diff --git a/registry-public/src/RegistryLib/Api/Handler/KnowledgeModelPackage/List_GET.hs b/registry-public/src/RegistryLib/Api/Handler/KnowledgeModelPackage/List_GET.hs index d27904a85..388943c3c 100644 --- a/registry-public/src/RegistryLib/Api/Handler/KnowledgeModelPackage/List_GET.hs +++ b/registry-public/src/RegistryLib/Api/Handler/KnowledgeModelPackage/List_GET.hs @@ -10,7 +10,7 @@ type List_GET = Header "Authorization" String :> Header "x-user-count" String :> Header "x-knowledge-model-package-count" String - :> Header "x-qtn-count" String + :> Header "x-project-count" String :> Header "x-knowledge-model-editor-count" String :> Header "x-doc-count" String :> Header "x-tml-count" String diff --git a/registry-server/src/Registry/Api/Handler/KnowledgeModelPackage/List_GET.hs b/registry-server/src/Registry/Api/Handler/KnowledgeModelPackage/List_GET.hs index 2cafaec64..61d971c52 100644 --- a/registry-server/src/Registry/Api/Handler/KnowledgeModelPackage/List_GET.hs +++ b/registry-server/src/Registry/Api/Handler/KnowledgeModelPackage/List_GET.hs @@ -25,7 +25,7 @@ list_GET -> Maybe String -> Maybe Int -> BaseContextM (Headers '[Header "x-trace-uuid" String] [KnowledgeModelPackageSimpleDTO]) -list_GET mTokenHeader xUserCountHeaderValue xPkgCountHeaderValue xQtnCountHeaderValue xKnowledgeModelEditorCountHeaderValue xDocCountHeaderValue xTmlCountHeaderValue mOrganizationId mKmId mMetamodelVersion = +list_GET mTokenHeader xUserCountHeaderValue xPkgCountHeaderValue xProjectCountHeaderValue xKnowledgeModelEditorCountHeaderValue xDocCountHeaderValue xTmlCountHeaderValue mOrganizationId mKmId mMetamodelVersion = getMaybeAuthServiceExecutor mTokenHeader $ \runInMaybeAuthService -> runInMaybeAuthService Transactional $ addTraceUuidHeader =<< do @@ -34,7 +34,7 @@ list_GET mTokenHeader xUserCountHeaderValue xPkgCountHeaderValue xQtnCountHeader catMaybes [ (,) xUserCountHeaderName <$> xUserCountHeaderValue , (,) xKnowledgeModelPackageCountHeaderName <$> xPkgCountHeaderValue - , (,) xQtnCountHeaderName <$> xQtnCountHeaderValue + , (,) xProjectCountHeaderName <$> xProjectCountHeaderValue , (,) xKnowledgeModelEditorCountHeaderName <$> xKnowledgeModelEditorCountHeaderValue , (,) xDocCountHeaderName <$> xDocCountHeaderValue , (,) xTmlCountHeaderName <$> xTmlCountHeaderValue diff --git a/registry-server/src/Registry/Database/Mapping/Audit/AuditEntry.hs b/registry-server/src/Registry/Database/Mapping/Audit/AuditEntry.hs index ac3de3d4d..04437c8d5 100644 --- a/registry-server/src/Registry/Database/Mapping/Audit/AuditEntry.hs +++ b/registry-server/src/Registry/Database/Mapping/Audit/AuditEntry.hs @@ -17,7 +17,7 @@ instance ToRow AuditEntry where , toField instanceStatistics.userCount , toField instanceStatistics.pkgCount , toField instanceStatistics.kmEditorCount - , toField instanceStatistics.qtnCount + , toField instanceStatistics.prjCount , toField instanceStatistics.tmlCount , toField instanceStatistics.docCount , toField (Nothing :: Maybe String) @@ -77,7 +77,7 @@ instance FromRow AuditEntry where userCount <- field pkgCount <- field kmEditorCount <- field - qtnCount <- field + prjCount <- field tmlCount <- field docCount <- field let instanceStatistics = InstanceStatistics {..} diff --git a/registry-server/src/Registry/Database/Migration/Development/Audit/AuditSchemaMigration.hs b/registry-server/src/Registry/Database/Migration/Development/Audit/AuditSchemaMigration.hs index 441b2f8e7..110f99ecf 100644 --- a/registry-server/src/Registry/Database/Migration/Development/Audit/AuditSchemaMigration.hs +++ b/registry-server/src/Registry/Database/Migration/Development/Audit/AuditSchemaMigration.hs @@ -27,7 +27,7 @@ createTables = do \ user_count int, \ \ knowledge_model_package_count int, \ \ knowledge_model_editor_count int, \ - \ questionnaire_count int, \ + \ project_count int, \ \ document_template_count int, \ \ document_count int, \ \ knowledge_model_package_id varchar, \ diff --git a/registry-server/src/Registry/Database/Migration/Development/Statistics/Data/InstanceStatistics.hs b/registry-server/src/Registry/Database/Migration/Development/Statistics/Data/InstanceStatistics.hs index 002bf028e..a3536f897 100644 --- a/registry-server/src/Registry/Database/Migration/Development/Statistics/Data/InstanceStatistics.hs +++ b/registry-server/src/Registry/Database/Migration/Development/Statistics/Data/InstanceStatistics.hs @@ -7,7 +7,7 @@ iStat = InstanceStatistics { userCount = 10 , pkgCount = 20 - , qtnCount = 30 + , prjCount = 30 , kmEditorCount = 40 , docCount = 50 , tmlCount = 60 diff --git a/registry-server/src/Registry/Database/Migration/Production/Migration.hs b/registry-server/src/Registry/Database/Migration/Production/Migration.hs index 5c7bdeecc..a459ebddb 100644 --- a/registry-server/src/Registry/Database/Migration/Production/Migration.hs +++ b/registry-server/src/Registry/Database/Migration/Production/Migration.hs @@ -17,6 +17,7 @@ import qualified Registry.Database.Migration.Production.Migration_0012_tenant.Mi import qualified Registry.Database.Migration.Production.Migration_0013_jsonb.Migration as M_0013 import qualified Registry.Database.Migration.Production.Migration_0014_documentTemplateMetamodel.Migration as M_0014 import qualified Registry.Database.Migration.Production.Migration_0015_knowledgeModelRefactor.Migration as M_0015 +import qualified Registry.Database.Migration.Production.Migration_0016_project.Migration as M_0016 migrationDefinitions :: [MigrationDefinition] migrationDefinitions = @@ -35,4 +36,5 @@ migrationDefinitions = , M_0013.definition , M_0014.definition , M_0015.definition + , M_0016.definition ] diff --git a/registry-server/src/Registry/Database/Migration/Production/Migration_0016_project/Migration.hs b/registry-server/src/Registry/Database/Migration/Production/Migration_0016_project/Migration.hs new file mode 100644 index 000000000..9746948b3 --- /dev/null +++ b/registry-server/src/Registry/Database/Migration/Production/Migration_0016_project/Migration.hs @@ -0,0 +1,20 @@ +module Registry.Database.Migration.Production.Migration_0016_project.Migration ( + definition, +) where + +import Control.Monad.Logger +import Control.Monad.Reader (liftIO) +import Data.Pool (Pool, withResource) +import Database.PostgreSQL.Migration.Entity +import Database.PostgreSQL.Simple + +definition = (meta, migrate) + +meta = MigrationMeta {mmNumber = 16, mmName = "Project Refactor", mmDescription = "Refactor project schema and related tables"} + +migrate :: Pool Connection -> LoggingT IO (Maybe Error) +migrate dbPool = do + let sql = "ALTER TABLE audit RENAME COLUMN questionnaire_count TO project_count;" + let action conn = execute_ conn sql + liftIO $ withResource dbPool action + return Nothing diff --git a/registry-server/src/Registry/Model/Statistics/InstanceStatistics.hs b/registry-server/src/Registry/Model/Statistics/InstanceStatistics.hs index dbc5d9eb1..5914e14da 100644 --- a/registry-server/src/Registry/Model/Statistics/InstanceStatistics.hs +++ b/registry-server/src/Registry/Model/Statistics/InstanceStatistics.hs @@ -5,7 +5,7 @@ import GHC.Generics data InstanceStatistics = InstanceStatistics { userCount :: Int , pkgCount :: Int - , qtnCount :: Int + , prjCount :: Int , kmEditorCount :: Int , docCount :: Int , tmlCount :: Int diff --git a/registry-server/src/Registry/Service/Audit/AuditService.hs b/registry-server/src/Registry/Service/Audit/AuditService.hs index 1fa6fd757..173958d24 100644 --- a/registry-server/src/Registry/Service/Audit/AuditService.hs +++ b/registry-server/src/Registry/Service/Audit/AuditService.hs @@ -68,7 +68,7 @@ getInstanceStaticsFromHeaders headers = in InstanceStatistics { userCount = get xUserCountHeaderName , pkgCount = get xKnowledgeModelPackageCountHeaderName - , qtnCount = get xQtnCountHeaderName + , prjCount = get xProjectCountHeaderName , kmEditorCount = get xKnowledgeModelEditorCountHeaderName , docCount = get xDocCountHeaderName , tmlCount = get xTmlCountHeaderName diff --git a/registry-server/test/Registry/Specs/API/Common.hs b/registry-server/test/Registry/Specs/API/Common.hs index 5958e75d4..1a58f5c35 100644 --- a/registry-server/test/Registry/Specs/API/Common.hs +++ b/registry-server/test/Registry/Specs/API/Common.hs @@ -45,7 +45,7 @@ reqStatisticsHeader :: [Header] reqStatisticsHeader = [ (CI.mk . BS.pack $ xUserCountHeaderName, BS.pack . show $ iStat.userCount) , (CI.mk . BS.pack $ xKnowledgeModelPackageCountHeaderName, BS.pack . show $ iStat.pkgCount) - , (CI.mk . BS.pack $ xQtnCountHeaderName, BS.pack . show $ iStat.qtnCount) + , (CI.mk . BS.pack $ xProjectCountHeaderName, BS.pack . show $ iStat.prjCount) , (CI.mk . BS.pack $ xKnowledgeModelEditorCountHeaderName, BS.pack . show $ iStat.kmEditorCount) , (CI.mk . BS.pack $ xDocCountHeaderName, BS.pack . show $ iStat.docCount) , (CI.mk . BS.pack $ xTmlCountHeaderName, BS.pack . show $ iStat.tmlCount) diff --git a/registry-server/test/Registry/Specs/API/DocumentTemplate/Detail_GET.hs b/registry-server/test/Registry/Specs/API/DocumentTemplate/Detail_GET.hs index 512e15ab4..6d81786cb 100644 --- a/registry-server/test/Registry/Specs/API/DocumentTemplate/Detail_GET.hs +++ b/registry-server/test/Registry/Specs/API/DocumentTemplate/Detail_GET.hs @@ -31,7 +31,7 @@ detail_GET appContext = -- ---------------------------------------------------- reqMethod = methodGet -reqUrl = "/document-templates/global:questionnaire-report:1.0.0" +reqUrl = "/document-templates/global:project-report:1.0.0" reqHeaders = [reqCtHeader] diff --git a/shared-common/src/Shared/Common/Constant/Api.hs b/shared-common/src/Shared/Common/Constant/Api.hs index 19abc48c8..80a1c4508 100644 --- a/shared-common/src/Shared/Common/Constant/Api.hs +++ b/shared-common/src/Shared/Common/Constant/Api.hs @@ -15,8 +15,8 @@ xUserCountHeaderName = "x-user-count" xKnowledgeModelPackageCountHeaderName :: String xKnowledgeModelPackageCountHeaderName = "x-knowledge-model-package-count" -xQtnCountHeaderName :: String -xQtnCountHeaderName = "x-qtn-count" +xProjectCountHeaderName :: String +xProjectCountHeaderName = "x-project-count" xKnowledgeModelEditorCountHeaderName :: String xKnowledgeModelEditorCountHeaderName = "x-knowledge-model-editor-count" diff --git a/shared-common/src/Shared/Common/Integration/Http/Common/HttpClientFactory.hs b/shared-common/src/Shared/Common/Integration/Http/Common/HttpClientFactory.hs index 3d3334407..9dd584b3d 100644 --- a/shared-common/src/Shared/Common/Integration/Http/Common/HttpClientFactory.hs +++ b/shared-common/src/Shared/Common/Integration/Http/Common/HttpClientFactory.hs @@ -43,10 +43,14 @@ createHttpClientManager serverConfig = modifyRequest :: Bool -> Request -> IO Request modifyRequest logHttpClient request = do - let updatedRequest = + let originalHeaders = requestHeaders request + -- Filter out "User-Agent" headers (case-insensitive) and (re-)add our explicit "User-Agent" header, to ensure there's only one User-Agent header. + -- Note: Reason for using case-insensitive search for header key(s) is because HTTP spec. states that header keys are case-insensitive. + headersWithoutUA = filter (\(headerName, _) -> headerName /= CI.mk (BS.pack "User-Agent")) originalHeaders + updatedRequest = request { path = BS.pack . replace "//" "/" . BS.unpack . path $ request - , requestHeaders = ("User-Agent", "wizard-http-client") : requestHeaders request + , requestHeaders = ("User-Agent", "wizard-http-client") : headersWithoutUA } logRequest logHttpClient updatedRequest return updatedRequest diff --git a/shared-common/src/Shared/Common/Util/Aeson.hs b/shared-common/src/Shared/Common/Util/Aeson.hs index 9aa462db9..4ac467747 100644 --- a/shared-common/src/Shared/Common/Util/Aeson.hs +++ b/shared-common/src/Shared/Common/Util/Aeson.hs @@ -53,8 +53,8 @@ jsonSpecialFields "gId" = "id" jsonSpecialFields "iId" = "id" jsonSpecialFields "lId" = "id" jsonSpecialFields "pId" = "id" -jsonSpecialFields "qaId" = "id" -jsonSpecialFields "qiId" = "id" +jsonSpecialFields "paId" = "id" +jsonSpecialFields "piId" = "id" jsonSpecialFields "sId" = "id" jsonSpecialFields "tId" = "id" jsonSpecialFields "aData" = "data" diff --git a/shared-common/src/Shared/DocumentTemplate/Database/Migration/Development/DocumentTemplate/Data/DocumentTemplateFiles.hs b/shared-common/src/Shared/DocumentTemplate/Database/Migration/Development/DocumentTemplate/Data/DocumentTemplateFiles.hs index b1ca3c316..c92e82b0b 100644 --- a/shared-common/src/Shared/DocumentTemplate/Database/Migration/Development/DocumentTemplate/Data/DocumentTemplateFiles.hs +++ b/shared-common/src/Shared/DocumentTemplate/Database/Migration/Development/DocumentTemplate/Data/DocumentTemplateFiles.hs @@ -103,8 +103,8 @@ html = {# VARIABLES #} {# ------------------------------------------------------------------------------------ #} {%- set km = ctx.knowledgeModel -%} -{%- set replies = ctx.questionnaireReplies -%} -{%- set repliesMap = ctx.questionnaireRepliesMap -%} +{%- set replies = ctx.projectReplies -%} +{%- set repliesMap = ctx.projectRepliesMap -%} {%- set report = ctx.report -%} {%- set metricDefinitions = ctx.metrics -%} {%- set levelDefinitions = ctx.levels -%} @@ -380,7 +380,7 @@ html =

- {{ctx.questionnaireName}}
+ {{ctx.projectName}}
{{km.name}}

diff --git a/shared-common/src/Shared/DocumentTemplate/Database/Migration/Development/DocumentTemplate/Data/DocumentTemplates.hs b/shared-common/src/Shared/DocumentTemplate/Database/Migration/Development/DocumentTemplate/Data/DocumentTemplates.hs index c73aa879e..f0971c60c 100644 --- a/shared-common/src/Shared/DocumentTemplate/Database/Migration/Development/DocumentTemplate/Data/DocumentTemplates.hs +++ b/shared-common/src/Shared/DocumentTemplate/Database/Migration/Development/DocumentTemplate/Data/DocumentTemplates.hs @@ -11,14 +11,14 @@ import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data. wizardDocumentTemplate :: DocumentTemplate wizardDocumentTemplate = DocumentTemplate - { tId = "global:questionnaire-report:1.0.0" - , name = "Questionnaire Report" + { tId = "global:project-report:1.0.0" + , name = "Project Report" , organizationId = "global" - , templateId = "questionnaire-report" + , templateId = "project-report" , version = "1.0.0" , phase = ReleasedDocumentTemplatePhase , metamodelVersion = documentTemplateMetamodelVersion - , description = "Exported questions and answers from a questionnaire" + , description = "Exported questions and answers from a project" , readme = "# Default DocumentTemplate" , license = "Apache-2.0" , allowedPackages = [kmPackagePatternAll] @@ -34,7 +34,7 @@ wizardDocumentTemplateDeprecated = wizardDocumentTemplate {phase = DeprecatedDoc wizardDocumentTemplateDraft :: DocumentTemplate wizardDocumentTemplateDraft = wizardDocumentTemplate - { tId = "global:questionnaire-report:2.0.0" + { tId = "global:project-report:2.0.0" , name = "DRAFT: " ++ wizardDocumentTemplate.name , version = "2.0.0" , phase = DraftDocumentTemplatePhase @@ -45,7 +45,7 @@ wizardDocumentTemplateDraft = wizardDocumentTemplateNlDraft :: DocumentTemplate wizardDocumentTemplateNlDraft = wizardDocumentTemplate - { tId = "org.nl.amsterdam:questionnaire-report:3.0.0" + { tId = "org.nl.amsterdam:project-report:3.0.0" , name = "New Document Template" , organizationId = "org.nl.amsterdam" , version = "3.0.0" diff --git a/wizard-public/src/WizardLib/Public/Api/Resource/Tenant/Usage/WizardUsageDTO.hs b/wizard-public/src/WizardLib/Public/Api/Resource/Tenant/Usage/WizardUsageDTO.hs index f5fcf5571..1777be88b 100644 --- a/wizard-public/src/WizardLib/Public/Api/Resource/Tenant/Usage/WizardUsageDTO.hs +++ b/wizard-public/src/WizardLib/Public/Api/Resource/Tenant/Usage/WizardUsageDTO.hs @@ -11,7 +11,7 @@ data WizardUsageDTO = WizardUsageDTO , knowledgeModelEditors :: UsageEntryDTO , documentTemplates :: UsageEntryDTO , documentTemplateDrafts :: UsageEntryDTO - , questionnaires :: UsageEntryDTO + , projects :: UsageEntryDTO , documents :: UsageEntryDTO , locales :: UsageEntryDTO , storage :: UsageEntryDTO diff --git a/wizard-public/src/WizardLib/Public/Database/Migration/Development/Tenant/Data/TenantLimitBundles.hs b/wizard-public/src/WizardLib/Public/Database/Migration/Development/Tenant/Data/TenantLimitBundles.hs index 6ca576e01..2ad3c5039 100644 --- a/wizard-public/src/WizardLib/Public/Database/Migration/Development/Tenant/Data/TenantLimitBundles.hs +++ b/wizard-public/src/WizardLib/Public/Database/Migration/Development/Tenant/Data/TenantLimitBundles.hs @@ -11,7 +11,7 @@ tenantLimitBundleChange = , knowledgeModelEditors = -1000 , documentTemplates = -1000 , documentTemplateDrafts = -1000 - , questionnaires = -1000 + , projects = -1000 , documents = -1000 , locales = -1000 , storage = -1000 * 5 * 1000 * 1000 diff --git a/wizard-public/src/WizardLib/Public/Database/Migration/Development/Tenant/Data/TenantUsages.hs b/wizard-public/src/WizardLib/Public/Database/Migration/Development/Tenant/Data/TenantUsages.hs index 544f1371e..3cef73bd3 100644 --- a/wizard-public/src/WizardLib/Public/Database/Migration/Development/Tenant/Data/TenantUsages.hs +++ b/wizard-public/src/WizardLib/Public/Database/Migration/Development/Tenant/Data/TenantUsages.hs @@ -12,7 +12,7 @@ defaultUsage = , knowledgeModelEditors = defaultUsageKnowledgeModelEditors , documentTemplates = defaultUsageDocumentTemplates , documentTemplateDrafts = defaultUsageDocumentTemplateDrafts - , questionnaires = defaultUsageQuestionnaires + , projects = defaultUsageProjects , documents = defaultUsageDocuments , locales = defaultUsageLocales , storage = defaultUsageStorage @@ -42,8 +42,8 @@ defaultUsageDocumentTemplates = UsageEntryDTO {current = 0, max = -1000} defaultUsageDocumentTemplateDrafts :: UsageEntryDTO defaultUsageDocumentTemplateDrafts = UsageEntryDTO {current = 0, max = -1000} -defaultUsageQuestionnaires :: UsageEntryDTO -defaultUsageQuestionnaires = UsageEntryDTO {current = 0, max = -1000} +defaultUsageProjects :: UsageEntryDTO +defaultUsageProjects = UsageEntryDTO {current = 0, max = -1000} defaultUsageDocuments :: UsageEntryDTO defaultUsageDocuments = UsageEntryDTO {current = 0, max = -1000} diff --git a/wizard-public/src/WizardLib/Public/Model/PersistentCommand/Project/CreateProjectCommand.hs b/wizard-public/src/WizardLib/Public/Model/PersistentCommand/Project/CreateProjectCommand.hs new file mode 100644 index 000000000..2482efb52 --- /dev/null +++ b/wizard-public/src/WizardLib/Public/Model/PersistentCommand/Project/CreateProjectCommand.hs @@ -0,0 +1,20 @@ +module WizardLib.Public.Model.PersistentCommand.Project.CreateProjectCommand where + +import Data.Aeson +import GHC.Generics + +import Shared.Common.Util.Aeson + +data CreateProjectCommand = CreateProjectCommand + { name :: String + , emails :: [String] + , knowledgeModelPackageId :: String + , documentTemplateId :: Maybe String + } + deriving (Show, Eq, Generic) + +instance FromJSON CreateProjectCommand where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON CreateProjectCommand where + toJSON = genericToJSON jsonOptions diff --git a/wizard-public/src/WizardLib/Public/Model/PersistentCommand/Questionnaire/CreateQuestionnaireCommand.hs b/wizard-public/src/WizardLib/Public/Model/PersistentCommand/Questionnaire/CreateQuestionnaireCommand.hs deleted file mode 100644 index 16fb84c5a..000000000 --- a/wizard-public/src/WizardLib/Public/Model/PersistentCommand/Questionnaire/CreateQuestionnaireCommand.hs +++ /dev/null @@ -1,20 +0,0 @@ -module WizardLib.Public.Model.PersistentCommand.Questionnaire.CreateQuestionnaireCommand where - -import Data.Aeson -import GHC.Generics - -import Shared.Common.Util.Aeson - -data CreateQuestionnaireCommand = CreateQuestionnaireCommand - { name :: String - , emails :: [String] - , knowledgeModelPackageId :: String - , documentTemplateId :: Maybe String - } - deriving (Show, Eq, Generic) - -instance FromJSON CreateQuestionnaireCommand where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON CreateQuestionnaireCommand where - toJSON = genericToJSON jsonOptions diff --git a/wizard-public/src/WizardLib/Public/Model/Tenant/Limit/TenantLimitBundleChange.hs b/wizard-public/src/WizardLib/Public/Model/Tenant/Limit/TenantLimitBundleChange.hs index 1e312d7ee..b021aee94 100644 --- a/wizard-public/src/WizardLib/Public/Model/Tenant/Limit/TenantLimitBundleChange.hs +++ b/wizard-public/src/WizardLib/Public/Model/Tenant/Limit/TenantLimitBundleChange.hs @@ -13,7 +13,7 @@ data TenantLimitBundleChange = TenantLimitBundleChange , knowledgeModelEditors :: Int , documentTemplates :: Int , documentTemplateDrafts :: Int - , questionnaires :: Int + , projects :: Int , documents :: Int , locales :: Int , storage :: Int64 diff --git a/wizard-server/src/Wizard/Api/Handler/Api.hs b/wizard-server/src/Wizard/Api/Handler/Api.hs index c33ed9e4a..502a792c6 100644 --- a/wizard-server/src/Wizard/Api/Handler/Api.hs +++ b/wizard-server/src/Wizard/Api/Handler/Api.hs @@ -6,7 +6,6 @@ import Wizard.Api.Handler.ActionKey.Api import Wizard.Api.Handler.ApiKey.Api import Wizard.Api.Handler.AppKey.Api import Wizard.Api.Handler.Auth.Api -import Wizard.Api.Handler.CommentThread.Api import Wizard.Api.Handler.Config.Api import Wizard.Api.Handler.Dev.Api import Wizard.Api.Handler.Document.Api @@ -24,15 +23,13 @@ import Wizard.Api.Handler.KnowledgeModelEditor.Api import Wizard.Api.Handler.KnowledgeModelPackage.Api import Wizard.Api.Handler.KnowledgeModelSecret.Api import Wizard.Api.Handler.Locale.Api -import Wizard.Api.Handler.Migration.Api import Wizard.Api.Handler.PersistentCommand.Api import Wizard.Api.Handler.Prefab.Api -import Wizard.Api.Handler.Questionnaire.Api -import Wizard.Api.Handler.Questionnaire.Event.Api -import Wizard.Api.Handler.Questionnaire.Version.Api -import Wizard.Api.Handler.QuestionnaireAction.Api -import Wizard.Api.Handler.QuestionnaireFile.Api -import Wizard.Api.Handler.QuestionnaireImporter.Api +import Wizard.Api.Handler.Project.Api +import Wizard.Api.Handler.ProjectAction.Api +import Wizard.Api.Handler.ProjectCommentThread.Api +import Wizard.Api.Handler.ProjectFile.Api +import Wizard.Api.Handler.ProjectImporter.Api import Wizard.Api.Handler.Registry.Api import Wizard.Api.Handler.Submission.Api import Wizard.Api.Handler.Tenant.Api @@ -47,7 +44,6 @@ type ApplicationAPI = :<|> ApiKeyAPI :<|> AppKeyAPI :<|> AuthAPI - :<|> CommentThreadAPI :<|> ConfigAPI :<|> DevAPI :<|> DocumentTemplateAPI @@ -65,15 +61,13 @@ type ApplicationAPI = :<|> KnowledgeModelPackageAPI :<|> KnowledgeModelSecretAPI :<|> LocaleAPI - :<|> MigrationAPI :<|> PersistentCommandAPI :<|> PrefabAPI - :<|> QuestionnaireAPI - :<|> QuestionnaireEventAPI - :<|> QuestionnaireVersionAPI - :<|> QuestionnaireFileAPI - :<|> QuestionnaireActionAPI - :<|> QuestionnaireImporterAPI + :<|> ProjectAPI + :<|> ProjectActionAPI + :<|> ProjectCommentThreadAPI + :<|> ProjectFileAPI + :<|> ProjectImporterAPI :<|> RegistryAPI :<|> SubmissionAPI :<|> TenantAPI @@ -91,7 +85,6 @@ applicationServer = :<|> apiKeyServer :<|> appKeyServer :<|> authServer - :<|> commentThreadServer :<|> configServer :<|> devServer :<|> documentTemplateServer @@ -109,15 +102,13 @@ applicationServer = :<|> knowledgeModelPackageServer :<|> knowledgeModelSecretServer :<|> localeServer - :<|> migrationServer :<|> persistentCommandServer :<|> prefabServer - :<|> questionnaireServer - :<|> questionnaireEventServer - :<|> questionnaireVersionServer - :<|> questionnaireFileServer - :<|> questionnaireActionServer - :<|> questionnaireImporterServer + :<|> projectServer + :<|> projectActionServer + :<|> projectCommentThreadServer + :<|> projectFileServer + :<|> projectImporterServer :<|> registryServer :<|> submissionServer :<|> tenantServer diff --git a/wizard-server/src/Wizard/Api/Handler/CommentThread/Api.hs b/wizard-server/src/Wizard/Api/Handler/CommentThread/Api.hs deleted file mode 100644 index 81d7cd41c..000000000 --- a/wizard-server/src/Wizard/Api/Handler/CommentThread/Api.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Wizard.Api.Handler.CommentThread.Api where - -import Servant -import Servant.Swagger.Tags - -import Wizard.Api.Handler.CommentThread.List_GET -import Wizard.Model.Context.BaseContext - -type CommentThreadAPI = - Tags "CommentThread" - :> List_GET - -commentThreadApi :: Proxy CommentThreadAPI -commentThreadApi = Proxy - -commentThreadServer :: ServerT CommentThreadAPI BaseContextM -commentThreadServer = - list_GET diff --git a/wizard-server/src/Wizard/Api/Handler/CommentThread/List_GET.hs b/wizard-server/src/Wizard/Api/Handler/CommentThread/List_GET.hs deleted file mode 100644 index 7972437b7..000000000 --- a/wizard-server/src/Wizard/Api/Handler/CommentThread/List_GET.hs +++ /dev/null @@ -1,42 +0,0 @@ -module Wizard.Api.Handler.CommentThread.List_GET where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.Pageable -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Questionnaire.QuestionnaireCommentThreadAssignedJM () -import Wizard.Model.Context.BaseContext -import Wizard.Model.Questionnaire.QuestionnaireCommentThreadAssigned -import Wizard.Service.Questionnaire.Comment.QuestionnaireCommentService - -type List_GET = - Header "Authorization" String - :> Header "Host" String - :> "comment-threads" - :> QueryParam "q" String - :> QueryParam "questionnaireUuid" U.UUID - :> QueryParam "resolved" Bool - :> QueryParam "page" Int - :> QueryParam "size" Int - :> QueryParam "sort" String - :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (Page QuestionnaireCommentThreadAssigned)) - -list_GET - :: Maybe String - -> Maybe String - -> Maybe String - -> Maybe U.UUID - -> Maybe Bool - -> Maybe Int - -> Maybe Int - -> Maybe String - -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page QuestionnaireCommentThreadAssigned)) -list_GET mTokenHeader mServerUrl mQuery mQuestionnaireUuid resolved mPage mSize mSort = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService NoTransaction $ - addTraceUuidHeader - =<< getQuestionnaireCommentThreadsPage mQuery mQuestionnaireUuid resolved (Pageable mPage mSize) (parseSortQuery mSort) diff --git a/wizard-server/src/Wizard/Api/Handler/Document/List_GET.hs b/wizard-server/src/Wizard/Api/Handler/Document/List_GET.hs index 257ce006c..639bf15fc 100644 --- a/wizard-server/src/Wizard/Api/Handler/Document/List_GET.hs +++ b/wizard-server/src/Wizard/Api/Handler/Document/List_GET.hs @@ -17,7 +17,7 @@ type List_GET = Header "Authorization" String :> Header "Host" String :> "documents" - :> QueryParam "questionnaireUuid" U.UUID + :> QueryParam "projectUuid" U.UUID :> QueryParam "documentTemplateId" String :> QueryParam "q" String :> QueryParam "page" Int @@ -35,7 +35,7 @@ list_GET -> Maybe Int -> Maybe String -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page DocumentDTO)) -list_GET mTokenHeader mServerUrl mQuestionnaireUuid mDocumentTemplateId mQuery mPage mSize mSort = +list_GET mTokenHeader mServerUrl mProjectUuid mDocumentTemplateId mQuery mPage mSize mSort = getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> runInAuthService NoTransaction $ - addTraceUuidHeader =<< getDocumentsPageDto mQuestionnaireUuid mDocumentTemplateId mQuery (Pageable mPage mSize) (parseSortQuery mSort) + addTraceUuidHeader =<< getDocumentsPageDto mProjectUuid mDocumentTemplateId mQuery (Pageable mPage mSize) (parseSortQuery mSort) diff --git a/wizard-server/src/Wizard/Api/Handler/DocumentTemplateDraft/Detail_Documents_Preview_GET.hs b/wizard-server/src/Wizard/Api/Handler/DocumentTemplateDraft/Detail_Documents_Preview_GET.hs index f48aa1d9d..c62457930 100644 --- a/wizard-server/src/Wizard/Api/Handler/DocumentTemplateDraft/Detail_Documents_Preview_GET.hs +++ b/wizard-server/src/Wizard/Api/Handler/DocumentTemplateDraft/Detail_Documents_Preview_GET.hs @@ -34,5 +34,5 @@ detail_documents_preview_GET mTokenHeader mServerUrl documentTemplateId = case doc.state of DoneDocumentState -> addTraceUuidHeader fileDto ErrorDocumentState -> - throwError $ SystemLogError (_ERROR_SERVICE_QTN__UNABLE_TO_GENERATE_DOCUMENT_PREVIEW $ doc.workerLog) + throwError $ SystemLogError (_ERROR_SERVICE_PROJECT__UNABLE_TO_GENERATE_DOCUMENT_PREVIEW $ doc.workerLog) _ -> throwError AcceptedError diff --git a/wizard-server/src/Wizard/Api/Handler/KnowledgeModelEditor/Api.hs b/wizard-server/src/Wizard/Api/Handler/KnowledgeModelEditor/Api.hs index f78024bd9..f900bdf7b 100644 --- a/wizard-server/src/Wizard/Api/Handler/KnowledgeModelEditor/Api.hs +++ b/wizard-server/src/Wizard/Api/Handler/KnowledgeModelEditor/Api.hs @@ -10,6 +10,7 @@ import Wizard.Api.Handler.KnowledgeModelEditor.Detail_WS import Wizard.Api.Handler.KnowledgeModelEditor.List_GET import Wizard.Api.Handler.KnowledgeModelEditor.List_POST import Wizard.Api.Handler.KnowledgeModelEditor.List_Suggestions_GET +import Wizard.Api.Handler.KnowledgeModelEditor.Migration.Api import Wizard.Model.Context.BaseContext type KnowledgeModelEditorAPI = @@ -21,6 +22,7 @@ type KnowledgeModelEditorAPI = :<|> Detail_PUT :<|> Detail_DELETE :<|> Detail_WS + :<|> MigrationAPI ) knowledgeModelEditorApi :: Proxy KnowledgeModelEditorAPI @@ -35,3 +37,4 @@ knowledgeModelEditorServer = :<|> detail_PUT :<|> detail_DELETE :<|> detail_WS + :<|> migrationServer diff --git a/wizard-server/src/Wizard/Api/Handler/KnowledgeModelEditor/Detail_WS.hs b/wizard-server/src/Wizard/Api/Handler/KnowledgeModelEditor/Detail_WS.hs index 39ba19055..78cbb3a43 100644 --- a/wizard-server/src/Wizard/Api/Handler/KnowledgeModelEditor/Detail_WS.hs +++ b/wizard-server/src/Wizard/Api/Handler/KnowledgeModelEditor/Detail_WS.hs @@ -10,8 +10,8 @@ import Prelude hiding (log) import Shared.Common.Model.Context.TransactionState import Wizard.Api.Handler.Common import Wizard.Api.Handler.Websocket -import Wizard.Api.Resource.Websocket.KnowledgeModelEditorActionDTO -import Wizard.Api.Resource.Websocket.KnowledgeModelEditorActionJM () +import Wizard.Api.Resource.Websocket.KnowledgeModelEditorMessageDTO +import Wizard.Api.Resource.Websocket.KnowledgeModelEditorMessageJM () import Wizard.Model.Context.AppContext import Wizard.Model.Context.BaseContext import Wizard.Service.KnowledgeModel.Editor.Collaboration.CollaborationService @@ -45,12 +45,12 @@ handleMessage editorUuid connectionUuid connection = handleClose :: AppContextM () handleClose = deleteUser editorUuid connectionUuid -- ------------------------------------------------------------------------------------ - handleAction :: ClientKnowledgeModelEditorActionDTO -> AppContextM () - handleAction (SetContent_ClientKnowledgeModelEditorActionDTO reqDto) = do + handleAction :: ClientKnowledgeModelEditorMessageDTO -> AppContextM () + handleAction (SetContent_ClientKnowledgeModelEditorMessageDTO reqDto) = do log connectionUuid "SetContent" setContent editorUuid connectionUuid reqDto handleMessage editorUuid connectionUuid connection - handleAction (SetReplies_ClientKnowledgeModelEditorActionDTO reqDto) = do + handleAction (SetReplies_ClientKnowledgeModelEditorMessageDTO reqDto) = do log connectionUuid "SetReplies" setReplies editorUuid connectionUuid reqDto handleMessage editorUuid connectionUuid connection diff --git a/wizard-server/src/Wizard/Api/Handler/KnowledgeModelEditor/Migration/Api.hs b/wizard-server/src/Wizard/Api/Handler/KnowledgeModelEditor/Migration/Api.hs new file mode 100644 index 000000000..ef999409f --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/KnowledgeModelEditor/Migration/Api.hs @@ -0,0 +1,31 @@ +module Wizard.Api.Handler.KnowledgeModelEditor.Migration.Api where + +import Servant +import Servant.Swagger.Tags + +import Wizard.Api.Handler.KnowledgeModelEditor.Migration.List_Current_Conflict_All_POST +import Wizard.Api.Handler.KnowledgeModelEditor.Migration.List_Current_Conflict_POST +import Wizard.Api.Handler.KnowledgeModelEditor.Migration.List_Current_DELETE +import Wizard.Api.Handler.KnowledgeModelEditor.Migration.List_Current_GET +import Wizard.Api.Handler.KnowledgeModelEditor.Migration.List_Current_POST +import Wizard.Model.Context.BaseContext + +type MigrationAPI = + Tags "Knowledge Model Editor Migration" + :> ( List_Current_GET + :<|> List_Current_POST + :<|> List_Current_DELETE + :<|> List_Current_Conflict_POST + :<|> List_Current_Conflict_All_POST + ) + +migrationApi :: Proxy MigrationAPI +migrationApi = Proxy + +migrationServer :: ServerT MigrationAPI BaseContextM +migrationServer = + list_current_GET + :<|> list_current_POST + :<|> list_current_DELETE + :<|> list_current_conflict_POST + :<|> list_Current_Conflict_All_POST diff --git a/wizard-server/src/Wizard/Api/Handler/KnowledgeModelEditor/Migration/List_Current_Conflict_All_POST.hs b/wizard-server/src/Wizard/Api/Handler/KnowledgeModelEditor/Migration/List_Current_Conflict_All_POST.hs new file mode 100644 index 000000000..47fc5e66d --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/KnowledgeModelEditor/Migration/List_Current_Conflict_All_POST.hs @@ -0,0 +1,30 @@ +module Wizard.Api.Handler.KnowledgeModelEditor.Migration.List_Current_Conflict_All_POST where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Model.Context.BaseContext +import Wizard.Service.KnowledgeModel.Migration.KnowledgeModelMigrationService + +type List_Current_Conflict_All_POST = + Header "Authorization" String + :> Header "Host" String + :> "knowledge-model-editors" + :> Capture "bUuid" U.UUID + :> "migrations" + :> "current" + :> "conflict" + :> "all" + :> Verb 'POST 204 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] NoContent) + +list_Current_Conflict_All_POST + :: Maybe String -> Maybe String -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] NoContent) +list_Current_Conflict_All_POST mTokenHeader mServerUrl bUuid = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService Transactional $ + addTraceUuidHeader =<< do + solveAllConflicts bUuid + return NoContent diff --git a/wizard-server/src/Wizard/Api/Handler/KnowledgeModelEditor/Migration/List_Current_Conflict_POST.hs b/wizard-server/src/Wizard/Api/Handler/KnowledgeModelEditor/Migration/List_Current_Conflict_POST.hs new file mode 100644 index 000000000..69016c85e --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/KnowledgeModelEditor/Migration/List_Current_Conflict_POST.hs @@ -0,0 +1,36 @@ +module Wizard.Api.Handler.KnowledgeModelEditor.Migration.List_Current_Conflict_POST where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationResolutionDTO +import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationResolutionJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.KnowledgeModel.Migration.KnowledgeModelMigrationService + +type List_Current_Conflict_POST = + Header "Authorization" String + :> Header "Host" String + :> ReqBody '[SafeJSON] KnowledgeModelMigrationResolutionDTO + :> "knowledge-model-editors" + :> Capture "bUuid" U.UUID + :> "migrations" + :> "current" + :> "conflict" + :> Verb 'POST 204 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] NoContent) + +list_current_conflict_POST + :: Maybe String + -> Maybe String + -> KnowledgeModelMigrationResolutionDTO + -> U.UUID + -> BaseContextM (Headers '[Header "x-trace-uuid" String] NoContent) +list_current_conflict_POST mTokenHeader mServerUrl reqDto bUuid = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService Transactional $ + addTraceUuidHeader =<< do + solveConflictAndMigrate bUuid reqDto + return NoContent diff --git a/wizard-server/src/Wizard/Api/Handler/KnowledgeModelEditor/Migration/List_Current_DELETE.hs b/wizard-server/src/Wizard/Api/Handler/KnowledgeModelEditor/Migration/List_Current_DELETE.hs new file mode 100644 index 000000000..fac9b16e6 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/KnowledgeModelEditor/Migration/List_Current_DELETE.hs @@ -0,0 +1,28 @@ +module Wizard.Api.Handler.KnowledgeModelEditor.Migration.List_Current_DELETE where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Model.Context.BaseContext +import Wizard.Service.KnowledgeModel.Migration.KnowledgeModelMigrationService + +type List_Current_DELETE = + Header "Authorization" String + :> Header "Host" String + :> "knowledge-model-editors" + :> Capture "bUuid" U.UUID + :> "migrations" + :> "current" + :> Verb DELETE 204 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] NoContent) + +list_current_DELETE + :: Maybe String -> Maybe String -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] NoContent) +list_current_DELETE mTokenHeader mServerUrl bUuid = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService Transactional $ + addTraceUuidHeader =<< do + deleteCurrentMigration bUuid + return NoContent diff --git a/wizard-server/src/Wizard/Api/Handler/KnowledgeModelEditor/Migration/List_Current_GET.hs b/wizard-server/src/Wizard/Api/Handler/KnowledgeModelEditor/Migration/List_Current_GET.hs new file mode 100644 index 000000000..a9cbcb019 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/KnowledgeModelEditor/Migration/List_Current_GET.hs @@ -0,0 +1,27 @@ +module Wizard.Api.Handler.KnowledgeModelEditor.Migration.List_Current_GET where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationDTO +import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationStateJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.KnowledgeModel.Migration.KnowledgeModelMigrationService + +type List_Current_GET = + Header "Authorization" String + :> Header "Host" String + :> "knowledge-model-editors" + :> Capture "bUuid" U.UUID + :> "migrations" + :> "current" + :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] KnowledgeModelMigrationDTO) + +list_current_GET + :: Maybe String -> Maybe String -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] KnowledgeModelMigrationDTO) +list_current_GET mTokenHeader mServerUrl bUuid = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService NoTransaction $ addTraceUuidHeader =<< getCurrentMigrationDto bUuid diff --git a/wizard-server/src/Wizard/Api/Handler/KnowledgeModelEditor/Migration/List_Current_POST.hs b/wizard-server/src/Wizard/Api/Handler/KnowledgeModelEditor/Migration/List_Current_POST.hs new file mode 100644 index 000000000..43bd4efb3 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/KnowledgeModelEditor/Migration/List_Current_POST.hs @@ -0,0 +1,34 @@ +module Wizard.Api.Handler.KnowledgeModelEditor.Migration.List_Current_POST where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationCreateDTO +import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationCreateJM () +import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationDTO +import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationStateJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.KnowledgeModel.Migration.KnowledgeModelMigrationService + +type List_Current_POST = + Header "Authorization" String + :> Header "Host" String + :> ReqBody '[SafeJSON] KnowledgeModelMigrationCreateDTO + :> "knowledge-model-editors" + :> Capture "bUuid" U.UUID + :> "migrations" + :> "current" + :> Verb 'POST 201 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] KnowledgeModelMigrationDTO) + +list_current_POST + :: Maybe String + -> Maybe String + -> KnowledgeModelMigrationCreateDTO + -> U.UUID + -> BaseContextM (Headers '[Header "x-trace-uuid" String] KnowledgeModelMigrationDTO) +list_current_POST mTokenHeader mServerUrl reqDto bUuid = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService Transactional $ addTraceUuidHeader =<< createMigration bUuid reqDto diff --git a/wizard-server/src/Wizard/Api/Handler/Migration/Api.hs b/wizard-server/src/Wizard/Api/Handler/Migration/Api.hs deleted file mode 100644 index 531a7dd48..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Migration/Api.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Wizard.Api.Handler.Migration.Api where - -import Servant - -import qualified Wizard.Api.Handler.Migration.KnowledgeModel.Api as KM -import qualified Wizard.Api.Handler.Migration.Questionnaire.Api as QTN -import Wizard.Model.Context.BaseContext - -type MigrationAPI = - KM.MigrationAPI - :<|> QTN.MigrationAPI - -migrationApi :: Proxy MigrationAPI -migrationApi = Proxy - -migrationServer :: ServerT MigrationAPI BaseContextM -migrationServer = KM.migrationServer :<|> QTN.migrationServer diff --git a/wizard-server/src/Wizard/Api/Handler/Migration/KnowledgeModel/Api.hs b/wizard-server/src/Wizard/Api/Handler/Migration/KnowledgeModel/Api.hs deleted file mode 100644 index 8291369f1..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Migration/KnowledgeModel/Api.hs +++ /dev/null @@ -1,31 +0,0 @@ -module Wizard.Api.Handler.Migration.KnowledgeModel.Api where - -import Servant -import Servant.Swagger.Tags - -import Wizard.Api.Handler.Migration.KnowledgeModel.List_Current_Conflict_All_POST -import Wizard.Api.Handler.Migration.KnowledgeModel.List_Current_Conflict_POST -import Wizard.Api.Handler.Migration.KnowledgeModel.List_Current_DELETE -import Wizard.Api.Handler.Migration.KnowledgeModel.List_Current_GET -import Wizard.Api.Handler.Migration.KnowledgeModel.List_Current_POST -import Wizard.Model.Context.BaseContext - -type MigrationAPI = - Tags "Knowledge Model Editor Migration" - :> ( List_Current_GET - :<|> List_Current_POST - :<|> List_Current_DELETE - :<|> List_Current_Conflict_POST - :<|> List_Current_Conflict_All_POST - ) - -migrationApi :: Proxy MigrationAPI -migrationApi = Proxy - -migrationServer :: ServerT MigrationAPI BaseContextM -migrationServer = - list_current_GET - :<|> list_current_POST - :<|> list_current_DELETE - :<|> list_current_conflict_POST - :<|> list_Current_Conflict_All_POST diff --git a/wizard-server/src/Wizard/Api/Handler/Migration/KnowledgeModel/List_Current_Conflict_All_POST.hs b/wizard-server/src/Wizard/Api/Handler/Migration/KnowledgeModel/List_Current_Conflict_All_POST.hs deleted file mode 100644 index 7ce75b85a..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Migration/KnowledgeModel/List_Current_Conflict_All_POST.hs +++ /dev/null @@ -1,30 +0,0 @@ -module Wizard.Api.Handler.Migration.KnowledgeModel.List_Current_Conflict_All_POST where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Model.Context.BaseContext -import Wizard.Service.KnowledgeModel.Migration.MigrationService - -type List_Current_Conflict_All_POST = - Header "Authorization" String - :> Header "Host" String - :> "knowledge-model-editors" - :> Capture "bUuid" U.UUID - :> "migrations" - :> "current" - :> "conflict" - :> "all" - :> Verb 'POST 204 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] NoContent) - -list_Current_Conflict_All_POST - :: Maybe String -> Maybe String -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] NoContent) -list_Current_Conflict_All_POST mTokenHeader mServerUrl bUuid = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService Transactional $ - addTraceUuidHeader =<< do - solveAllConflicts bUuid - return NoContent diff --git a/wizard-server/src/Wizard/Api/Handler/Migration/KnowledgeModel/List_Current_Conflict_POST.hs b/wizard-server/src/Wizard/Api/Handler/Migration/KnowledgeModel/List_Current_Conflict_POST.hs deleted file mode 100644 index 95e08b9be..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Migration/KnowledgeModel/List_Current_Conflict_POST.hs +++ /dev/null @@ -1,36 +0,0 @@ -module Wizard.Api.Handler.Migration.KnowledgeModel.List_Current_Conflict_POST where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationResolutionDTO -import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationResolutionJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.KnowledgeModel.Migration.MigrationService - -type List_Current_Conflict_POST = - Header "Authorization" String - :> Header "Host" String - :> ReqBody '[SafeJSON] KnowledgeModelMigrationResolutionDTO - :> "knowledge-model-editors" - :> Capture "bUuid" U.UUID - :> "migrations" - :> "current" - :> "conflict" - :> Verb 'POST 204 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] NoContent) - -list_current_conflict_POST - :: Maybe String - -> Maybe String - -> KnowledgeModelMigrationResolutionDTO - -> U.UUID - -> BaseContextM (Headers '[Header "x-trace-uuid" String] NoContent) -list_current_conflict_POST mTokenHeader mServerUrl reqDto bUuid = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService Transactional $ - addTraceUuidHeader =<< do - solveConflictAndMigrate bUuid reqDto - return NoContent diff --git a/wizard-server/src/Wizard/Api/Handler/Migration/KnowledgeModel/List_Current_DELETE.hs b/wizard-server/src/Wizard/Api/Handler/Migration/KnowledgeModel/List_Current_DELETE.hs deleted file mode 100644 index 4616a64ad..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Migration/KnowledgeModel/List_Current_DELETE.hs +++ /dev/null @@ -1,28 +0,0 @@ -module Wizard.Api.Handler.Migration.KnowledgeModel.List_Current_DELETE where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Model.Context.BaseContext -import Wizard.Service.KnowledgeModel.Migration.MigrationService - -type List_Current_DELETE = - Header "Authorization" String - :> Header "Host" String - :> "knowledge-model-editors" - :> Capture "bUuid" U.UUID - :> "migrations" - :> "current" - :> Verb DELETE 204 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] NoContent) - -list_current_DELETE - :: Maybe String -> Maybe String -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] NoContent) -list_current_DELETE mTokenHeader mServerUrl bUuid = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService Transactional $ - addTraceUuidHeader =<< do - deleteCurrentMigration bUuid - return NoContent diff --git a/wizard-server/src/Wizard/Api/Handler/Migration/KnowledgeModel/List_Current_GET.hs b/wizard-server/src/Wizard/Api/Handler/Migration/KnowledgeModel/List_Current_GET.hs deleted file mode 100644 index d224b9fab..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Migration/KnowledgeModel/List_Current_GET.hs +++ /dev/null @@ -1,27 +0,0 @@ -module Wizard.Api.Handler.Migration.KnowledgeModel.List_Current_GET where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationDTO -import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationStateJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.KnowledgeModel.Migration.MigrationService - -type List_Current_GET = - Header "Authorization" String - :> Header "Host" String - :> "knowledge-model-editors" - :> Capture "bUuid" U.UUID - :> "migrations" - :> "current" - :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] KnowledgeModelMigrationDTO) - -list_current_GET - :: Maybe String -> Maybe String -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] KnowledgeModelMigrationDTO) -list_current_GET mTokenHeader mServerUrl bUuid = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService NoTransaction $ addTraceUuidHeader =<< getCurrentMigrationDto bUuid diff --git a/wizard-server/src/Wizard/Api/Handler/Migration/KnowledgeModel/List_Current_POST.hs b/wizard-server/src/Wizard/Api/Handler/Migration/KnowledgeModel/List_Current_POST.hs deleted file mode 100644 index d1e242864..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Migration/KnowledgeModel/List_Current_POST.hs +++ /dev/null @@ -1,34 +0,0 @@ -module Wizard.Api.Handler.Migration.KnowledgeModel.List_Current_POST where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationCreateDTO -import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationCreateJM () -import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationDTO -import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationStateJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.KnowledgeModel.Migration.MigrationService - -type List_Current_POST = - Header "Authorization" String - :> Header "Host" String - :> ReqBody '[SafeJSON] KnowledgeModelMigrationCreateDTO - :> "knowledge-model-editors" - :> Capture "bUuid" U.UUID - :> "migrations" - :> "current" - :> Verb 'POST 201 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] KnowledgeModelMigrationDTO) - -list_current_POST - :: Maybe String - -> Maybe String - -> KnowledgeModelMigrationCreateDTO - -> U.UUID - -> BaseContextM (Headers '[Header "x-trace-uuid" String] KnowledgeModelMigrationDTO) -list_current_POST mTokenHeader mServerUrl reqDto bUuid = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService Transactional $ addTraceUuidHeader =<< createMigration bUuid reqDto diff --git a/wizard-server/src/Wizard/Api/Handler/Migration/Questionnaire/Api.hs b/wizard-server/src/Wizard/Api/Handler/Migration/Questionnaire/Api.hs deleted file mode 100644 index e22d62341..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Migration/Questionnaire/Api.hs +++ /dev/null @@ -1,27 +0,0 @@ -module Wizard.Api.Handler.Migration.Questionnaire.Api where - -import Servant -import Servant.Swagger.Tags - -import Wizard.Api.Handler.Migration.Questionnaire.List_Current_Completion_POST -import Wizard.Api.Handler.Migration.Questionnaire.List_Current_DELETE -import Wizard.Api.Handler.Migration.Questionnaire.List_Current_GET -import Wizard.Api.Handler.Migration.Questionnaire.List_Current_PUT -import Wizard.Api.Handler.Migration.Questionnaire.List_POST -import Wizard.Model.Context.BaseContext - -type MigrationAPI = - Tags "Questionnaire Migration" - :> ( List_POST - :<|> List_Current_GET - :<|> List_Current_PUT - :<|> List_Current_DELETE - :<|> List_Current_Completion_POST - ) - -migrationApi :: Proxy MigrationAPI -migrationApi = Proxy - -migrationServer :: ServerT MigrationAPI BaseContextM -migrationServer = - list_POST :<|> list_current_GET :<|> list_current_PUT :<|> list_current_DELETE :<|> list_current_completion_POST diff --git a/wizard-server/src/Wizard/Api/Handler/Migration/Questionnaire/List_Current_Completion_POST.hs b/wizard-server/src/Wizard/Api/Handler/Migration/Questionnaire/List_Current_Completion_POST.hs deleted file mode 100644 index 2b28b0aa5..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Migration/Questionnaire/List_Current_Completion_POST.hs +++ /dev/null @@ -1,29 +0,0 @@ -module Wizard.Api.Handler.Migration.Questionnaire.List_Current_Completion_POST where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Model.Context.BaseContext -import Wizard.Service.Questionnaire.Migration.MigrationService - -type List_Current_Completion_POST = - Header "Authorization" String - :> Header "Host" String - :> "questionnaires" - :> Capture "qtnUuid" U.UUID - :> "migrations" - :> "current" - :> "completion" - :> Verb POST 204 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] NoContent) - -list_current_completion_POST - :: Maybe String -> Maybe String -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] NoContent) -list_current_completion_POST mTokenHeader mServerUrl qtnUuid = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService Transactional $ - addTraceUuidHeader =<< do - finishQuestionnaireMigration qtnUuid - return NoContent diff --git a/wizard-server/src/Wizard/Api/Handler/Migration/Questionnaire/List_Current_DELETE.hs b/wizard-server/src/Wizard/Api/Handler/Migration/Questionnaire/List_Current_DELETE.hs deleted file mode 100644 index 933f4ab27..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Migration/Questionnaire/List_Current_DELETE.hs +++ /dev/null @@ -1,28 +0,0 @@ -module Wizard.Api.Handler.Migration.Questionnaire.List_Current_DELETE where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Model.Context.BaseContext -import Wizard.Service.Questionnaire.Migration.MigrationService - -type List_Current_DELETE = - Header "Authorization" String - :> Header "Host" String - :> "questionnaires" - :> Capture "qtnUuid" U.UUID - :> "migrations" - :> "current" - :> Verb DELETE 204 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] NoContent) - -list_current_DELETE - :: Maybe String -> Maybe String -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] NoContent) -list_current_DELETE mTokenHeader mServerUrl qtnUuid = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService Transactional $ - addTraceUuidHeader =<< do - cancelQuestionnaireMigration qtnUuid - return NoContent diff --git a/wizard-server/src/Wizard/Api/Handler/Migration/Questionnaire/List_Current_GET.hs b/wizard-server/src/Wizard/Api/Handler/Migration/Questionnaire/List_Current_GET.hs deleted file mode 100644 index a5bb2986b..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Migration/Questionnaire/List_Current_GET.hs +++ /dev/null @@ -1,27 +0,0 @@ -module Wizard.Api.Handler.Migration.Questionnaire.List_Current_GET where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateDTO -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.Questionnaire.Migration.MigrationService - -type List_Current_GET = - Header "Authorization" String - :> Header "Host" String - :> "questionnaires" - :> Capture "qtnUuid" U.UUID - :> "migrations" - :> "current" - :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] MigratorStateDTO) - -list_current_GET - :: Maybe String -> Maybe String -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] MigratorStateDTO) -list_current_GET mTokenHeader mServerUrl qtnUuid = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService NoTransaction $ addTraceUuidHeader =<< getQuestionnaireMigration qtnUuid diff --git a/wizard-server/src/Wizard/Api/Handler/Migration/Questionnaire/List_Current_PUT.hs b/wizard-server/src/Wizard/Api/Handler/Migration/Questionnaire/List_Current_PUT.hs deleted file mode 100644 index 5afb2494e..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Migration/Questionnaire/List_Current_PUT.hs +++ /dev/null @@ -1,34 +0,0 @@ -module Wizard.Api.Handler.Migration.Questionnaire.List_Current_PUT where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateChangeDTO -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateChangeJM () -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateDTO -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.Questionnaire.Migration.MigrationService - -type List_Current_PUT = - Header "Authorization" String - :> Header "Host" String - :> ReqBody '[SafeJSON] MigratorStateChangeDTO - :> "questionnaires" - :> Capture "qtnUuid" U.UUID - :> "migrations" - :> "current" - :> Put '[SafeJSON] (Headers '[Header "x-trace-uuid" String] MigratorStateDTO) - -list_current_PUT - :: Maybe String - -> Maybe String - -> MigratorStateChangeDTO - -> U.UUID - -> BaseContextM (Headers '[Header "x-trace-uuid" String] MigratorStateDTO) -list_current_PUT mTokenHeader mServerUrl reqDto qtnUuid = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService Transactional $ addTraceUuidHeader =<< modifyQuestionnaireMigration qtnUuid reqDto diff --git a/wizard-server/src/Wizard/Api/Handler/Migration/Questionnaire/List_POST.hs b/wizard-server/src/Wizard/Api/Handler/Migration/Questionnaire/List_POST.hs deleted file mode 100644 index 0d4b87f7a..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Migration/Questionnaire/List_POST.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Wizard.Api.Handler.Migration.Questionnaire.List_POST where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateCreateDTO -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateCreateJM () -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateDTO -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.Questionnaire.Migration.MigrationService - -type List_POST = - Header "Authorization" String - :> Header "Host" String - :> ReqBody '[SafeJSON] MigratorStateCreateDTO - :> "questionnaires" - :> Capture "qtnUuid" U.UUID - :> "migrations" - :> Verb 'POST 201 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] MigratorStateDTO) - -list_POST - :: Maybe String - -> Maybe String - -> MigratorStateCreateDTO - -> U.UUID - -> BaseContextM (Headers '[Header "x-trace-uuid" String] MigratorStateDTO) -list_POST mTokenHeader mServerUrl reqDto qtnUuid = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService Transactional $ addTraceUuidHeader =<< createQuestionnaireMigration qtnUuid reqDto diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Api.hs b/wizard-server/src/Wizard/Api/Handler/Project/Api.hs new file mode 100644 index 000000000..ac4c8a2b1 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Api.hs @@ -0,0 +1,91 @@ +module Wizard.Api.Handler.Project.Api where + +import Servant +import Servant.Swagger.Tags + +import Wizard.Api.Handler.Project.Comment.Api +import Wizard.Api.Handler.Project.Detail_Content_PUT +import Wizard.Api.Handler.Project.Detail_DELETE +import Wizard.Api.Handler.Project.Detail_Documents_GET +import Wizard.Api.Handler.Project.Detail_Documents_Preview_GET +import Wizard.Api.Handler.Project.Detail_GET +import Wizard.Api.Handler.Project.Detail_Preview_GET +import Wizard.Api.Handler.Project.Detail_Questionnaire_GET +import Wizard.Api.Handler.Project.Detail_Report_GET +import Wizard.Api.Handler.Project.Detail_Revert_POST +import Wizard.Api.Handler.Project.Detail_Revert_Preview_POST +import Wizard.Api.Handler.Project.Detail_Settings_GET +import Wizard.Api.Handler.Project.Detail_Settings_PUT +import Wizard.Api.Handler.Project.Detail_Share_PUT +import Wizard.Api.Handler.Project.Detail_WS +import Wizard.Api.Handler.Project.Event.Api +import Wizard.Api.Handler.Project.File.Api +import Wizard.Api.Handler.Project.List_GET +import Wizard.Api.Handler.Project.List_POST +import Wizard.Api.Handler.Project.List_POST_CloneUuid +import Wizard.Api.Handler.Project.List_POST_FromTemplate +import Wizard.Api.Handler.Project.Migration.Api +import Wizard.Api.Handler.Project.Tag.Api +import Wizard.Api.Handler.Project.User.Api +import Wizard.Api.Handler.Project.Version.Api +import Wizard.Model.Context.BaseContext + +type ProjectAPI = + Tags "Project" + :> ( List_GET + :<|> List_POST + :<|> List_POST_FromTemplate + :<|> List_POST_CloneUuid + :<|> Detail_GET + :<|> Detail_Questionnaire_GET + :<|> Detail_Preview_GET + :<|> Detail_Settings_GET + :<|> Detail_Settings_PUT + :<|> Detail_Share_PUT + :<|> Detail_DELETE + :<|> Detail_Content_PUT + :<|> Detail_Report_GET + :<|> Detail_Documents_GET + :<|> Detail_Documents_Preview_GET + :<|> Detail_WS + :<|> Detail_Revert_POST + :<|> Detail_Revert_Preview_POST + :<|> CommentAPI + :<|> EventAPI + :<|> FileAPI + :<|> MigrationAPI + :<|> TagAPI + :<|> UserAPI + :<|> VersionAPI + ) + +projectApi :: Proxy ProjectAPI +projectApi = Proxy + +projectServer :: ServerT ProjectAPI BaseContextM +projectServer = + list_GET + :<|> list_POST + :<|> list_POST_FromTemplate + :<|> list_POST_CloneUuid + :<|> detail_GET + :<|> detail_questionnaire_GET + :<|> detail_preview_GET + :<|> detail_settings_GET + :<|> detail_settings_PUT + :<|> detail_share_PUT + :<|> detail_DELETE + :<|> detail_content_PUT + :<|> detail_report_GET + :<|> detail_documents_GET + :<|> detail_documents_preview_GET + :<|> detail_WS + :<|> detail_revert_POST + :<|> detail_revert_preview_POST + :<|> commentServer + :<|> eventServer + :<|> fileServer + :<|> migrationServer + :<|> tagServer + :<|> userServer + :<|> versionServer diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Comment/Api.hs b/wizard-server/src/Wizard/Api/Handler/Project/Comment/Api.hs new file mode 100644 index 000000000..3e4f35cfc --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Comment/Api.hs @@ -0,0 +1,17 @@ +module Wizard.Api.Handler.Project.Comment.Api where + +import Servant +import Servant.Swagger.Tags + +import Wizard.Api.Handler.Project.Comment.List_GET +import Wizard.Model.Context.BaseContext + +type CommentAPI = + Tags "Project Comment" + :> List_GET + +commentApi :: Proxy CommentAPI +commentApi = Proxy + +commentServer :: ServerT CommentAPI BaseContextM +commentServer = list_GET diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Comment/List_GET.hs b/wizard-server/src/Wizard/Api/Handler/Project/Comment/List_GET.hs new file mode 100644 index 000000000..77df6ef26 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Comment/List_GET.hs @@ -0,0 +1,34 @@ +module Wizard.Api.Handler.Project.Comment.List_GET where + +import qualified Data.Map.Strict as M +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.Comment.ProjectCommentThreadListJM () +import Wizard.Model.Context.BaseContext +import Wizard.Model.Project.Comment.ProjectCommentList +import Wizard.Service.Project.Comment.ProjectCommentService + +type List_GET = + Header "Authorization" String + :> Header "Host" String + :> "projects" + :> Capture "uuid" U.UUID + :> QueryParam "path" String + :> QueryParam "resolved" Bool + :> "comments" + :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (M.Map String [ProjectCommentThreadList])) + +list_GET + :: Maybe String + -> Maybe String + -> U.UUID + -> Maybe String + -> Maybe Bool + -> BaseContextM (Headers '[Header "x-trace-uuid" String] (M.Map String [ProjectCommentThreadList])) +list_GET mTokenHeader mServerUrl uuid mPath mResolved = + getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService NoTransaction $ addTraceUuidHeader =<< getProjectCommentsByProjectUuid uuid mPath mResolved diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Detail_Content_PUT.hs b/wizard-server/src/Wizard/Api/Handler/Project/Detail_Content_PUT.hs new file mode 100644 index 000000000..6af4ff057 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Detail_Content_PUT.hs @@ -0,0 +1,31 @@ +module Wizard.Api.Handler.Project.Detail_Content_PUT where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.ProjectContentChangeDTO +import Wizard.Api.Resource.Project.ProjectContentChangeJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.ProjectService + +type Detail_Content_PUT = + Header "Authorization" String + :> Header "Host" String + :> ReqBody '[SafeJSON] ProjectContentChangeDTO + :> "projects" + :> Capture "uuid" U.UUID + :> "content" + :> Put '[SafeJSON] (Headers '[Header "x-trace-uuid" String] ProjectContentChangeDTO) + +detail_content_PUT + :: Maybe String + -> Maybe String + -> ProjectContentChangeDTO + -> U.UUID + -> BaseContextM (Headers '[Header "x-trace-uuid" String] ProjectContentChangeDTO) +detail_content_PUT mTokenHeader mServerUrl reqDto uuid = + getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService Transactional $ addTraceUuidHeader =<< modifyContent uuid reqDto diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Detail_DELETE.hs b/wizard-server/src/Wizard/Api/Handler/Project/Detail_DELETE.hs new file mode 100644 index 000000000..5d5b8b117 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Detail_DELETE.hs @@ -0,0 +1,26 @@ +module Wizard.Api.Handler.Project.Detail_DELETE where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.ProjectService + +type Detail_DELETE = + Header "Authorization" String + :> Header "Host" String + :> "projects" + :> Capture "uuid" U.UUID + :> Verb DELETE 204 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] NoContent) + +detail_DELETE + :: Maybe String -> Maybe String -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] NoContent) +detail_DELETE mTokenHeader mServerUrl uuid = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService Transactional $ + addTraceUuidHeader =<< do + deleteProject uuid True + return NoContent diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Detail_Documents_GET.hs b/wizard-server/src/Wizard/Api/Handler/Project/Detail_Documents_GET.hs new file mode 100644 index 000000000..65f427b81 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Detail_Documents_GET.hs @@ -0,0 +1,40 @@ +module Wizard.Api.Handler.Project.Detail_Documents_GET where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.Pageable +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Document.DocumentDTO +import Wizard.Api.Resource.Document.DocumentJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.Document.DocumentService + +type Detail_Documents_GET = + Header "Authorization" String + :> Header "Host" String + :> "projects" + :> Capture "uuid" U.UUID + :> "documents" + :> QueryParam "q" String + :> QueryParam "page" Int + :> QueryParam "size" Int + :> QueryParam "sort" String + :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (Page DocumentDTO)) + +detail_documents_GET + :: Maybe String + -> Maybe String + -> U.UUID + -> Maybe String + -> Maybe Int + -> Maybe Int + -> Maybe String + -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page DocumentDTO)) +detail_documents_GET mTokenHeader mServerUrl uuid mQuery mPage mSize mSort = + getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService NoTransaction $ + addTraceUuidHeader =<< getDocumentsForProject uuid mQuery (Pageable mPage mSize) (parseSortQuery mSort) diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Documents_Preview_GET.hs b/wizard-server/src/Wizard/Api/Handler/Project/Detail_Documents_Preview_GET.hs similarity index 76% rename from wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Documents_Preview_GET.hs rename to wizard-server/src/Wizard/Api/Handler/Project/Detail_Documents_Preview_GET.hs index eeb6c79c7..081adc72e 100644 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Documents_Preview_GET.hs +++ b/wizard-server/src/Wizard/Api/Handler/Project/Detail_Documents_Preview_GET.hs @@ -1,4 +1,4 @@ -module Wizard.Api.Handler.Questionnaire.Detail_Documents_Preview_GET where +module Wizard.Api.Handler.Project.Detail_Documents_Preview_GET where import qualified Data.UUID as U import Servant @@ -17,8 +17,8 @@ import WizardLib.Public.Api.Resource.TemporaryFile.TemporaryFileJM () type Detail_Documents_Preview_GET = Header "Authorization" String :> Header "Host" String - :> "questionnaires" - :> Capture "qtnUuid" U.UUID + :> "projects" + :> Capture "uuid" U.UUID :> "documents" :> "preview" :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] TemporaryFileDTO) @@ -28,12 +28,12 @@ detail_documents_preview_GET -> Maybe String -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] TemporaryFileDTO) -detail_documents_preview_GET mTokenHeader mServerUrl qtnUuid = +detail_documents_preview_GET mTokenHeader mServerUrl uuid = getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInMaybeAuthService -> runInMaybeAuthService Transactional $ do - (doc, fileDto) <- createDocumentPreviewForQtn qtnUuid + (doc, fileDto) <- createDocumentPreviewForProject uuid case doc.state of DoneDocumentState -> addTraceUuidHeader fileDto ErrorDocumentState -> - throwError $ SystemLogError (_ERROR_SERVICE_QTN__UNABLE_TO_GENERATE_DOCUMENT_PREVIEW $ doc.workerLog) + throwError $ SystemLogError (_ERROR_SERVICE_PROJECT__UNABLE_TO_GENERATE_DOCUMENT_PREVIEW $ doc.workerLog) _ -> throwError AcceptedError diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Detail_GET.hs b/wizard-server/src/Wizard/Api/Handler/Project/Detail_GET.hs new file mode 100644 index 000000000..34373cd5c --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Detail_GET.hs @@ -0,0 +1,25 @@ +module Wizard.Api.Handler.Project.Detail_GET where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.Detail.ProjectDetailDTO +import Wizard.Api.Resource.Project.Detail.ProjectDetailJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.ProjectService + +type Detail_GET = + Header "Authorization" String + :> Header "Host" String + :> "projects" + :> Capture "uuid" U.UUID + :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] ProjectDetailDTO) + +detail_GET + :: Maybe String -> Maybe String -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] ProjectDetailDTO) +detail_GET mTokenHeader mServerUrl uuid = + getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService NoTransaction $ addTraceUuidHeader =<< getProjectDetailByUuid uuid diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Detail_Preview_GET.hs b/wizard-server/src/Wizard/Api/Handler/Project/Detail_Preview_GET.hs new file mode 100644 index 000000000..ccb930e4c --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Detail_Preview_GET.hs @@ -0,0 +1,29 @@ +module Wizard.Api.Handler.Project.Detail_Preview_GET where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.Detail.ProjectDetailPreviewJM () +import Wizard.Model.Context.BaseContext +import Wizard.Model.Project.Detail.ProjectDetailPreview +import Wizard.Service.Project.ProjectService + +type Detail_Preview_GET = + Header "Authorization" String + :> Header "Host" String + :> "projects" + :> Capture "uuid" U.UUID + :> "preview" + :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] ProjectDetailPreview) + +detail_preview_GET + :: Maybe String + -> Maybe String + -> U.UUID + -> BaseContextM (Headers '[Header "x-trace-uuid" String] ProjectDetailPreview) +detail_preview_GET mTokenHeader mServerUrl uuid = + getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService NoTransaction $ addTraceUuidHeader =<< getProjectDetailPreviewById uuid diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Detail_Questionnaire_GET.hs b/wizard-server/src/Wizard/Api/Handler/Project/Detail_Questionnaire_GET.hs new file mode 100644 index 000000000..deba28871 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Detail_Questionnaire_GET.hs @@ -0,0 +1,29 @@ +module Wizard.Api.Handler.Project.Detail_Questionnaire_GET where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.Detail.ProjectDetailQuestionnaireDTO +import Wizard.Api.Resource.Project.Detail.ProjectDetailQuestionnaireJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.ProjectService + +type Detail_Questionnaire_GET = + Header "Authorization" String + :> Header "Host" String + :> "projects" + :> Capture "uuid" U.UUID + :> "questionnaire" + :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] ProjectDetailQuestionnaireDTO) + +detail_questionnaire_GET + :: Maybe String + -> Maybe String + -> U.UUID + -> BaseContextM (Headers '[Header "x-trace-uuid" String] ProjectDetailQuestionnaireDTO) +detail_questionnaire_GET mTokenHeader mServerUrl uuid = + getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService NoTransaction $ addTraceUuidHeader =<< getProjectDetailQuestionnaireByUuid uuid diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Detail_Report_GET.hs b/wizard-server/src/Wizard/Api/Handler/Project/Detail_Report_GET.hs new file mode 100644 index 000000000..88e6f5701 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Detail_Report_GET.hs @@ -0,0 +1,26 @@ +module Wizard.Api.Handler.Project.Detail_Report_GET where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.Detail.ProjectDetailReportDTO +import Wizard.Api.Resource.Project.Detail.ProjectDetailReportJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.Report.ReportService + +type Detail_Report_GET = + Header "Authorization" String + :> Header "Host" String + :> "projects" + :> Capture "uuid" U.UUID + :> "report" + :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] ProjectDetailReportDTO) + +detail_report_GET + :: Maybe String -> Maybe String -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] ProjectDetailReportDTO) +detail_report_GET mTokenHeader mServerUrl uuid = + getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService NoTransaction $ addTraceUuidHeader =<< getReportByProjectUuid uuid diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Detail_Revert_POST.hs b/wizard-server/src/Wizard/Api/Handler/Project/Detail_Revert_POST.hs new file mode 100644 index 000000000..2ded60c5b --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Detail_Revert_POST.hs @@ -0,0 +1,33 @@ +module Wizard.Api.Handler.Project.Detail_Revert_POST where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.ProjectContentDTO +import Wizard.Api.Resource.Project.ProjectContentJM () +import Wizard.Api.Resource.Project.Version.ProjectVersionRevertDTO +import Wizard.Api.Resource.Project.Version.ProjectVersionRevertJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.Version.ProjectVersionService + +type Detail_Revert_POST = + Header "Authorization" String + :> Header "Host" String + :> ReqBody '[SafeJSON] ProjectVersionRevertDTO + :> "projects" + :> Capture "uuid" U.UUID + :> "revert" + :> Post '[SafeJSON] (Headers '[Header "x-trace-uuid" String] ProjectContentDTO) + +detail_revert_POST + :: Maybe String + -> Maybe String + -> ProjectVersionRevertDTO + -> U.UUID + -> BaseContextM (Headers '[Header "x-trace-uuid" String] ProjectContentDTO) +detail_revert_POST mTokenHeader mServerUrl reqDto uuid = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService Transactional $ addTraceUuidHeader =<< revertToEvent uuid reqDto True diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Detail_Revert_Preview_POST.hs b/wizard-server/src/Wizard/Api/Handler/Project/Detail_Revert_Preview_POST.hs new file mode 100644 index 000000000..e71c5bb69 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Detail_Revert_Preview_POST.hs @@ -0,0 +1,34 @@ +module Wizard.Api.Handler.Project.Detail_Revert_Preview_POST where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.ProjectContentDTO +import Wizard.Api.Resource.Project.ProjectContentJM () +import Wizard.Api.Resource.Project.Version.ProjectVersionRevertDTO +import Wizard.Api.Resource.Project.Version.ProjectVersionRevertJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.Version.ProjectVersionService + +type Detail_Revert_Preview_POST = + Header "Authorization" String + :> Header "Host" String + :> ReqBody '[SafeJSON] ProjectVersionRevertDTO + :> "projects" + :> Capture "uuid" U.UUID + :> "revert" + :> "preview" + :> Post '[SafeJSON] (Headers '[Header "x-trace-uuid" String] ProjectContentDTO) + +detail_revert_preview_POST + :: Maybe String + -> Maybe String + -> ProjectVersionRevertDTO + -> U.UUID + -> BaseContextM (Headers '[Header "x-trace-uuid" String] ProjectContentDTO) +detail_revert_preview_POST mTokenHeader mServerUrl reqDto uuid = + getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService Transactional $ addTraceUuidHeader =<< revertToEvent uuid reqDto False diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Detail_Settings_GET.hs b/wizard-server/src/Wizard/Api/Handler/Project/Detail_Settings_GET.hs new file mode 100644 index 000000000..2562dd24b --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Detail_Settings_GET.hs @@ -0,0 +1,29 @@ +module Wizard.Api.Handler.Project.Detail_Settings_GET where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.Detail.ProjectDetailSettingsJM () +import Wizard.Model.Context.BaseContext +import Wizard.Model.Project.Detail.ProjectDetailSettings +import Wizard.Service.Project.ProjectService + +type Detail_Settings_GET = + Header "Authorization" String + :> Header "Host" String + :> "projects" + :> Capture "uuid" U.UUID + :> "settings" + :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] ProjectDetailSettings) + +detail_settings_GET + :: Maybe String + -> Maybe String + -> U.UUID + -> BaseContextM (Headers '[Header "x-trace-uuid" String] ProjectDetailSettings) +detail_settings_GET mTokenHeader mServerUrl uuid = + getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService NoTransaction $ addTraceUuidHeader =<< getProjectDetailSettingsById uuid diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Detail_Settings_PUT.hs b/wizard-server/src/Wizard/Api/Handler/Project/Detail_Settings_PUT.hs new file mode 100644 index 000000000..e781737b9 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Detail_Settings_PUT.hs @@ -0,0 +1,31 @@ +module Wizard.Api.Handler.Project.Detail_Settings_PUT where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.ProjectSettingsChangeDTO +import Wizard.Api.Resource.Project.ProjectSettingsChangeJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.ProjectService + +type Detail_Settings_PUT = + Header "Authorization" String + :> Header "Host" String + :> ReqBody '[SafeJSON] ProjectSettingsChangeDTO + :> "projects" + :> Capture "uuid" U.UUID + :> "settings" + :> Put '[SafeJSON] (Headers '[Header "x-trace-uuid" String] ProjectSettingsChangeDTO) + +detail_settings_PUT + :: Maybe String + -> Maybe String + -> ProjectSettingsChangeDTO + -> U.UUID + -> BaseContextM (Headers '[Header "x-trace-uuid" String] ProjectSettingsChangeDTO) +detail_settings_PUT mTokenHeader mServerUrl reqDto uuid = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService Transactional $ addTraceUuidHeader =<< modifyProjectSettings uuid reqDto diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Detail_Share_PUT.hs b/wizard-server/src/Wizard/Api/Handler/Project/Detail_Share_PUT.hs new file mode 100644 index 000000000..ea952611c --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Detail_Share_PUT.hs @@ -0,0 +1,31 @@ +module Wizard.Api.Handler.Project.Detail_Share_PUT where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.ProjectShareChangeDTO +import Wizard.Api.Resource.Project.ProjectShareChangeJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.ProjectService + +type Detail_Share_PUT = + Header "Authorization" String + :> Header "Host" String + :> ReqBody '[SafeJSON] ProjectShareChangeDTO + :> "projects" + :> Capture "uuid" U.UUID + :> "share" + :> Put '[SafeJSON] (Headers '[Header "x-trace-uuid" String] ProjectShareChangeDTO) + +detail_share_PUT + :: Maybe String + -> Maybe String + -> ProjectShareChangeDTO + -> U.UUID + -> BaseContextM (Headers '[Header "x-trace-uuid" String] ProjectShareChangeDTO) +detail_share_PUT mTokenHeader mServerUrl reqDto uuid = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService Transactional $ addTraceUuidHeader =<< modifyProjectShare uuid reqDto diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Detail_WS.hs b/wizard-server/src/Wizard/Api/Handler/Project/Detail_WS.hs new file mode 100644 index 000000000..9f8da2647 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Detail_WS.hs @@ -0,0 +1,52 @@ +module Wizard.Api.Handler.Project.Detail_WS where + +import Control.Monad.Except (catchError) +import qualified Data.UUID as U +import Network.WebSockets +import Servant +import Servant.API.WebSocket +import Prelude hiding (log) + +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Handler.Websocket +import Wizard.Api.Resource.Websocket.ProjectMessageDTO +import Wizard.Api.Resource.Websocket.ProjectMessageJM () +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.Collaboration.ProjectCollaborationService +import Wizard.Util.Websocket + +type Detail_WS = + Header "Host" String + :> "projects" + :> Capture "uuid" U.UUID + :> "websocket" + :> QueryParam "Authorization" String + :> WebSocket + +detail_WS :: Maybe String -> U.UUID -> Maybe String -> Connection -> BaseContextM () +detail_WS mServerUrl projectUuid mTokenHeader connection = + getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInMaybeAuthService -> + runInMaybeAuthService NoTransaction $ do + connectionUuid <- initConnection + catchError + (putUserOnline projectUuid connectionUuid connection) + (sendError connectionUuid connection (U.toString projectUuid) disconnectUser) + handleMessage projectUuid connectionUuid connection + +handleMessage :: U.UUID -> U.UUID -> Connection -> AppContextM () +handleMessage projectUuid connectionUuid connection = + handleWebsocketMessage (U.toString projectUuid) connectionUuid connection handleClose disconnectUser handleAction continue + where + continue :: AppContextM () + continue = handleMessage projectUuid connectionUuid connection + -- ------------------------------------------------------------------------------------ + handleClose :: AppContextM () + handleClose = deleteUser projectUuid connectionUuid + -- ------------------------------------------------------------------------------------ + handleAction :: ClientProjectMessageDTO -> AppContextM () + handleAction (SetContent_ClientProjectMessageDTO reqDto) = do + log connectionUuid "SetContent" + setContent projectUuid connectionUuid reqDto + handleMessage projectUuid connectionUuid connection diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Event/Api.hs b/wizard-server/src/Wizard/Api/Handler/Project/Event/Api.hs new file mode 100644 index 000000000..a4ed54334 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Event/Api.hs @@ -0,0 +1,20 @@ +module Wizard.Api.Handler.Project.Event.Api where + +import Servant +import Servant.Swagger.Tags + +import Wizard.Api.Handler.Project.Event.Detail_GET +import Wizard.Api.Handler.Project.Event.List_GET +import Wizard.Model.Context.BaseContext + +type EventAPI = + Tags "Project Event" + :> ( List_GET + :<|> Detail_GET + ) + +eventApi :: Proxy EventAPI +eventApi = Proxy + +eventServer :: ServerT EventAPI BaseContextM +eventServer = list_GET :<|> detail_GET diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Event/Detail_GET.hs b/wizard-server/src/Wizard/Api/Handler/Project/Event/Detail_GET.hs new file mode 100644 index 000000000..210f1463d --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Event/Detail_GET.hs @@ -0,0 +1,31 @@ +module Wizard.Api.Handler.Project.Event.Detail_GET where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.Event.ProjectEventDTO +import Wizard.Api.Resource.Project.Event.ProjectEventJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.ProjectService + +type Detail_GET = + Header "Authorization" String + :> Header "Host" String + :> "projects" + :> Capture "projectUuid" U.UUID + :> "events" + :> Capture "eventUuid" U.UUID + :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] ProjectEventDTO) + +detail_GET + :: Maybe String + -> Maybe String + -> U.UUID + -> U.UUID + -> BaseContextM (Headers '[Header "x-trace-uuid" String] ProjectEventDTO) +detail_GET mTokenHeader mServerUrl projectUuid eventUuid = + getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService NoTransaction $ addTraceUuidHeader =<< getProjectEventForProjectUuid projectUuid eventUuid diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Event/List_GET.hs b/wizard-server/src/Wizard/Api/Handler/Project/Event/List_GET.hs new file mode 100644 index 000000000..3eae18d15 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Event/List_GET.hs @@ -0,0 +1,39 @@ +module Wizard.Api.Handler.Project.Event.List_GET where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.Pageable +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.Event.ProjectEventListJM () +import Wizard.Model.Context.BaseContext +import Wizard.Model.Project.Event.ProjectEventList +import Wizard.Service.Project.ProjectService + +type List_GET = + Header "Authorization" String + :> Header "Host" String + :> "projects" + :> Capture "uuid" U.UUID + :> "events" + :> QueryParam "page" Int + :> QueryParam "size" Int + :> QueryParam "sort" String + :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (Page ProjectEventList)) + +list_GET + :: Maybe String + -> Maybe String + -> U.UUID + -> Maybe Int + -> Maybe Int + -> Maybe String + -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page ProjectEventList)) +list_GET mTokenHeader mServerUrl uuid mPage mSize mSort = + getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService NoTransaction $ + addTraceUuidHeader + =<< getProjectEventsPage uuid (Pageable mPage mSize) (parseSortQuery mSort) diff --git a/wizard-server/src/Wizard/Api/Handler/Project/File/Api.hs b/wizard-server/src/Wizard/Api/Handler/Project/File/Api.hs new file mode 100644 index 000000000..af907cc45 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/File/Api.hs @@ -0,0 +1,28 @@ +module Wizard.Api.Handler.Project.File.Api where + +import Servant +import Servant.Swagger.Tags + +import Wizard.Api.Handler.Project.File.Detail_DELETE +import Wizard.Api.Handler.Project.File.Detail_Download_GET +import Wizard.Api.Handler.Project.File.List_GET +import Wizard.Api.Handler.Project.File.List_POST +import Wizard.Model.Context.BaseContext + +type FileAPI = + Tags "Project File" + :> ( List_GET + :<|> List_POST + :<|> Detail_DELETE + :<|> Detail_Download_GET + ) + +fileApi :: Proxy FileAPI +fileApi = Proxy + +fileServer :: ServerT FileAPI BaseContextM +fileServer = + list_GET + :<|> list_POST + :<|> detail_DELETE + :<|> detail_download_GET diff --git a/wizard-server/src/Wizard/Api/Handler/Project/File/Detail_DELETE.hs b/wizard-server/src/Wizard/Api/Handler/Project/File/Detail_DELETE.hs new file mode 100644 index 000000000..a7155af6f --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/File/Detail_DELETE.hs @@ -0,0 +1,27 @@ +module Wizard.Api.Handler.Project.File.Detail_DELETE where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.File.ProjectFileService + +type Detail_DELETE = + Header "Authorization" String + :> Header "Host" String + :> "projects" + :> Capture "projectUuid" U.UUID + :> "files" + :> Capture "fileUuid" U.UUID + :> Verb DELETE 204 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] NoContent) + +detail_DELETE :: Maybe String -> Maybe String -> U.UUID -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] NoContent) +detail_DELETE mTokenHeader mServerUrl projectUuid fileUuid = + getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService Transactional $ + addTraceUuidHeader =<< do + deleteProjectFile projectUuid fileUuid + return NoContent diff --git a/wizard-server/src/Wizard/Api/Handler/Project/File/Detail_Download_GET.hs b/wizard-server/src/Wizard/Api/Handler/Project/File/Detail_Download_GET.hs new file mode 100644 index 000000000..62b50b80e --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/File/Detail_Download_GET.hs @@ -0,0 +1,26 @@ +module Wizard.Api.Handler.Project.File.Detail_Download_GET where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.File.ProjectFileService +import WizardLib.Public.Api.Resource.TemporaryFile.TemporaryFileDTO +import WizardLib.Public.Api.Resource.TemporaryFile.TemporaryFileJM () + +type Detail_Download_GET = + Header "Authorization" String + :> Header "Host" String + :> "projects" + :> Capture "projectUuid" U.UUID + :> "files" + :> Capture "fileUuid" U.UUID + :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] TemporaryFileDTO) + +detail_download_GET :: Maybe String -> Maybe String -> U.UUID -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] TemporaryFileDTO) +detail_download_GET mTokenHeader mServerUrl projectUuid fileUuid = + getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInMaybeAuthService -> + runInMaybeAuthService Transactional $ addTraceUuidHeader =<< downloadProjectFile projectUuid fileUuid diff --git a/wizard-server/src/Wizard/Api/Handler/Project/File/List_GET.hs b/wizard-server/src/Wizard/Api/Handler/Project/File/List_GET.hs new file mode 100644 index 000000000..ec4fece62 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/File/List_GET.hs @@ -0,0 +1,40 @@ +module Wizard.Api.Handler.Project.File.List_GET where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.Pageable +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.File.ProjectFileListJM () +import Wizard.Model.Context.BaseContext +import Wizard.Model.Project.File.ProjectFileList +import Wizard.Service.Project.File.ProjectFileService + +type List_GET = + Header "Authorization" String + :> Header "Host" String + :> "projects" + :> Capture "projectUuid" U.UUID + :> "files" + :> QueryParam "q" String + :> QueryParam "page" Int + :> QueryParam "size" Int + :> QueryParam "sort" String + :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (Page ProjectFileList)) + +list_GET + :: Maybe String + -> Maybe String + -> U.UUID + -> Maybe String + -> Maybe Int + -> Maybe Int + -> Maybe String + -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page ProjectFileList)) +list_GET mTokenHeader mServerUrl uuid mQuery mPage mSize mSort = + getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInMaybeAuthService -> + runInMaybeAuthService NoTransaction $ + addTraceUuidHeader =<< getProjectFilesPage mQuery (Just uuid) (Pageable mPage mSize) (parseSortQuery mSort) diff --git a/wizard-server/src/Wizard/Api/Handler/Project/File/List_POST.hs b/wizard-server/src/Wizard/Api/Handler/Project/File/List_POST.hs new file mode 100644 index 000000000..7844104d3 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/File/List_POST.hs @@ -0,0 +1,32 @@ +module Wizard.Api.Handler.Project.File.List_POST where + +import qualified Data.UUID as U +import Servant +import Servant.Multipart + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.File.FileCreateDTO +import Wizard.Api.Resource.File.FileCreateJM () +import Wizard.Api.Resource.Project.File.ProjectFileListJM () +import Wizard.Model.Context.BaseContext +import Wizard.Model.Project.File.ProjectFileList +import Wizard.Service.Project.File.ProjectFileService + +type List_POST = + Header "Authorization" String + :> Header "Host" String + :> MultipartForm Mem FileCreateDTO + :> "projects" + :> Capture "uuid" U.UUID + :> "files" + :> Capture "questionUuid" U.UUID + :> Verb 'POST 201 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] ProjectFileList) + +list_POST :: Maybe String -> Maybe String -> FileCreateDTO -> U.UUID -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] ProjectFileList) +list_POST mTokenHeader mServerUrl reqDto projectUuid questionUuid = + getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService Transactional $ + addTraceUuidHeader =<< do + createProjectFile projectUuid questionUuid reqDto diff --git a/wizard-server/src/Wizard/Api/Handler/Project/List_GET.hs b/wizard-server/src/Wizard/Api/Handler/Project/List_GET.hs new file mode 100644 index 000000000..30114b458 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/List_GET.hs @@ -0,0 +1,68 @@ +module Wizard.Api.Handler.Project.List_GET where + +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.Pageable +import Shared.Common.Model.Context.TransactionState +import Shared.Common.Util.String (splitOn) +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.ProjectDTO +import Wizard.Api.Resource.Project.ProjectJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.ProjectService + +type List_GET = + Header "Authorization" String + :> Header "Host" String + :> "projects" + :> QueryParam "q" String + :> QueryParam "isTemplate" Bool + :> QueryParam "isMigrating" Bool + :> QueryParam "projectTags" String + :> QueryParam "projectTagsOp" String + :> QueryParam "userUuids" String + :> QueryParam "userUuidsOp" String + :> QueryParam "knowledgeModelPackageIds" String + :> QueryParam "knowledgeModelPackageIdsOp" String + :> QueryParam "page" Int + :> QueryParam "size" Int + :> QueryParam "sort" String + :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (Page ProjectDTO)) + +list_GET + :: Maybe String + -> Maybe String + -> Maybe String + -> Maybe Bool + -> Maybe Bool + -> Maybe String + -> Maybe String + -> Maybe String + -> Maybe String + -> Maybe String + -> Maybe String + -> Maybe Int + -> Maybe Int + -> Maybe String + -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page ProjectDTO)) +list_GET mTokenHeader mServerUrl mQuery mIsTemplate mIsMigrating mProjectTagsL mProjectTagsOp mUserUuidsL mUserUuidsOp mKnowledgeModelPackageIdsL mKnowledgeModelPackageIdsOp mPage mSize mSort = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService NoTransaction $ + addTraceUuidHeader =<< do + let mUserUuids = fmap (splitOn ",") mUserUuidsL + let mProjectTags = fmap (splitOn ",") mProjectTagsL + let mKnowledgeModelPackageIds = fmap (splitOn ",") mKnowledgeModelPackageIdsL + getProjectsForCurrentUserPageDto + mQuery + mIsTemplate + mIsMigrating + mProjectTags + mProjectTagsOp + mUserUuids + mUserUuidsOp + mKnowledgeModelPackageIds + mKnowledgeModelPackageIdsOp + (Pageable mPage mSize) + (parseSortQuery mSort) diff --git a/wizard-server/src/Wizard/Api/Handler/Project/List_POST.hs b/wizard-server/src/Wizard/Api/Handler/Project/List_POST.hs new file mode 100644 index 000000000..a2cbb7156 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/List_POST.hs @@ -0,0 +1,29 @@ +module Wizard.Api.Handler.Project.List_POST where + +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.ProjectCreateDTO +import Wizard.Api.Resource.Project.ProjectCreateJM () +import Wizard.Api.Resource.Project.ProjectDTO +import Wizard.Api.Resource.Project.ProjectJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.ProjectService + +type List_POST = + Header "Authorization" String + :> Header "Host" String + :> ReqBody '[SafeJSON] ProjectCreateDTO + :> "projects" + :> Verb 'POST 201 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] ProjectDTO) + +list_POST + :: Maybe String + -> Maybe String + -> ProjectCreateDTO + -> BaseContextM (Headers '[Header "x-trace-uuid" String] ProjectDTO) +list_POST mTokenHeader mServerUrl reqDto = + getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInMaybeAuthService -> + runInMaybeAuthService Transactional $ addTraceUuidHeader =<< createProject reqDto diff --git a/wizard-server/src/Wizard/Api/Handler/Project/List_POST_CloneUuid.hs b/wizard-server/src/Wizard/Api/Handler/Project/List_POST_CloneUuid.hs new file mode 100644 index 000000000..21112fd59 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/List_POST_CloneUuid.hs @@ -0,0 +1,26 @@ +module Wizard.Api.Handler.Project.List_POST_CloneUuid where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.ProjectDTO +import Wizard.Api.Resource.Project.ProjectJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.ProjectService + +type List_POST_CloneUuid = + Header "Authorization" String + :> Header "Host" String + :> "projects" + :> Capture "uuid" U.UUID + :> "clone" + :> Verb 'POST 201 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] ProjectDTO) + +list_POST_CloneUuid + :: Maybe String -> Maybe String -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] ProjectDTO) +list_POST_CloneUuid mTokenHeader mServerUrl uuid = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService Transactional $ addTraceUuidHeader =<< cloneProject uuid diff --git a/wizard-server/src/Wizard/Api/Handler/Project/List_POST_FromTemplate.hs b/wizard-server/src/Wizard/Api/Handler/Project/List_POST_FromTemplate.hs new file mode 100644 index 000000000..e86fe4436 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/List_POST_FromTemplate.hs @@ -0,0 +1,30 @@ +module Wizard.Api.Handler.Project.List_POST_FromTemplate where + +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.ProjectCreateFromTemplateDTO +import Wizard.Api.Resource.Project.ProjectCreateFromTemplateJM () +import Wizard.Api.Resource.Project.ProjectDTO +import Wizard.Api.Resource.Project.ProjectJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.ProjectService + +type List_POST_FromTemplate = + Header "Authorization" String + :> Header "Host" String + :> ReqBody '[SafeJSON] ProjectCreateFromTemplateDTO + :> "projects" + :> "from-template" + :> Verb 'POST 201 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] ProjectDTO) + +list_POST_FromTemplate + :: Maybe String + -> Maybe String + -> ProjectCreateFromTemplateDTO + -> BaseContextM (Headers '[Header "x-trace-uuid" String] ProjectDTO) +list_POST_FromTemplate mTokenHeader mServerUrl reqDto = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService Transactional $ addTraceUuidHeader =<< createProjectFromTemplate reqDto diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Migration/Api.hs b/wizard-server/src/Wizard/Api/Handler/Project/Migration/Api.hs new file mode 100644 index 000000000..7d1a807d7 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Migration/Api.hs @@ -0,0 +1,31 @@ +module Wizard.Api.Handler.Project.Migration.Api where + +import Servant +import Servant.Swagger.Tags + +import Wizard.Api.Handler.Project.Migration.List_Current_Completion_POST +import Wizard.Api.Handler.Project.Migration.List_Current_DELETE +import Wizard.Api.Handler.Project.Migration.List_Current_GET +import Wizard.Api.Handler.Project.Migration.List_Current_PUT +import Wizard.Api.Handler.Project.Migration.List_POST +import Wizard.Model.Context.BaseContext + +type MigrationAPI = + Tags "Project Migration" + :> ( List_POST + :<|> List_Current_GET + :<|> List_Current_PUT + :<|> List_Current_DELETE + :<|> List_Current_Completion_POST + ) + +migrationApi :: Proxy MigrationAPI +migrationApi = Proxy + +migrationServer :: ServerT MigrationAPI BaseContextM +migrationServer = + list_POST + :<|> list_current_GET + :<|> list_current_PUT + :<|> list_current_DELETE + :<|> list_current_completion_POST diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Migration/List_Current_Completion_POST.hs b/wizard-server/src/Wizard/Api/Handler/Project/Migration/List_Current_Completion_POST.hs new file mode 100644 index 000000000..57a87d2db --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Migration/List_Current_Completion_POST.hs @@ -0,0 +1,29 @@ +module Wizard.Api.Handler.Project.Migration.List_Current_Completion_POST where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.Migration.ProjectMigrationService + +type List_Current_Completion_POST = + Header "Authorization" String + :> Header "Host" String + :> "projects" + :> Capture "uuid" U.UUID + :> "migrations" + :> "current" + :> "completion" + :> Verb POST 204 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] NoContent) + +list_current_completion_POST + :: Maybe String -> Maybe String -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] NoContent) +list_current_completion_POST mTokenHeader mServerUrl uuid = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService Transactional $ + addTraceUuidHeader =<< do + finishProjectMigration uuid + return NoContent diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Migration/List_Current_DELETE.hs b/wizard-server/src/Wizard/Api/Handler/Project/Migration/List_Current_DELETE.hs new file mode 100644 index 000000000..3878cebf1 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Migration/List_Current_DELETE.hs @@ -0,0 +1,28 @@ +module Wizard.Api.Handler.Project.Migration.List_Current_DELETE where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.Migration.ProjectMigrationService + +type List_Current_DELETE = + Header "Authorization" String + :> Header "Host" String + :> "projects" + :> Capture "uuid" U.UUID + :> "migrations" + :> "current" + :> Verb DELETE 204 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] NoContent) + +list_current_DELETE + :: Maybe String -> Maybe String -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] NoContent) +list_current_DELETE mTokenHeader mServerUrl uuid = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService Transactional $ + addTraceUuidHeader =<< do + cancelProjectMigration uuid + return NoContent diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Migration/List_Current_GET.hs b/wizard-server/src/Wizard/Api/Handler/Project/Migration/List_Current_GET.hs new file mode 100644 index 000000000..373ef134b --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Migration/List_Current_GET.hs @@ -0,0 +1,27 @@ +module Wizard.Api.Handler.Project.Migration.List_Current_GET where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.Migration.ProjectMigrationDTO +import Wizard.Api.Resource.Project.Migration.ProjectMigrationJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.Migration.ProjectMigrationService + +type List_Current_GET = + Header "Authorization" String + :> Header "Host" String + :> "projects" + :> Capture "uuid" U.UUID + :> "migrations" + :> "current" + :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] ProjectMigrationDTO) + +list_current_GET + :: Maybe String -> Maybe String -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] ProjectMigrationDTO) +list_current_GET mTokenHeader mServerUrl uuid = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService NoTransaction $ addTraceUuidHeader =<< getProjectMigration uuid diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Migration/List_Current_PUT.hs b/wizard-server/src/Wizard/Api/Handler/Project/Migration/List_Current_PUT.hs new file mode 100644 index 000000000..60e5c70f0 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Migration/List_Current_PUT.hs @@ -0,0 +1,34 @@ +module Wizard.Api.Handler.Project.Migration.List_Current_PUT where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.Migration.ProjectMigrationChangeDTO +import Wizard.Api.Resource.Project.Migration.ProjectMigrationChangeJM () +import Wizard.Api.Resource.Project.Migration.ProjectMigrationDTO +import Wizard.Api.Resource.Project.Migration.ProjectMigrationJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.Migration.ProjectMigrationService + +type List_Current_PUT = + Header "Authorization" String + :> Header "Host" String + :> ReqBody '[SafeJSON] ProjectMigrationChangeDTO + :> "projects" + :> Capture "uuid" U.UUID + :> "migrations" + :> "current" + :> Put '[SafeJSON] (Headers '[Header "x-trace-uuid" String] ProjectMigrationDTO) + +list_current_PUT + :: Maybe String + -> Maybe String + -> ProjectMigrationChangeDTO + -> U.UUID + -> BaseContextM (Headers '[Header "x-trace-uuid" String] ProjectMigrationDTO) +list_current_PUT mTokenHeader mServerUrl reqDto uuid = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService Transactional $ addTraceUuidHeader =<< modifyProjectMigration uuid reqDto diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Migration/List_POST.hs b/wizard-server/src/Wizard/Api/Handler/Project/Migration/List_POST.hs new file mode 100644 index 000000000..0b699b332 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Migration/List_POST.hs @@ -0,0 +1,33 @@ +module Wizard.Api.Handler.Project.Migration.List_POST where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.Migration.ProjectMigrationCreateDTO +import Wizard.Api.Resource.Project.Migration.ProjectMigrationCreateJM () +import Wizard.Api.Resource.Project.Migration.ProjectMigrationDTO +import Wizard.Api.Resource.Project.Migration.ProjectMigrationJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.Migration.ProjectMigrationService + +type List_POST = + Header "Authorization" String + :> Header "Host" String + :> ReqBody '[SafeJSON] ProjectMigrationCreateDTO + :> "projects" + :> Capture "uuid" U.UUID + :> "migrations" + :> Verb 'POST 201 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] ProjectMigrationDTO) + +list_POST + :: Maybe String + -> Maybe String + -> ProjectMigrationCreateDTO + -> U.UUID + -> BaseContextM (Headers '[Header "x-trace-uuid" String] ProjectMigrationDTO) +list_POST mTokenHeader mServerUrl reqDto uuid = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService Transactional $ addTraceUuidHeader =<< createProjectMigration uuid reqDto diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Tag/Api.hs b/wizard-server/src/Wizard/Api/Handler/Project/Tag/Api.hs new file mode 100644 index 000000000..9cd51d78a --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Tag/Api.hs @@ -0,0 +1,17 @@ +module Wizard.Api.Handler.Project.Tag.Api where + +import Servant +import Servant.Swagger.Tags + +import Wizard.Api.Handler.Project.Tag.List_Suggestions_GET +import Wizard.Model.Context.BaseContext + +type TagAPI = + Tags "Project Tag" + :> List_Suggestions_GET + +tagApi :: Proxy TagAPI +tagApi = Proxy + +tagServer :: ServerT TagAPI BaseContextM +tagServer = list_suggestions_GET diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Tag/List_Suggestions_GET.hs b/wizard-server/src/Wizard/Api/Handler/Project/Tag/List_Suggestions_GET.hs new file mode 100644 index 000000000..67404c19c --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Tag/List_Suggestions_GET.hs @@ -0,0 +1,41 @@ +module Wizard.Api.Handler.Project.Tag.List_Suggestions_GET where + +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.Pageable +import Shared.Common.Model.Context.TransactionState +import Shared.Common.Util.String (splitOn) +import Wizard.Api.Handler.Common +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.Tag.ProjectTagService + +type List_Suggestions_GET = + Header "Authorization" String + :> Header "Host" String + :> "projects" + :> "project-tags" + :> "suggestions" + :> QueryParam "q" String + :> QueryParam "exclude" String + :> QueryParam "page" Int + :> QueryParam "size" Int + :> QueryParam "sort" String + :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (Page String)) + +list_suggestions_GET + :: Maybe String + -> Maybe String + -> Maybe String + -> Maybe String + -> Maybe Int + -> Maybe Int + -> Maybe String + -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page String)) +list_suggestions_GET mTokenHeader mServerUrl mQuery mExclude mPage mSize mSort = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService NoTransaction $ + addTraceUuidHeader =<< do + let excludeTags = maybe [] (splitOn ",") mExclude + getProjectTagSuggestions mQuery excludeTags (Pageable mPage mSize) (parseSortQuery mSort) diff --git a/wizard-server/src/Wizard/Api/Handler/Project/User/Api.hs b/wizard-server/src/Wizard/Api/Handler/Project/User/Api.hs new file mode 100644 index 000000000..d5f881255 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/User/Api.hs @@ -0,0 +1,17 @@ +module Wizard.Api.Handler.Project.User.Api where + +import Servant +import Servant.Swagger.Tags + +import Wizard.Api.Handler.Project.User.List_Suggestions_GET +import Wizard.Model.Context.BaseContext + +type UserAPI = + Tags "Project User" + :> List_Suggestions_GET + +userApi :: Proxy UserAPI +userApi = Proxy + +userServer :: ServerT UserAPI BaseContextM +userServer = list_suggestions_GET diff --git a/wizard-server/src/Wizard/Api/Handler/Project/User/List_Suggestions_GET.hs b/wizard-server/src/Wizard/Api/Handler/Project/User/List_Suggestions_GET.hs new file mode 100644 index 000000000..b8beb86e9 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/User/List_Suggestions_GET.hs @@ -0,0 +1,43 @@ +module Wizard.Api.Handler.Project.User.List_Suggestions_GET where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.Pageable +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.User.ProjectUserService +import WizardLib.Public.Api.Resource.User.UserSuggestionJM () +import WizardLib.Public.Model.User.UserSuggestion + +type List_Suggestions_GET = + Header "Authorization" String + :> Header "Host" String + :> "projects" + :> Capture "uuid" U.UUID + :> "users" + :> "suggestions" + :> QueryParam "q" String + :> QueryParam "editor" Bool + :> QueryParam "page" Int + :> QueryParam "size" Int + :> QueryParam "sort" String + :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (Page UserSuggestion)) + +list_suggestions_GET + :: Maybe String + -> Maybe String + -> U.UUID + -> Maybe String + -> Maybe Bool + -> Maybe Int + -> Maybe Int + -> Maybe String + -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page UserSuggestion)) +list_suggestions_GET mTokenHeader mServerUrl uuid mQuery mEditor mPage mSize mSort = + getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInMaybeAuthService -> + runInMaybeAuthService NoTransaction $ + addTraceUuidHeader =<< getProjectUserSuggestionsPage uuid mQuery mEditor (Pageable mPage mSize) (parseSortQuery mSort) diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Version/Api.hs b/wizard-server/src/Wizard/Api/Handler/Project/Version/Api.hs new file mode 100644 index 000000000..3b50e6d41 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Version/Api.hs @@ -0,0 +1,28 @@ +module Wizard.Api.Handler.Project.Version.Api where + +import Servant +import Servant.Swagger.Tags + +import Wizard.Api.Handler.Project.Version.Detail_DELETE +import Wizard.Api.Handler.Project.Version.Detail_PUT +import Wizard.Api.Handler.Project.Version.List_GET +import Wizard.Api.Handler.Project.Version.List_POST +import Wizard.Model.Context.BaseContext + +type VersionAPI = + Tags "Project Version" + :> ( List_GET + :<|> List_POST + :<|> Detail_PUT + :<|> Detail_DELETE + ) + +versionApi :: Proxy VersionAPI +versionApi = Proxy + +versionServer :: ServerT VersionAPI BaseContextM +versionServer = + list_GET + :<|> list_POST + :<|> detail_PUT + :<|> detail_DELETE diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Version/Detail_DELETE.hs b/wizard-server/src/Wizard/Api/Handler/Project/Version/Detail_DELETE.hs new file mode 100644 index 000000000..1d69cf303 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Version/Detail_DELETE.hs @@ -0,0 +1,32 @@ +module Wizard.Api.Handler.Project.Version.Detail_DELETE where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.Version.ProjectVersionService + +type Detail_DELETE = + Header "Authorization" String + :> Header "Host" String + :> "projects" + :> Capture "projectUuid" U.UUID + :> "versions" + :> Capture "versionUuid" U.UUID + :> Verb DELETE 204 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] NoContent) + +detail_DELETE + :: Maybe String + -> Maybe String + -> U.UUID + -> U.UUID + -> BaseContextM (Headers '[Header "x-trace-uuid" String] NoContent) +detail_DELETE mTokenHeader mServerUrl projectUuid versionUuid = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService Transactional $ + addTraceUuidHeader =<< do + deleteVersion projectUuid versionUuid + return NoContent diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Version/Detail_PUT.hs b/wizard-server/src/Wizard/Api/Handler/Project/Version/Detail_PUT.hs new file mode 100644 index 000000000..4c43732c8 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Version/Detail_PUT.hs @@ -0,0 +1,35 @@ +module Wizard.Api.Handler.Project.Version.Detail_PUT where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.Version.ProjectVersionChangeDTO +import Wizard.Api.Resource.Project.Version.ProjectVersionChangeJM () +import Wizard.Api.Resource.Project.Version.ProjectVersionListJM () +import Wizard.Model.Context.BaseContext +import Wizard.Model.Project.Version.ProjectVersionList +import Wizard.Service.Project.Version.ProjectVersionService + +type Detail_PUT = + Header "Authorization" String + :> Header "Host" String + :> ReqBody '[SafeJSON] ProjectVersionChangeDTO + :> "projects" + :> Capture "projectUuid" U.UUID + :> "versions" + :> Capture "versionUuid" U.UUID + :> Put '[SafeJSON] (Headers '[Header "x-trace-uuid" String] ProjectVersionList) + +detail_PUT + :: Maybe String + -> Maybe String + -> ProjectVersionChangeDTO + -> U.UUID + -> U.UUID + -> BaseContextM (Headers '[Header "x-trace-uuid" String] ProjectVersionList) +detail_PUT mTokenHeader mServerUrl reqDto projectUuid versionUuid = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService Transactional $ addTraceUuidHeader =<< modifyVersion projectUuid versionUuid reqDto diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Version/List_GET.hs b/wizard-server/src/Wizard/Api/Handler/Project/Version/List_GET.hs new file mode 100644 index 000000000..5f757c995 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Version/List_GET.hs @@ -0,0 +1,29 @@ +module Wizard.Api.Handler.Project.Version.List_GET where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.Version.ProjectVersionListJM () +import Wizard.Model.Context.BaseContext +import Wizard.Model.Project.Version.ProjectVersionList +import Wizard.Service.Project.Version.ProjectVersionService + +type List_GET = + Header "Authorization" String + :> Header "Host" String + :> "projects" + :> Capture "uuid" U.UUID + :> "versions" + :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] [ProjectVersionList]) + +list_GET + :: Maybe String + -> Maybe String + -> U.UUID + -> BaseContextM (Headers '[Header "x-trace-uuid" String] [ProjectVersionList]) +list_GET mTokenHeader mServerUrl uuid = + getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService NoTransaction $ addTraceUuidHeader =<< getVersions uuid diff --git a/wizard-server/src/Wizard/Api/Handler/Project/Version/List_POST.hs b/wizard-server/src/Wizard/Api/Handler/Project/Version/List_POST.hs new file mode 100644 index 000000000..e9388cb43 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Project/Version/List_POST.hs @@ -0,0 +1,33 @@ +module Wizard.Api.Handler.Project.Version.List_POST where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.Version.ProjectVersionChangeDTO +import Wizard.Api.Resource.Project.Version.ProjectVersionChangeJM () +import Wizard.Api.Resource.Project.Version.ProjectVersionListJM () +import Wizard.Model.Context.BaseContext +import Wizard.Model.Project.Version.ProjectVersionList +import Wizard.Service.Project.Version.ProjectVersionService + +type List_POST = + Header "Authorization" String + :> Header "Host" String + :> ReqBody '[SafeJSON] ProjectVersionChangeDTO + :> "projects" + :> Capture "uuid" U.UUID + :> "versions" + :> Verb 'POST 201 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] ProjectVersionList) + +list_POST + :: Maybe String + -> Maybe String + -> ProjectVersionChangeDTO + -> U.UUID + -> BaseContextM (Headers '[Header "x-trace-uuid" String] ProjectVersionList) +list_POST mTokenHeader mServerUrl reqDto uuid = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService Transactional $ addTraceUuidHeader =<< createVersion uuid reqDto diff --git a/wizard-server/src/Wizard/Api/Handler/ProjectAction/Api.hs b/wizard-server/src/Wizard/Api/Handler/ProjectAction/Api.hs new file mode 100644 index 000000000..e84cc93ed --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/ProjectAction/Api.hs @@ -0,0 +1,28 @@ +module Wizard.Api.Handler.ProjectAction.Api where + +import Servant +import Servant.Swagger.Tags + +import Wizard.Api.Handler.ProjectAction.Detail_GET +import Wizard.Api.Handler.ProjectAction.Detail_PUT +import Wizard.Api.Handler.ProjectAction.List_GET +import Wizard.Api.Handler.ProjectAction.List_Suggestions_GET +import Wizard.Model.Context.BaseContext + +type ProjectActionAPI = + Tags "Project Action" + :> ( List_GET + :<|> List_Suggestions_GET + :<|> Detail_GET + :<|> Detail_PUT + ) + +projectActionApi :: Proxy ProjectActionAPI +projectActionApi = Proxy + +projectActionServer :: ServerT ProjectActionAPI BaseContextM +projectActionServer = + list_GET + :<|> list_suggestions_GET + :<|> detail_GET + :<|> detail_PUT diff --git a/wizard-server/src/Wizard/Api/Handler/ProjectAction/Detail_GET.hs b/wizard-server/src/Wizard/Api/Handler/ProjectAction/Detail_GET.hs new file mode 100644 index 000000000..fe4e16643 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/ProjectAction/Detail_GET.hs @@ -0,0 +1,27 @@ +module Wizard.Api.Handler.ProjectAction.Detail_GET where + +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.Action.ProjectActionDTO +import Wizard.Api.Resource.Project.Action.ProjectActionJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.Action.ProjectActionService + +type Detail_GET = + Header "Authorization" String + :> Header "Host" String + :> "project-actions" + :> Capture "id" String + :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] ProjectActionDTO) + +detail_GET + :: Maybe String + -> Maybe String + -> String + -> BaseContextM (Headers '[Header "x-trace-uuid" String] ProjectActionDTO) +detail_GET mTokenHeader mServerUrl paId = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService Transactional $ addTraceUuidHeader =<< getProjectAction paId diff --git a/wizard-server/src/Wizard/Api/Handler/ProjectAction/Detail_PUT.hs b/wizard-server/src/Wizard/Api/Handler/ProjectAction/Detail_PUT.hs new file mode 100644 index 000000000..2b698fc16 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/ProjectAction/Detail_PUT.hs @@ -0,0 +1,31 @@ +module Wizard.Api.Handler.ProjectAction.Detail_PUT where + +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.Action.ProjectActionChangeDTO +import Wizard.Api.Resource.Project.Action.ProjectActionChangeJM () +import Wizard.Api.Resource.Project.Action.ProjectActionDTO +import Wizard.Api.Resource.Project.Action.ProjectActionJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.Action.ProjectActionService + +type Detail_PUT = + Header "Authorization" String + :> Header "Host" String + :> ReqBody '[SafeJSON] ProjectActionChangeDTO + :> "project-actions" + :> Capture "id" String + :> Put '[SafeJSON] (Headers '[Header "x-trace-uuid" String] ProjectActionDTO) + +detail_PUT + :: Maybe String + -> Maybe String + -> ProjectActionChangeDTO + -> String + -> BaseContextM (Headers '[Header "x-trace-uuid" String] ProjectActionDTO) +detail_PUT mTokenHeader mServerUrl reqDto paId = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService Transactional $ addTraceUuidHeader =<< modifyProjectAction paId reqDto diff --git a/wizard-server/src/Wizard/Api/Handler/ProjectAction/List_GET.hs b/wizard-server/src/Wizard/Api/Handler/ProjectAction/List_GET.hs new file mode 100644 index 000000000..664100089 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/ProjectAction/List_GET.hs @@ -0,0 +1,36 @@ +module Wizard.Api.Handler.ProjectAction.List_GET where + +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.Pageable +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.Action.ProjectActionDTO +import Wizard.Api.Resource.Project.Action.ProjectActionJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.Action.ProjectActionService + +type List_GET = + Header "Authorization" String + :> Header "Host" String + :> "project-actions" + :> QueryParam "q" String + :> QueryParam "page" Int + :> QueryParam "size" Int + :> QueryParam "sort" String + :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (Page ProjectActionDTO)) + +list_GET + :: Maybe String + -> Maybe String + -> Maybe String + -> Maybe Int + -> Maybe Int + -> Maybe String + -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page ProjectActionDTO)) +list_GET mTokenHeader mServerUrl mQuery mPage mSize mSort = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService NoTransaction $ + addTraceUuidHeader =<< getProjectActionsPageDto mQuery (Pageable mPage mSize) (parseSortQuery mSort) diff --git a/wizard-server/src/Wizard/Api/Handler/ProjectAction/List_Suggestions_GET.hs b/wizard-server/src/Wizard/Api/Handler/ProjectAction/List_Suggestions_GET.hs new file mode 100644 index 000000000..462b6b056 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/ProjectAction/List_Suggestions_GET.hs @@ -0,0 +1,43 @@ +module Wizard.Api.Handler.ProjectAction.List_Suggestions_GET where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.Pageable +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.Action.ProjectActionDTO +import Wizard.Api.Resource.Project.Action.ProjectActionJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.Action.ProjectActionService + +type List_Suggestions_GET = + Header "Authorization" String + :> Header "Host" String + :> "project-actions" + :> "suggestions" + :> QueryParam "projectUuid" U.UUID + :> QueryParam "q" String + :> QueryParam "enabled" Bool + :> QueryParam "page" Int + :> QueryParam "size" Int + :> QueryParam "sort" String + :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (Page ProjectActionDTO)) + +list_suggestions_GET + :: Maybe String + -> Maybe String + -> Maybe U.UUID + -> Maybe String + -> Maybe Bool + -> Maybe Int + -> Maybe Int + -> Maybe String + -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page ProjectActionDTO)) +list_suggestions_GET mTokenHeader mServerUrl mProjectUuid mQuery mEnabled mPage mSize mSort = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService NoTransaction $ + addTraceUuidHeader + =<< getProjectActionSuggestions mProjectUuid mQuery mEnabled (Pageable mPage mSize) (parseSortQuery mSort) diff --git a/wizard-server/src/Wizard/Api/Handler/ProjectCommentThread/Api.hs b/wizard-server/src/Wizard/Api/Handler/ProjectCommentThread/Api.hs new file mode 100644 index 000000000..7c4c49fb3 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/ProjectCommentThread/Api.hs @@ -0,0 +1,18 @@ +module Wizard.Api.Handler.ProjectCommentThread.Api where + +import Servant +import Servant.Swagger.Tags + +import Wizard.Api.Handler.ProjectCommentThread.List_GET +import Wizard.Model.Context.BaseContext + +type ProjectCommentThreadAPI = + Tags "Project Comment Thread" + :> List_GET + +projectCommentThreadApi :: Proxy ProjectCommentThreadAPI +projectCommentThreadApi = Proxy + +projectCommentThreadServer :: ServerT ProjectCommentThreadAPI BaseContextM +projectCommentThreadServer = + list_GET diff --git a/wizard-server/src/Wizard/Api/Handler/ProjectCommentThread/List_GET.hs b/wizard-server/src/Wizard/Api/Handler/ProjectCommentThread/List_GET.hs new file mode 100644 index 000000000..a0f72265c --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/ProjectCommentThread/List_GET.hs @@ -0,0 +1,42 @@ +module Wizard.Api.Handler.ProjectCommentThread.List_GET where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.Pageable +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.Comment.ProjectCommentThreadAssignedJM () +import Wizard.Model.Context.BaseContext +import Wizard.Model.Project.Comment.ProjectCommentThreadAssigned +import Wizard.Service.Project.Comment.ProjectCommentService + +type List_GET = + Header "Authorization" String + :> Header "Host" String + :> "project-comment-threads" + :> QueryParam "q" String + :> QueryParam "projectUuid" U.UUID + :> QueryParam "resolved" Bool + :> QueryParam "page" Int + :> QueryParam "size" Int + :> QueryParam "sort" String + :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (Page ProjectCommentThreadAssigned)) + +list_GET + :: Maybe String + -> Maybe String + -> Maybe String + -> Maybe U.UUID + -> Maybe Bool + -> Maybe Int + -> Maybe Int + -> Maybe String + -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page ProjectCommentThreadAssigned)) +list_GET mTokenHeader mServerUrl mQuery mProjectUuid resolved mPage mSize mSort = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService NoTransaction $ + addTraceUuidHeader + =<< getProjectCommentThreadsPage mQuery mProjectUuid resolved (Pageable mPage mSize) (parseSortQuery mSort) diff --git a/wizard-server/src/Wizard/Api/Handler/ProjectFile/Api.hs b/wizard-server/src/Wizard/Api/Handler/ProjectFile/Api.hs new file mode 100644 index 000000000..738e57f3b --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/ProjectFile/Api.hs @@ -0,0 +1,18 @@ +module Wizard.Api.Handler.ProjectFile.Api where + +import Servant +import Servant.Swagger.Tags + +import Wizard.Api.Handler.ProjectFile.List_GET +import Wizard.Model.Context.BaseContext + +type ProjectFileAPI = + Tags "Project File" + :> List_GET + +projectFileApi :: Proxy ProjectFileAPI +projectFileApi = Proxy + +projectFileServer :: ServerT ProjectFileAPI BaseContextM +projectFileServer = + list_GET diff --git a/wizard-server/src/Wizard/Api/Handler/ProjectFile/List_GET.hs b/wizard-server/src/Wizard/Api/Handler/ProjectFile/List_GET.hs new file mode 100644 index 000000000..c3f7a00e8 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/ProjectFile/List_GET.hs @@ -0,0 +1,36 @@ +module Wizard.Api.Handler.ProjectFile.List_GET where + +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.Pageable +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.File.ProjectFileListJM () +import Wizard.Model.Context.BaseContext +import Wizard.Model.Project.File.ProjectFileList +import Wizard.Service.Project.File.ProjectFileService + +type List_GET = + Header "Authorization" String + :> Header "Host" String + :> "project-files" + :> QueryParam "q" String + :> QueryParam "page" Int + :> QueryParam "size" Int + :> QueryParam "sort" String + :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (Page ProjectFileList)) + +list_GET + :: Maybe String + -> Maybe String + -> Maybe String + -> Maybe Int + -> Maybe Int + -> Maybe String + -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page ProjectFileList)) +list_GET mTokenHeader mServerUrl mQuery mPage mSize mSort = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService NoTransaction $ + addTraceUuidHeader =<< getProjectFilesPage mQuery Nothing (Pageable mPage mSize) (parseSortQuery mSort) diff --git a/wizard-server/src/Wizard/Api/Handler/ProjectImporter/Api.hs b/wizard-server/src/Wizard/Api/Handler/ProjectImporter/Api.hs new file mode 100644 index 000000000..0d9dbdf37 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/ProjectImporter/Api.hs @@ -0,0 +1,28 @@ +module Wizard.Api.Handler.ProjectImporter.Api where + +import Servant +import Servant.Swagger.Tags + +import Wizard.Api.Handler.ProjectImporter.Detail_GET +import Wizard.Api.Handler.ProjectImporter.Detail_PUT +import Wizard.Api.Handler.ProjectImporter.List_GET +import Wizard.Api.Handler.ProjectImporter.List_Suggestions_GET +import Wizard.Model.Context.BaseContext + +type ProjectImporterAPI = + Tags "Project Importer" + :> ( List_GET + :<|> List_Suggestions_GET + :<|> Detail_GET + :<|> Detail_PUT + ) + +projectImporterApi :: Proxy ProjectImporterAPI +projectImporterApi = Proxy + +projectImporterServer :: ServerT ProjectImporterAPI BaseContextM +projectImporterServer = + list_GET + :<|> list_suggestions_GET + :<|> detail_GET + :<|> detail_PUT diff --git a/wizard-server/src/Wizard/Api/Handler/ProjectImporter/Detail_GET.hs b/wizard-server/src/Wizard/Api/Handler/ProjectImporter/Detail_GET.hs new file mode 100644 index 000000000..312e5f6db --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/ProjectImporter/Detail_GET.hs @@ -0,0 +1,27 @@ +module Wizard.Api.Handler.ProjectImporter.Detail_GET where + +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.Importer.ProjectImporterDTO +import Wizard.Api.Resource.Project.Importer.ProjectImporterJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.Importer.ProjectImporterService + +type Detail_GET = + Header "Authorization" String + :> Header "Host" String + :> "project-importers" + :> Capture "piId" String + :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] ProjectImporterDTO) + +detail_GET + :: Maybe String + -> Maybe String + -> String + -> BaseContextM (Headers '[Header "x-trace-uuid" String] ProjectImporterDTO) +detail_GET mTokenHeader mServerUrl piId = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService Transactional $ addTraceUuidHeader =<< getProjectImporter piId diff --git a/wizard-server/src/Wizard/Api/Handler/ProjectImporter/Detail_PUT.hs b/wizard-server/src/Wizard/Api/Handler/ProjectImporter/Detail_PUT.hs new file mode 100644 index 000000000..2b6a8ea89 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/ProjectImporter/Detail_PUT.hs @@ -0,0 +1,31 @@ +module Wizard.Api.Handler.ProjectImporter.Detail_PUT where + +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.Importer.ProjectImporterChangeDTO +import Wizard.Api.Resource.Project.Importer.ProjectImporterChangeJM () +import Wizard.Api.Resource.Project.Importer.ProjectImporterDTO +import Wizard.Api.Resource.Project.Importer.ProjectImporterJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.Importer.ProjectImporterService + +type Detail_PUT = + Header "Authorization" String + :> Header "Host" String + :> ReqBody '[SafeJSON] ProjectImporterChangeDTO + :> "project-importers" + :> Capture "piId" String + :> Put '[SafeJSON] (Headers '[Header "x-trace-uuid" String] ProjectImporterDTO) + +detail_PUT + :: Maybe String + -> Maybe String + -> ProjectImporterChangeDTO + -> String + -> BaseContextM (Headers '[Header "x-trace-uuid" String] ProjectImporterDTO) +detail_PUT mTokenHeader mServerUrl reqDto piId = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService Transactional $ addTraceUuidHeader =<< modifyProjectImporter piId reqDto diff --git a/wizard-server/src/Wizard/Api/Handler/ProjectImporter/List_GET.hs b/wizard-server/src/Wizard/Api/Handler/ProjectImporter/List_GET.hs new file mode 100644 index 000000000..6b8210b41 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/ProjectImporter/List_GET.hs @@ -0,0 +1,36 @@ +module Wizard.Api.Handler.ProjectImporter.List_GET where + +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.Pageable +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.Importer.ProjectImporterDTO +import Wizard.Api.Resource.Project.Importer.ProjectImporterJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.Importer.ProjectImporterService + +type List_GET = + Header "Authorization" String + :> Header "Host" String + :> "project-importers" + :> QueryParam "q" String + :> QueryParam "page" Int + :> QueryParam "size" Int + :> QueryParam "sort" String + :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (Page ProjectImporterDTO)) + +list_GET + :: Maybe String + -> Maybe String + -> Maybe String + -> Maybe Int + -> Maybe Int + -> Maybe String + -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page ProjectImporterDTO)) +list_GET mTokenHeader mServerUrl mQuery mPage mSize mSort = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService NoTransaction $ + addTraceUuidHeader =<< getProjectImportersPageDto mQuery (Pageable mPage mSize) (parseSortQuery mSort) diff --git a/wizard-server/src/Wizard/Api/Handler/ProjectImporter/List_Suggestions_GET.hs b/wizard-server/src/Wizard/Api/Handler/ProjectImporter/List_Suggestions_GET.hs new file mode 100644 index 000000000..774e2c785 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/ProjectImporter/List_Suggestions_GET.hs @@ -0,0 +1,43 @@ +module Wizard.Api.Handler.ProjectImporter.List_Suggestions_GET where + +import qualified Data.UUID as U +import Servant + +import Shared.Common.Api.Handler.Common +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.Pageable +import Shared.Common.Model.Context.TransactionState +import Wizard.Api.Handler.Common +import Wizard.Api.Resource.Project.Importer.ProjectImporterDTO +import Wizard.Api.Resource.Project.Importer.ProjectImporterJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.Project.Importer.ProjectImporterService + +type List_Suggestions_GET = + Header "Authorization" String + :> Header "Host" String + :> "project-importers" + :> "suggestions" + :> QueryParam "projectUuid" U.UUID + :> QueryParam "q" String + :> QueryParam "enabled" Bool + :> QueryParam "page" Int + :> QueryParam "size" Int + :> QueryParam "sort" String + :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (Page ProjectImporterDTO)) + +list_suggestions_GET + :: Maybe String + -> Maybe String + -> Maybe U.UUID + -> Maybe String + -> Maybe Bool + -> Maybe Int + -> Maybe Int + -> Maybe String + -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page ProjectImporterDTO)) +list_suggestions_GET mTokenHeader mServerUrl mProjectUuid mQuery mEnabled mPage mSize mSort = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService NoTransaction $ + addTraceUuidHeader + =<< getProjectImporterSuggestions mProjectUuid mQuery mEnabled (Pageable mPage mSize) (parseSortQuery mSort) diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Api.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/Api.hs deleted file mode 100644 index 3967f8625..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Api.hs +++ /dev/null @@ -1,82 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.Api where - -import Servant -import Servant.Swagger.Tags - -import Wizard.Api.Handler.Questionnaire.Comment.Api -import Wizard.Api.Handler.Questionnaire.Detail_Content_PUT -import Wizard.Api.Handler.Questionnaire.Detail_DELETE -import Wizard.Api.Handler.Questionnaire.Detail_Documents_GET -import Wizard.Api.Handler.Questionnaire.Detail_Documents_Preview_GET -import Wizard.Api.Handler.Questionnaire.Detail_GET -import Wizard.Api.Handler.Questionnaire.Detail_Preview_GET -import Wizard.Api.Handler.Questionnaire.Detail_Questionnaire_GET -import Wizard.Api.Handler.Questionnaire.Detail_Report_GET -import Wizard.Api.Handler.Questionnaire.Detail_Revert_POST -import Wizard.Api.Handler.Questionnaire.Detail_Revert_Preview_POST -import Wizard.Api.Handler.Questionnaire.Detail_Settings_GET -import Wizard.Api.Handler.Questionnaire.Detail_Settings_PUT -import Wizard.Api.Handler.Questionnaire.Detail_Share_PUT -import Wizard.Api.Handler.Questionnaire.Detail_WS -import Wizard.Api.Handler.Questionnaire.File.Api -import Wizard.Api.Handler.Questionnaire.List_GET -import Wizard.Api.Handler.Questionnaire.List_POST -import Wizard.Api.Handler.Questionnaire.List_POST_CloneUuid -import Wizard.Api.Handler.Questionnaire.List_POST_FromTemplate -import Wizard.Api.Handler.Questionnaire.ProjectTag.List_Suggestions_GET -import Wizard.Api.Handler.Questionnaire.User.Api -import Wizard.Model.Context.BaseContext - -type QuestionnaireAPI = - Tags "Questionnaire" - :> ( List_GET - :<|> List_POST - :<|> List_POST_FromTemplate - :<|> List_POST_CloneUuid - :<|> Detail_GET - :<|> Detail_Questionnaire_GET - :<|> Detail_Preview_GET - :<|> Detail_Settings_GET - :<|> Detail_Settings_PUT - :<|> Detail_Share_PUT - :<|> Detail_DELETE - :<|> Detail_Content_PUT - :<|> Detail_Report_GET - :<|> Detail_Documents_GET - :<|> Detail_Documents_Preview_GET - :<|> Detail_WS - :<|> Detail_Revert_POST - :<|> Detail_Revert_Preview_POST - :<|> List_Suggestions_GET - :<|> QuestionnaireCommentAPI - :<|> QuestionnaireFileAPI - :<|> QuestionnaireUserAPI - ) - -questionnaireApi :: Proxy QuestionnaireAPI -questionnaireApi = Proxy - -questionnaireServer :: ServerT QuestionnaireAPI BaseContextM -questionnaireServer = - list_GET - :<|> list_POST - :<|> list_POST_FromTemplate - :<|> list_POST_CloneUuid - :<|> detail_GET - :<|> detail_questionnaire_GET - :<|> detail_preview_GET - :<|> detail_settings_GET - :<|> detail_settings_PUT - :<|> detail_share_PUT - :<|> detail_DELETE - :<|> detail_content_PUT - :<|> detail_report_GET - :<|> detail_documents_GET - :<|> detail_documents_preview_GET - :<|> detail_WS - :<|> detail_revert_POST - :<|> detail_revert_preview_POST - :<|> list_suggestions_GET - :<|> questionnaireCommentServer - :<|> questionnaireFileServer - :<|> questionnaireUserServer diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Comment/Api.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/Comment/Api.hs deleted file mode 100644 index d8a8779ed..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Comment/Api.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.Comment.Api where - -import Servant -import Servant.Swagger.Tags - -import Wizard.Api.Handler.Questionnaire.Comment.List_GET -import Wizard.Model.Context.BaseContext - -type QuestionnaireCommentAPI = - Tags "Questionnaire Comment" - :> List_GET - -questionnaireCommentApi :: Proxy QuestionnaireCommentAPI -questionnaireCommentApi = Proxy - -questionnaireCommentServer :: ServerT QuestionnaireCommentAPI BaseContextM -questionnaireCommentServer = list_GET diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Comment/List_GET.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/Comment/List_GET.hs deleted file mode 100644 index babe7261f..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Comment/List_GET.hs +++ /dev/null @@ -1,34 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.Comment.List_GET where - -import qualified Data.Map.Strict as M -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Questionnaire.QuestionnaireCommentThreadListJM () -import Wizard.Model.Context.BaseContext -import Wizard.Model.Questionnaire.QuestionnaireCommentList -import Wizard.Service.Questionnaire.Comment.QuestionnaireCommentService - -type List_GET = - Header "Authorization" String - :> Header "Host" String - :> "questionnaires" - :> Capture "qtnUuid" U.UUID - :> QueryParam "path" String - :> QueryParam "resolved" Bool - :> "comments" - :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (M.Map String [QuestionnaireCommentThreadList])) - -list_GET - :: Maybe String - -> Maybe String - -> U.UUID - -> Maybe String - -> Maybe Bool - -> BaseContextM (Headers '[Header "x-trace-uuid" String] (M.Map String [QuestionnaireCommentThreadList])) -list_GET mTokenHeader mServerUrl qtnUuid mPath mResolved = - getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService NoTransaction $ addTraceUuidHeader =<< getQuestionnaireCommentsByQuestionnaireUuid qtnUuid mPath mResolved diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Content_PUT.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Content_PUT.hs deleted file mode 100644 index 473047886..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Content_PUT.hs +++ /dev/null @@ -1,31 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.Detail_Content_PUT where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Questionnaire.QuestionnaireContentChangeDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireContentChangeJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.Questionnaire.QuestionnaireService - -type Detail_Content_PUT = - Header "Authorization" String - :> Header "Host" String - :> ReqBody '[SafeJSON] QuestionnaireContentChangeDTO - :> "questionnaires" - :> Capture "qtnUuid" U.UUID - :> "content" - :> Put '[SafeJSON] (Headers '[Header "x-trace-uuid" String] QuestionnaireContentChangeDTO) - -detail_content_PUT - :: Maybe String - -> Maybe String - -> QuestionnaireContentChangeDTO - -> U.UUID - -> BaseContextM (Headers '[Header "x-trace-uuid" String] QuestionnaireContentChangeDTO) -detail_content_PUT mTokenHeader mServerUrl reqDto qtnUuid = - getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService Transactional $ addTraceUuidHeader =<< modifyContent qtnUuid reqDto diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_DELETE.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_DELETE.hs deleted file mode 100644 index 81434205b..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_DELETE.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.Detail_DELETE where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Model.Context.BaseContext -import Wizard.Service.Questionnaire.QuestionnaireService - -type Detail_DELETE = - Header "Authorization" String - :> Header "Host" String - :> "questionnaires" - :> Capture "qtnUuid" U.UUID - :> Verb DELETE 204 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] NoContent) - -detail_DELETE - :: Maybe String -> Maybe String -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] NoContent) -detail_DELETE mTokenHeader mServerUrl qtnUuid = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService Transactional $ - addTraceUuidHeader =<< do - deleteQuestionnaire qtnUuid True - return NoContent diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Documents_GET.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Documents_GET.hs deleted file mode 100644 index 841f11ce3..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Documents_GET.hs +++ /dev/null @@ -1,40 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.Detail_Documents_GET where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.Pageable -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Document.DocumentDTO -import Wizard.Api.Resource.Document.DocumentJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.Document.DocumentService - -type Detail_Documents_GET = - Header "Authorization" String - :> Header "Host" String - :> "questionnaires" - :> Capture "qtnUuid" U.UUID - :> "documents" - :> QueryParam "q" String - :> QueryParam "page" Int - :> QueryParam "size" Int - :> QueryParam "sort" String - :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (Page DocumentDTO)) - -detail_documents_GET - :: Maybe String - -> Maybe String - -> U.UUID - -> Maybe String - -> Maybe Int - -> Maybe Int - -> Maybe String - -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page DocumentDTO)) -detail_documents_GET mTokenHeader mServerUrl qtnUuid mQuery mPage mSize mSort = - getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService NoTransaction $ - addTraceUuidHeader =<< getDocumentsForQtn qtnUuid mQuery (Pageable mPage mSize) (parseSortQuery mSort) diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_GET.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_GET.hs deleted file mode 100644 index 059e877d8..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_GET.hs +++ /dev/null @@ -1,25 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.Detail_GET where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.Questionnaire.QuestionnaireService - -type Detail_GET = - Header "Authorization" String - :> Header "Host" String - :> "questionnaires" - :> Capture "qtnUuid" U.UUID - :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] QuestionnaireDetailDTO) - -detail_GET - :: Maybe String -> Maybe String -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] QuestionnaireDetailDTO) -detail_GET mTokenHeader mServerUrl qtnUuid = - getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService NoTransaction $ addTraceUuidHeader =<< getQuestionnaireDetailByUuid qtnUuid diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Preview_GET.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Preview_GET.hs deleted file mode 100644 index 893b5f197..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Preview_GET.hs +++ /dev/null @@ -1,29 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.Detail_Preview_GET where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailPreviewJM () -import Wizard.Model.Context.BaseContext -import Wizard.Model.Questionnaire.QuestionnaireDetailPreview -import Wizard.Service.Questionnaire.QuestionnaireService - -type Detail_Preview_GET = - Header "Authorization" String - :> Header "Host" String - :> "questionnaires" - :> Capture "qtnUuid" U.UUID - :> "preview" - :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] QuestionnaireDetailPreview) - -detail_preview_GET - :: Maybe String - -> Maybe String - -> U.UUID - -> BaseContextM (Headers '[Header "x-trace-uuid" String] QuestionnaireDetailPreview) -detail_preview_GET mTokenHeader mServerUrl qtnUuid = - getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService NoTransaction $ addTraceUuidHeader =<< getQuestionnaireDetailPreviewById qtnUuid diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Questionnaire_GET.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Questionnaire_GET.hs deleted file mode 100644 index 5c873c481..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Questionnaire_GET.hs +++ /dev/null @@ -1,29 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.Detail_Questionnaire_GET where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailQuestionnaireDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailQuestionnaireJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.Questionnaire.QuestionnaireService - -type Detail_Questionnaire_GET = - Header "Authorization" String - :> Header "Host" String - :> "questionnaires" - :> Capture "qtnUuid" U.UUID - :> "questionnaire" - :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] QuestionnaireDetailQuestionnaireDTO) - -detail_questionnaire_GET - :: Maybe String - -> Maybe String - -> U.UUID - -> BaseContextM (Headers '[Header "x-trace-uuid" String] QuestionnaireDetailQuestionnaireDTO) -detail_questionnaire_GET mTokenHeader mServerUrl qtnUuid = - getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService NoTransaction $ addTraceUuidHeader =<< getQuestionnaireDetailQuestionnaireByUuid qtnUuid diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Report_GET.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Report_GET.hs deleted file mode 100644 index 26a389c07..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Report_GET.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.Detail_Report_GET where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailReportDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailReportJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.Report.ReportService - -type Detail_Report_GET = - Header "Authorization" String - :> Header "Host" String - :> "questionnaires" - :> Capture "qtnUuid" U.UUID - :> "report" - :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] QuestionnaireDetailReportDTO) - -detail_report_GET - :: Maybe String -> Maybe String -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] QuestionnaireDetailReportDTO) -detail_report_GET mTokenHeader mServerUrl qtnUuid = - getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService NoTransaction $ addTraceUuidHeader =<< getReportByQuestionnaireUuid qtnUuid diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Revert_POST.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Revert_POST.hs deleted file mode 100644 index 2eed407c5..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Revert_POST.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.Detail_Revert_POST where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Questionnaire.QuestionnaireContentDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireContentJM () -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionRevertDTO -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionRevertJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.Questionnaire.Version.QuestionnaireVersionService - -type Detail_Revert_POST = - Header "Authorization" String - :> Header "Host" String - :> ReqBody '[SafeJSON] QuestionnaireVersionRevertDTO - :> "questionnaires" - :> Capture "qtnUuid" U.UUID - :> "revert" - :> Post '[SafeJSON] (Headers '[Header "x-trace-uuid" String] QuestionnaireContentDTO) - -detail_revert_POST - :: Maybe String - -> Maybe String - -> QuestionnaireVersionRevertDTO - -> U.UUID - -> BaseContextM (Headers '[Header "x-trace-uuid" String] QuestionnaireContentDTO) -detail_revert_POST mTokenHeader mServerUrl reqDto qtnUuid = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService Transactional $ addTraceUuidHeader =<< revertToEvent qtnUuid reqDto True diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Revert_Preview_POST.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Revert_Preview_POST.hs deleted file mode 100644 index b6cd1dca9..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Revert_Preview_POST.hs +++ /dev/null @@ -1,34 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.Detail_Revert_Preview_POST where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Questionnaire.QuestionnaireContentDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireContentJM () -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionRevertDTO -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionRevertJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.Questionnaire.Version.QuestionnaireVersionService - -type Detail_Revert_Preview_POST = - Header "Authorization" String - :> Header "Host" String - :> ReqBody '[SafeJSON] QuestionnaireVersionRevertDTO - :> "questionnaires" - :> Capture "qtnUuid" U.UUID - :> "revert" - :> "preview" - :> Post '[SafeJSON] (Headers '[Header "x-trace-uuid" String] QuestionnaireContentDTO) - -detail_revert_preview_POST - :: Maybe String - -> Maybe String - -> QuestionnaireVersionRevertDTO - -> U.UUID - -> BaseContextM (Headers '[Header "x-trace-uuid" String] QuestionnaireContentDTO) -detail_revert_preview_POST mTokenHeader mServerUrl reqDto qtnUuid = - getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService Transactional $ addTraceUuidHeader =<< revertToEvent qtnUuid reqDto False diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Settings_GET.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Settings_GET.hs deleted file mode 100644 index 7c3b7bf1f..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Settings_GET.hs +++ /dev/null @@ -1,29 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.Detail_Settings_GET where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailSettingsJM () -import Wizard.Model.Context.BaseContext -import Wizard.Model.Questionnaire.QuestionnaireDetailSettings -import Wizard.Service.Questionnaire.QuestionnaireService - -type Detail_Settings_GET = - Header "Authorization" String - :> Header "Host" String - :> "questionnaires" - :> Capture "qtnUuid" U.UUID - :> "settings" - :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] QuestionnaireDetailSettings) - -detail_settings_GET - :: Maybe String - -> Maybe String - -> U.UUID - -> BaseContextM (Headers '[Header "x-trace-uuid" String] QuestionnaireDetailSettings) -detail_settings_GET mTokenHeader mServerUrl qtnUuid = - getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService NoTransaction $ addTraceUuidHeader =<< getQuestionnaireDetailSettingsById qtnUuid diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Settings_PUT.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Settings_PUT.hs deleted file mode 100644 index 89920b770..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Settings_PUT.hs +++ /dev/null @@ -1,31 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.Detail_Settings_PUT where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Questionnaire.QuestionnaireSettingsChangeDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireSettingsChangeJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.Questionnaire.QuestionnaireService - -type Detail_Settings_PUT = - Header "Authorization" String - :> Header "Host" String - :> ReqBody '[SafeJSON] QuestionnaireSettingsChangeDTO - :> "questionnaires" - :> Capture "qtnUuid" U.UUID - :> "settings" - :> Put '[SafeJSON] (Headers '[Header "x-trace-uuid" String] QuestionnaireSettingsChangeDTO) - -detail_settings_PUT - :: Maybe String - -> Maybe String - -> QuestionnaireSettingsChangeDTO - -> U.UUID - -> BaseContextM (Headers '[Header "x-trace-uuid" String] QuestionnaireSettingsChangeDTO) -detail_settings_PUT mTokenHeader mServerUrl reqDto qtnUuid = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService Transactional $ addTraceUuidHeader =<< modifyQuestionnaireSettings qtnUuid reqDto diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Share_PUT.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Share_PUT.hs deleted file mode 100644 index 2dc548552..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_Share_PUT.hs +++ /dev/null @@ -1,31 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.Detail_Share_PUT where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Questionnaire.QuestionnaireShareChangeDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireShareChangeJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.Questionnaire.QuestionnaireService - -type Detail_Share_PUT = - Header "Authorization" String - :> Header "Host" String - :> ReqBody '[SafeJSON] QuestionnaireShareChangeDTO - :> "questionnaires" - :> Capture "qtnUuid" U.UUID - :> "share" - :> Put '[SafeJSON] (Headers '[Header "x-trace-uuid" String] QuestionnaireShareChangeDTO) - -detail_share_PUT - :: Maybe String - -> Maybe String - -> QuestionnaireShareChangeDTO - -> U.UUID - -> BaseContextM (Headers '[Header "x-trace-uuid" String] QuestionnaireShareChangeDTO) -detail_share_PUT mTokenHeader mServerUrl reqDto qtnUuid = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService Transactional $ addTraceUuidHeader =<< modifyQuestionnaireShare qtnUuid reqDto diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_WS.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_WS.hs deleted file mode 100644 index 6bd8adabb..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Detail_WS.hs +++ /dev/null @@ -1,52 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.Detail_WS where - -import Control.Monad.Except (catchError) -import qualified Data.UUID as U -import Network.WebSockets -import Servant -import Servant.API.WebSocket -import Prelude hiding (log) - -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Handler.Websocket -import Wizard.Api.Resource.Websocket.QuestionnaireActionDTO -import Wizard.Api.Resource.Websocket.QuestionnaireActionJM () -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.BaseContext -import Wizard.Service.Questionnaire.Collaboration.CollaborationService -import Wizard.Util.Websocket - -type Detail_WS = - Header "Host" String - :> "questionnaires" - :> Capture "qtnUuid" U.UUID - :> "websocket" - :> QueryParam "Authorization" String - :> WebSocket - -detail_WS :: Maybe String -> U.UUID -> Maybe String -> Connection -> BaseContextM () -detail_WS mServerUrl qtnUuid mTokenHeader connection = - getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInMaybeAuthService -> - runInMaybeAuthService NoTransaction $ do - connectionUuid <- initConnection - catchError - (putUserOnline qtnUuid connectionUuid connection) - (sendError connectionUuid connection (U.toString qtnUuid) disconnectUser) - handleMessage qtnUuid connectionUuid connection - -handleMessage :: U.UUID -> U.UUID -> Connection -> AppContextM () -handleMessage qtnUuid connectionUuid connection = - handleWebsocketMessage (U.toString qtnUuid) connectionUuid connection handleClose disconnectUser handleAction continue - where - continue :: AppContextM () - continue = handleMessage qtnUuid connectionUuid connection - -- ------------------------------------------------------------------------------------ - handleClose :: AppContextM () - handleClose = deleteUser qtnUuid connectionUuid - -- ------------------------------------------------------------------------------------ - handleAction :: ClientQuestionnaireActionDTO -> AppContextM () - handleAction (SetContent_ClientQuestionnaireActionDTO reqDto) = do - log connectionUuid "SetContent" - setContent qtnUuid connectionUuid reqDto - handleMessage qtnUuid connectionUuid connection diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Event/Api.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/Event/Api.hs deleted file mode 100644 index 95cd6f90d..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Event/Api.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.Event.Api where - -import Servant -import Servant.Swagger.Tags - -import Wizard.Api.Handler.Questionnaire.Event.Detail_GET -import Wizard.Api.Handler.Questionnaire.Event.List_GET -import Wizard.Model.Context.BaseContext - -type QuestionnaireEventAPI = - Tags "Questionnaire Event" - :> ( List_GET - :<|> Detail_GET - ) - -questionnaireEventApi :: Proxy QuestionnaireEventAPI -questionnaireEventApi = Proxy - -questionnaireEventServer :: ServerT QuestionnaireEventAPI BaseContextM -questionnaireEventServer = list_GET :<|> detail_GET diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Event/Detail_GET.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/Event/Detail_GET.hs deleted file mode 100644 index da5cce722..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Event/Detail_GET.hs +++ /dev/null @@ -1,31 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.Event.Detail_GET where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventDTO -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.Questionnaire.QuestionnaireService - -type Detail_GET = - Header "Authorization" String - :> Header "Host" String - :> "questionnaires" - :> Capture "qtnUuid" U.UUID - :> "events" - :> Capture "eventUuid" U.UUID - :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] QuestionnaireEventDTO) - -detail_GET - :: Maybe String - -> Maybe String - -> U.UUID - -> U.UUID - -> BaseContextM (Headers '[Header "x-trace-uuid" String] QuestionnaireEventDTO) -detail_GET mTokenHeader mServerUrl qtnUuid eventUuid = - getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService NoTransaction $ addTraceUuidHeader =<< getQuestionnaireEventForQtnUuid qtnUuid eventUuid diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Event/List_GET.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/Event/List_GET.hs deleted file mode 100644 index 7b570acc0..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Event/List_GET.hs +++ /dev/null @@ -1,39 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.Event.List_GET where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.Pageable -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventListJM () -import Wizard.Model.Context.BaseContext -import Wizard.Model.Questionnaire.QuestionnaireEventList -import Wizard.Service.Questionnaire.QuestionnaireService - -type List_GET = - Header "Authorization" String - :> Header "Host" String - :> "questionnaires" - :> Capture "qtnUuid" U.UUID - :> "events" - :> QueryParam "page" Int - :> QueryParam "size" Int - :> QueryParam "sort" String - :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (Page QuestionnaireEventList)) - -list_GET - :: Maybe String - -> Maybe String - -> U.UUID - -> Maybe Int - -> Maybe Int - -> Maybe String - -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page QuestionnaireEventList)) -list_GET mTokenHeader mServerUrl qtnUuid mPage mSize mSort = - getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService NoTransaction $ - addTraceUuidHeader - =<< getQuestionnaireEventsPage qtnUuid (Pageable mPage mSize) (parseSortQuery mSort) diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/File/Api.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/File/Api.hs deleted file mode 100644 index 3ad0720ad..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/File/Api.hs +++ /dev/null @@ -1,28 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.File.Api where - -import Servant -import Servant.Swagger.Tags - -import Wizard.Api.Handler.Questionnaire.File.Detail_DELETE -import Wizard.Api.Handler.Questionnaire.File.Detail_Download_GET -import Wizard.Api.Handler.Questionnaire.File.List_GET -import Wizard.Api.Handler.Questionnaire.File.List_POST -import Wizard.Model.Context.BaseContext - -type QuestionnaireFileAPI = - Tags "Questionnaire File" - :> ( List_GET - :<|> List_POST - :<|> Detail_DELETE - :<|> Detail_Download_GET - ) - -questionnaireFileApi :: Proxy QuestionnaireFileAPI -questionnaireFileApi = Proxy - -questionnaireFileServer :: ServerT QuestionnaireFileAPI BaseContextM -questionnaireFileServer = - list_GET - :<|> list_POST - :<|> detail_DELETE - :<|> detail_download_GET diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/File/Detail_DELETE.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/File/Detail_DELETE.hs deleted file mode 100644 index 1efcbafaa..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/File/Detail_DELETE.hs +++ /dev/null @@ -1,27 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.File.Detail_DELETE where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Model.Context.BaseContext -import Wizard.Service.Questionnaire.File.QuestionnaireFileService - -type Detail_DELETE = - Header "Authorization" String - :> Header "Host" String - :> "questionnaires" - :> Capture "questionnaireUuid" U.UUID - :> "files" - :> Capture "fileUuid" U.UUID - :> Verb DELETE 204 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] NoContent) - -detail_DELETE :: Maybe String -> Maybe String -> U.UUID -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] NoContent) -detail_DELETE mTokenHeader mServerUrl qtnUuid fileUuid = - getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService Transactional $ - addTraceUuidHeader =<< do - deleteQuestionnaireFile qtnUuid fileUuid - return NoContent diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/File/Detail_Download_GET.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/File/Detail_Download_GET.hs deleted file mode 100644 index 4109d186a..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/File/Detail_Download_GET.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.File.Detail_Download_GET where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Model.Context.BaseContext -import Wizard.Service.Questionnaire.File.QuestionnaireFileService -import WizardLib.Public.Api.Resource.TemporaryFile.TemporaryFileDTO -import WizardLib.Public.Api.Resource.TemporaryFile.TemporaryFileJM () - -type Detail_Download_GET = - Header "Authorization" String - :> Header "Host" String - :> "questionnaires" - :> Capture "questionnaireUuid" U.UUID - :> "files" - :> Capture "fileUuid" U.UUID - :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] TemporaryFileDTO) - -detail_download_GET :: Maybe String -> Maybe String -> U.UUID -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] TemporaryFileDTO) -detail_download_GET mTokenHeader mServerUrl qtnUuid fileUuid = - getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInMaybeAuthService -> - runInMaybeAuthService Transactional $ addTraceUuidHeader =<< downloadQuestionnaireFile qtnUuid fileUuid diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/File/List_GET.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/File/List_GET.hs deleted file mode 100644 index dbaba4ec6..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/File/List_GET.hs +++ /dev/null @@ -1,40 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.File.List_GET where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.Pageable -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Questionnaire.File.QuestionnaireFileListJM () -import Wizard.Model.Context.BaseContext -import Wizard.Model.Questionnaire.QuestionnaireFileList -import Wizard.Service.Questionnaire.File.QuestionnaireFileService - -type List_GET = - Header "Authorization" String - :> Header "Host" String - :> "questionnaires" - :> Capture "questionnaireUuid" U.UUID - :> "files" - :> QueryParam "q" String - :> QueryParam "page" Int - :> QueryParam "size" Int - :> QueryParam "sort" String - :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (Page QuestionnaireFileList)) - -list_GET - :: Maybe String - -> Maybe String - -> U.UUID - -> Maybe String - -> Maybe Int - -> Maybe Int - -> Maybe String - -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page QuestionnaireFileList)) -list_GET mTokenHeader mServerUrl qtnUuid mQuery mPage mSize mSort = - getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInMaybeAuthService -> - runInMaybeAuthService NoTransaction $ - addTraceUuidHeader =<< getQuestionnaireFilesPage mQuery (Just qtnUuid) (Pageable mPage mSize) (parseSortQuery mSort) diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/File/List_POST.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/File/List_POST.hs deleted file mode 100644 index e7202b7bd..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/File/List_POST.hs +++ /dev/null @@ -1,32 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.File.List_POST where - -import qualified Data.UUID as U -import Servant -import Servant.Multipart - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.File.FileCreateDTO -import Wizard.Api.Resource.File.FileCreateJM () -import Wizard.Api.Resource.Questionnaire.File.QuestionnaireFileListJM () -import Wizard.Model.Context.BaseContext -import Wizard.Model.Questionnaire.QuestionnaireFileList -import Wizard.Service.Questionnaire.File.QuestionnaireFileService - -type List_POST = - Header "Authorization" String - :> Header "Host" String - :> MultipartForm Mem FileCreateDTO - :> "questionnaires" - :> Capture "uuid" U.UUID - :> "files" - :> Capture "questionUuid" U.UUID - :> Verb 'POST 201 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] QuestionnaireFileList) - -list_POST :: Maybe String -> Maybe String -> FileCreateDTO -> U.UUID -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] QuestionnaireFileList) -list_POST mTokenHeader mServerUrl reqDto qtnUuid questionUuid = - getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService Transactional $ - addTraceUuidHeader =<< do - createQuestionnaireFile qtnUuid questionUuid reqDto diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/List_GET.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/List_GET.hs deleted file mode 100644 index f9f24eb3e..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/List_GET.hs +++ /dev/null @@ -1,68 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.List_GET where - -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.Pageable -import Shared.Common.Model.Context.TransactionState -import Shared.Common.Util.String (splitOn) -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Questionnaire.QuestionnaireDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.Questionnaire.QuestionnaireService - -type List_GET = - Header "Authorization" String - :> Header "Host" String - :> "questionnaires" - :> QueryParam "q" String - :> QueryParam "isTemplate" Bool - :> QueryParam "isMigrating" Bool - :> QueryParam "projectTags" String - :> QueryParam "projectTagsOp" String - :> QueryParam "userUuids" String - :> QueryParam "userUuidsOp" String - :> QueryParam "knowledgeModelPackageIds" String - :> QueryParam "knowledgeModelPackageIdsOp" String - :> QueryParam "page" Int - :> QueryParam "size" Int - :> QueryParam "sort" String - :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (Page QuestionnaireDTO)) - -list_GET - :: Maybe String - -> Maybe String - -> Maybe String - -> Maybe Bool - -> Maybe Bool - -> Maybe String - -> Maybe String - -> Maybe String - -> Maybe String - -> Maybe String - -> Maybe String - -> Maybe Int - -> Maybe Int - -> Maybe String - -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page QuestionnaireDTO)) -list_GET mTokenHeader mServerUrl mQuery mIsTemplate mIsMigrating mProjectTagsL mProjectTagsOp mUserUuidsL mUserUuidsOp mKnowledgeModelPackageIdsL mKnowledgeModelPackageIdsOp mPage mSize mSort = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService NoTransaction $ - addTraceUuidHeader =<< do - let mUserUuids = fmap (splitOn ",") mUserUuidsL - let mProjectTags = fmap (splitOn ",") mProjectTagsL - let mKnowledgeModelPackageIds = fmap (splitOn ",") mKnowledgeModelPackageIdsL - getQuestionnairesForCurrentUserPageDto - mQuery - mIsTemplate - mIsMigrating - mProjectTags - mProjectTagsOp - mUserUuids - mUserUuidsOp - mKnowledgeModelPackageIds - mKnowledgeModelPackageIdsOp - (Pageable mPage mSize) - (parseSortQuery mSort) diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/List_POST.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/List_POST.hs deleted file mode 100644 index 3fe7b35d7..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/List_POST.hs +++ /dev/null @@ -1,29 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.List_POST where - -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Questionnaire.QuestionnaireCreateDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireCreateJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.Questionnaire.QuestionnaireService - -type List_POST = - Header "Authorization" String - :> Header "Host" String - :> ReqBody '[SafeJSON] QuestionnaireCreateDTO - :> "questionnaires" - :> Verb 'POST 201 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] QuestionnaireDTO) - -list_POST - :: Maybe String - -> Maybe String - -> QuestionnaireCreateDTO - -> BaseContextM (Headers '[Header "x-trace-uuid" String] QuestionnaireDTO) -list_POST mTokenHeader mServerUrl reqDto = - getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInMaybeAuthService -> - runInMaybeAuthService Transactional $ addTraceUuidHeader =<< createQuestionnaire reqDto diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/List_POST_CloneUuid.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/List_POST_CloneUuid.hs deleted file mode 100644 index 871a6d7ab..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/List_POST_CloneUuid.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.List_POST_CloneUuid where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Questionnaire.QuestionnaireDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.Questionnaire.QuestionnaireService - -type List_POST_CloneUuid = - Header "Authorization" String - :> Header "Host" String - :> "questionnaires" - :> Capture "qtnUuid" U.UUID - :> "clone" - :> Verb 'POST 201 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] QuestionnaireDTO) - -list_POST_CloneUuid - :: Maybe String -> Maybe String -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] QuestionnaireDTO) -list_POST_CloneUuid mTokenHeader mServerUrl cloneUuid = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService Transactional $ addTraceUuidHeader =<< cloneQuestionnaire cloneUuid diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/List_POST_FromTemplate.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/List_POST_FromTemplate.hs deleted file mode 100644 index beac77a82..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/List_POST_FromTemplate.hs +++ /dev/null @@ -1,30 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.List_POST_FromTemplate where - -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Questionnaire.QuestionnaireCreateFromTemplateDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireCreateFromTemplateJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.Questionnaire.QuestionnaireService - -type List_POST_FromTemplate = - Header "Authorization" String - :> Header "Host" String - :> ReqBody '[SafeJSON] QuestionnaireCreateFromTemplateDTO - :> "questionnaires" - :> "from-template" - :> Verb 'POST 201 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] QuestionnaireDTO) - -list_POST_FromTemplate - :: Maybe String - -> Maybe String - -> QuestionnaireCreateFromTemplateDTO - -> BaseContextM (Headers '[Header "x-trace-uuid" String] QuestionnaireDTO) -list_POST_FromTemplate mTokenHeader mServerUrl reqDto = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService Transactional $ addTraceUuidHeader =<< createQuestionnaireFromTemplate reqDto diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/ProjectTag/List_Suggestions_GET.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/ProjectTag/List_Suggestions_GET.hs deleted file mode 100644 index 9e67282d5..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/ProjectTag/List_Suggestions_GET.hs +++ /dev/null @@ -1,41 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.ProjectTag.List_Suggestions_GET where - -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.Pageable -import Shared.Common.Model.Context.TransactionState -import Shared.Common.Util.String (splitOn) -import Wizard.Api.Handler.Common -import Wizard.Model.Context.BaseContext -import Wizard.Service.Questionnaire.ProjectTag.ProjectTagService - -type List_Suggestions_GET = - Header "Authorization" String - :> Header "Host" String - :> "questionnaires" - :> "project-tags" - :> "suggestions" - :> QueryParam "q" String - :> QueryParam "exclude" String - :> QueryParam "page" Int - :> QueryParam "size" Int - :> QueryParam "sort" String - :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (Page String)) - -list_suggestions_GET - :: Maybe String - -> Maybe String - -> Maybe String - -> Maybe String - -> Maybe Int - -> Maybe Int - -> Maybe String - -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page String)) -list_suggestions_GET mTokenHeader mServerUrl mQuery mExclude mPage mSize mSort = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService NoTransaction $ - addTraceUuidHeader =<< do - let excludeTags = maybe [] (splitOn ",") mExclude - getProjectTagSuggestions mQuery excludeTags (Pageable mPage mSize) (parseSortQuery mSort) diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/User/Api.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/User/Api.hs deleted file mode 100644 index 77a18c345..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/User/Api.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.User.Api where - -import Servant -import Servant.Swagger.Tags - -import Wizard.Api.Handler.Questionnaire.User.List_Suggestions_GET -import Wizard.Model.Context.BaseContext - -type QuestionnaireUserAPI = - Tags "Questionnaire User" - :> List_Suggestions_GET - -questionnaireUserApi :: Proxy QuestionnaireUserAPI -questionnaireUserApi = Proxy - -questionnaireUserServer :: ServerT QuestionnaireUserAPI BaseContextM -questionnaireUserServer = list_suggestions_GET diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/User/List_Suggestions_GET.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/User/List_Suggestions_GET.hs deleted file mode 100644 index beff1bfbd..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/User/List_Suggestions_GET.hs +++ /dev/null @@ -1,43 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.User.List_Suggestions_GET where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.Pageable -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Model.Context.BaseContext -import Wizard.Service.Questionnaire.User.QuestionnaireUserService -import WizardLib.Public.Api.Resource.User.UserSuggestionJM () -import WizardLib.Public.Model.User.UserSuggestion - -type List_Suggestions_GET = - Header "Authorization" String - :> Header "Host" String - :> "questionnaires" - :> Capture "uuid" U.UUID - :> "users" - :> "suggestions" - :> QueryParam "q" String - :> QueryParam "editor" Bool - :> QueryParam "page" Int - :> QueryParam "size" Int - :> QueryParam "sort" String - :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (Page UserSuggestion)) - -list_suggestions_GET - :: Maybe String - -> Maybe String - -> U.UUID - -> Maybe String - -> Maybe Bool - -> Maybe Int - -> Maybe Int - -> Maybe String - -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page UserSuggestion)) -list_suggestions_GET mTokenHeader mServerUrl uuid mQuery mEditor mPage mSize mSort = - getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInMaybeAuthService -> - runInMaybeAuthService NoTransaction $ - addTraceUuidHeader =<< getQuestionnaireUserSuggestionsPage uuid mQuery mEditor (Pageable mPage mSize) (parseSortQuery mSort) diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Version/Api.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/Version/Api.hs deleted file mode 100644 index 210c77583..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Version/Api.hs +++ /dev/null @@ -1,24 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.Version.Api where - -import Servant -import Servant.Swagger.Tags - -import Wizard.Api.Handler.Questionnaire.Version.Detail_DELETE -import Wizard.Api.Handler.Questionnaire.Version.Detail_PUT -import Wizard.Api.Handler.Questionnaire.Version.List_GET -import Wizard.Api.Handler.Questionnaire.Version.List_POST -import Wizard.Model.Context.BaseContext - -type QuestionnaireVersionAPI = - Tags "Questionnaire Version" - :> ( List_GET - :<|> List_POST - :<|> Detail_PUT - :<|> Detail_DELETE - ) - -questionnaireVersionApi :: Proxy QuestionnaireVersionAPI -questionnaireVersionApi = Proxy - -questionnaireVersionServer :: ServerT QuestionnaireVersionAPI BaseContextM -questionnaireVersionServer = list_GET :<|> list_POST :<|> detail_PUT :<|> detail_DELETE diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Version/Detail_DELETE.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/Version/Detail_DELETE.hs deleted file mode 100644 index ef688bba3..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Version/Detail_DELETE.hs +++ /dev/null @@ -1,32 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.Version.Detail_DELETE where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Model.Context.BaseContext -import Wizard.Service.Questionnaire.Version.QuestionnaireVersionService - -type Detail_DELETE = - Header "Authorization" String - :> Header "Host" String - :> "questionnaires" - :> Capture "qtnUuid" U.UUID - :> "versions" - :> Capture "vUuid" U.UUID - :> Verb DELETE 204 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] NoContent) - -detail_DELETE - :: Maybe String - -> Maybe String - -> U.UUID - -> U.UUID - -> BaseContextM (Headers '[Header "x-trace-uuid" String] NoContent) -detail_DELETE mTokenHeader mServerUrl qtnUuid vUuid = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService Transactional $ - addTraceUuidHeader =<< do - deleteVersion qtnUuid vUuid - return NoContent diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Version/Detail_PUT.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/Version/Detail_PUT.hs deleted file mode 100644 index 8508a7bda..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Version/Detail_PUT.hs +++ /dev/null @@ -1,35 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.Version.Detail_PUT where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionChangeDTO -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionChangeJM () -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionListJM () -import Wizard.Model.Context.BaseContext -import Wizard.Model.Questionnaire.QuestionnaireVersionList -import Wizard.Service.Questionnaire.Version.QuestionnaireVersionService - -type Detail_PUT = - Header "Authorization" String - :> Header "Host" String - :> ReqBody '[SafeJSON] QuestionnaireVersionChangeDTO - :> "questionnaires" - :> Capture "qtnUuid" U.UUID - :> "versions" - :> Capture "vUuid" U.UUID - :> Put '[SafeJSON] (Headers '[Header "x-trace-uuid" String] QuestionnaireVersionList) - -detail_PUT - :: Maybe String - -> Maybe String - -> QuestionnaireVersionChangeDTO - -> U.UUID - -> U.UUID - -> BaseContextM (Headers '[Header "x-trace-uuid" String] QuestionnaireVersionList) -detail_PUT mTokenHeader mServerUrl reqDto qtnUuid vUuid = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService Transactional $ addTraceUuidHeader =<< modifyVersion qtnUuid vUuid reqDto diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Version/List_GET.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/Version/List_GET.hs deleted file mode 100644 index 23a0ac326..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Version/List_GET.hs +++ /dev/null @@ -1,29 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.Version.List_GET where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionListJM () -import Wizard.Model.Context.BaseContext -import Wizard.Model.Questionnaire.QuestionnaireVersionList -import Wizard.Service.Questionnaire.Version.QuestionnaireVersionService - -type List_GET = - Header "Authorization" String - :> Header "Host" String - :> "questionnaires" - :> Capture "qtnUuid" U.UUID - :> "versions" - :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] [QuestionnaireVersionList]) - -list_GET - :: Maybe String - -> Maybe String - -> U.UUID - -> BaseContextM (Headers '[Header "x-trace-uuid" String] [QuestionnaireVersionList]) -list_GET mTokenHeader mServerUrl qtnUuid = - getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService NoTransaction $ addTraceUuidHeader =<< getVersions qtnUuid diff --git a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Version/List_POST.hs b/wizard-server/src/Wizard/Api/Handler/Questionnaire/Version/List_POST.hs deleted file mode 100644 index e185fbefb..000000000 --- a/wizard-server/src/Wizard/Api/Handler/Questionnaire/Version/List_POST.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Wizard.Api.Handler.Questionnaire.Version.List_POST where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionChangeDTO -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionChangeJM () -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionListJM () -import Wizard.Model.Context.BaseContext -import Wizard.Model.Questionnaire.QuestionnaireVersionList -import Wizard.Service.Questionnaire.Version.QuestionnaireVersionService - -type List_POST = - Header "Authorization" String - :> Header "Host" String - :> ReqBody '[SafeJSON] QuestionnaireVersionChangeDTO - :> "questionnaires" - :> Capture "qtnUuid" U.UUID - :> "versions" - :> Verb 'POST 201 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] QuestionnaireVersionList) - -list_POST - :: Maybe String - -> Maybe String - -> QuestionnaireVersionChangeDTO - -> U.UUID - -> BaseContextM (Headers '[Header "x-trace-uuid" String] QuestionnaireVersionList) -list_POST mTokenHeader mServerUrl reqDto qtnUuid = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService Transactional $ addTraceUuidHeader =<< createVersion qtnUuid reqDto diff --git a/wizard-server/src/Wizard/Api/Handler/QuestionnaireAction/Api.hs b/wizard-server/src/Wizard/Api/Handler/QuestionnaireAction/Api.hs deleted file mode 100644 index 1c56d36e6..000000000 --- a/wizard-server/src/Wizard/Api/Handler/QuestionnaireAction/Api.hs +++ /dev/null @@ -1,24 +0,0 @@ -module Wizard.Api.Handler.QuestionnaireAction.Api where - -import Servant -import Servant.Swagger.Tags - -import Wizard.Api.Handler.QuestionnaireAction.Detail_GET -import Wizard.Api.Handler.QuestionnaireAction.Detail_PUT -import Wizard.Api.Handler.QuestionnaireAction.List_GET -import Wizard.Api.Handler.QuestionnaireAction.List_Suggestions_GET -import Wizard.Model.Context.BaseContext - -type QuestionnaireActionAPI = - Tags "Questionnaire Action" - :> ( List_GET - :<|> List_Suggestions_GET - :<|> Detail_GET - :<|> Detail_PUT - ) - -questionnaireActionApi :: Proxy QuestionnaireActionAPI -questionnaireActionApi = Proxy - -questionnaireActionServer :: ServerT QuestionnaireActionAPI BaseContextM -questionnaireActionServer = list_GET :<|> list_suggestions_GET :<|> detail_GET :<|> detail_PUT diff --git a/wizard-server/src/Wizard/Api/Handler/QuestionnaireAction/Detail_GET.hs b/wizard-server/src/Wizard/Api/Handler/QuestionnaireAction/Detail_GET.hs deleted file mode 100644 index e9c6222ab..000000000 --- a/wizard-server/src/Wizard/Api/Handler/QuestionnaireAction/Detail_GET.hs +++ /dev/null @@ -1,27 +0,0 @@ -module Wizard.Api.Handler.QuestionnaireAction.Detail_GET where - -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionDTO -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.QuestionnaireAction.QuestionnaireActionService - -type Detail_GET = - Header "Authorization" String - :> Header "Host" String - :> "questionnaire-actions" - :> Capture "id" String - :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] QuestionnaireActionDTO) - -detail_GET - :: Maybe String - -> Maybe String - -> String - -> BaseContextM (Headers '[Header "x-trace-uuid" String] QuestionnaireActionDTO) -detail_GET mTokenHeader mServerUrl qaId = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService Transactional $ addTraceUuidHeader =<< getQuestionnaireAction qaId diff --git a/wizard-server/src/Wizard/Api/Handler/QuestionnaireAction/Detail_PUT.hs b/wizard-server/src/Wizard/Api/Handler/QuestionnaireAction/Detail_PUT.hs deleted file mode 100644 index c3de7eaae..000000000 --- a/wizard-server/src/Wizard/Api/Handler/QuestionnaireAction/Detail_PUT.hs +++ /dev/null @@ -1,31 +0,0 @@ -module Wizard.Api.Handler.QuestionnaireAction.Detail_PUT where - -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionChangeDTO -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionChangeJM () -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionDTO -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.QuestionnaireAction.QuestionnaireActionService - -type Detail_PUT = - Header "Authorization" String - :> Header "Host" String - :> ReqBody '[SafeJSON] QuestionnaireActionChangeDTO - :> "questionnaire-actions" - :> Capture "id" String - :> Put '[SafeJSON] (Headers '[Header "x-trace-uuid" String] QuestionnaireActionDTO) - -detail_PUT - :: Maybe String - -> Maybe String - -> QuestionnaireActionChangeDTO - -> String - -> BaseContextM (Headers '[Header "x-trace-uuid" String] QuestionnaireActionDTO) -detail_PUT mTokenHeader mServerUrl reqDto qaId = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService Transactional $ addTraceUuidHeader =<< modifyQuestionnaireAction qaId reqDto diff --git a/wizard-server/src/Wizard/Api/Handler/QuestionnaireAction/List_GET.hs b/wizard-server/src/Wizard/Api/Handler/QuestionnaireAction/List_GET.hs deleted file mode 100644 index d09851b11..000000000 --- a/wizard-server/src/Wizard/Api/Handler/QuestionnaireAction/List_GET.hs +++ /dev/null @@ -1,36 +0,0 @@ -module Wizard.Api.Handler.QuestionnaireAction.List_GET where - -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.Pageable -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionDTO -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.QuestionnaireAction.QuestionnaireActionService - -type List_GET = - Header "Authorization" String - :> Header "Host" String - :> "questionnaire-actions" - :> QueryParam "q" String - :> QueryParam "page" Int - :> QueryParam "size" Int - :> QueryParam "sort" String - :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (Page QuestionnaireActionDTO)) - -list_GET - :: Maybe String - -> Maybe String - -> Maybe String - -> Maybe Int - -> Maybe Int - -> Maybe String - -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page QuestionnaireActionDTO)) -list_GET mTokenHeader mServerUrl mQuery mPage mSize mSort = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService NoTransaction $ - addTraceUuidHeader =<< getQuestionnaireActionsPageDto mQuery (Pageable mPage mSize) (parseSortQuery mSort) diff --git a/wizard-server/src/Wizard/Api/Handler/QuestionnaireAction/List_Suggestions_GET.hs b/wizard-server/src/Wizard/Api/Handler/QuestionnaireAction/List_Suggestions_GET.hs deleted file mode 100644 index fcb3035e2..000000000 --- a/wizard-server/src/Wizard/Api/Handler/QuestionnaireAction/List_Suggestions_GET.hs +++ /dev/null @@ -1,43 +0,0 @@ -module Wizard.Api.Handler.QuestionnaireAction.List_Suggestions_GET where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.Pageable -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionDTO -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.QuestionnaireAction.QuestionnaireActionService - -type List_Suggestions_GET = - Header "Authorization" String - :> Header "Host" String - :> "questionnaire-actions" - :> "suggestions" - :> QueryParam "questionnaireUuid" U.UUID - :> QueryParam "q" String - :> QueryParam "enabled" Bool - :> QueryParam "page" Int - :> QueryParam "size" Int - :> QueryParam "sort" String - :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (Page QuestionnaireActionDTO)) - -list_suggestions_GET - :: Maybe String - -> Maybe String - -> Maybe U.UUID - -> Maybe String - -> Maybe Bool - -> Maybe Int - -> Maybe Int - -> Maybe String - -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page QuestionnaireActionDTO)) -list_suggestions_GET mTokenHeader mServerUrl mQuestionnaireUuid mQuery mEnabled mPage mSize mSort = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService NoTransaction $ - addTraceUuidHeader - =<< getQuestionnaireActionSuggestions mQuestionnaireUuid mQuery mEnabled (Pageable mPage mSize) (parseSortQuery mSort) diff --git a/wizard-server/src/Wizard/Api/Handler/QuestionnaireFile/Api.hs b/wizard-server/src/Wizard/Api/Handler/QuestionnaireFile/Api.hs deleted file mode 100644 index 1cfca6163..000000000 --- a/wizard-server/src/Wizard/Api/Handler/QuestionnaireFile/Api.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Wizard.Api.Handler.QuestionnaireFile.Api where - -import Servant -import Servant.Swagger.Tags - -import Wizard.Api.Handler.QuestionnaireFile.List_GET -import Wizard.Model.Context.BaseContext - -type QuestionnaireFileAPI = - Tags "Questionnaire File" - :> List_GET - -questionnaireFileApi :: Proxy QuestionnaireFileAPI -questionnaireFileApi = Proxy - -questionnaireFileServer :: ServerT QuestionnaireFileAPI BaseContextM -questionnaireFileServer = - list_GET diff --git a/wizard-server/src/Wizard/Api/Handler/QuestionnaireFile/List_GET.hs b/wizard-server/src/Wizard/Api/Handler/QuestionnaireFile/List_GET.hs deleted file mode 100644 index 3931691e5..000000000 --- a/wizard-server/src/Wizard/Api/Handler/QuestionnaireFile/List_GET.hs +++ /dev/null @@ -1,36 +0,0 @@ -module Wizard.Api.Handler.QuestionnaireFile.List_GET where - -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.Pageable -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.Questionnaire.File.QuestionnaireFileListJM () -import Wizard.Model.Context.BaseContext -import Wizard.Model.Questionnaire.QuestionnaireFileList -import Wizard.Service.Questionnaire.File.QuestionnaireFileService - -type List_GET = - Header "Authorization" String - :> Header "Host" String - :> "questionnaire-files" - :> QueryParam "q" String - :> QueryParam "page" Int - :> QueryParam "size" Int - :> QueryParam "sort" String - :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (Page QuestionnaireFileList)) - -list_GET - :: Maybe String - -> Maybe String - -> Maybe String - -> Maybe Int - -> Maybe Int - -> Maybe String - -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page QuestionnaireFileList)) -list_GET mTokenHeader mServerUrl mQuery mPage mSize mSort = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService NoTransaction $ - addTraceUuidHeader =<< getQuestionnaireFilesPage mQuery Nothing (Pageable mPage mSize) (parseSortQuery mSort) diff --git a/wizard-server/src/Wizard/Api/Handler/QuestionnaireImporter/Api.hs b/wizard-server/src/Wizard/Api/Handler/QuestionnaireImporter/Api.hs deleted file mode 100644 index 162f4de7d..000000000 --- a/wizard-server/src/Wizard/Api/Handler/QuestionnaireImporter/Api.hs +++ /dev/null @@ -1,24 +0,0 @@ -module Wizard.Api.Handler.QuestionnaireImporter.Api where - -import Servant -import Servant.Swagger.Tags - -import Wizard.Api.Handler.QuestionnaireImporter.Detail_GET -import Wizard.Api.Handler.QuestionnaireImporter.Detail_PUT -import Wizard.Api.Handler.QuestionnaireImporter.List_GET -import Wizard.Api.Handler.QuestionnaireImporter.List_Suggestions_GET -import Wizard.Model.Context.BaseContext - -type QuestionnaireImporterAPI = - Tags "Questionnaire Importer" - :> ( List_GET - :<|> List_Suggestions_GET - :<|> Detail_GET - :<|> Detail_PUT - ) - -questionnaireImporterApi :: Proxy QuestionnaireImporterAPI -questionnaireImporterApi = Proxy - -questionnaireImporterServer :: ServerT QuestionnaireImporterAPI BaseContextM -questionnaireImporterServer = list_GET :<|> list_suggestions_GET :<|> detail_GET :<|> detail_PUT diff --git a/wizard-server/src/Wizard/Api/Handler/QuestionnaireImporter/Detail_GET.hs b/wizard-server/src/Wizard/Api/Handler/QuestionnaireImporter/Detail_GET.hs deleted file mode 100644 index 7844ce436..000000000 --- a/wizard-server/src/Wizard/Api/Handler/QuestionnaireImporter/Detail_GET.hs +++ /dev/null @@ -1,27 +0,0 @@ -module Wizard.Api.Handler.QuestionnaireImporter.Detail_GET where - -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterDTO -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.QuestionnaireImporter.QuestionnaireImporterService - -type Detail_GET = - Header "Authorization" String - :> Header "Host" String - :> "questionnaire-importers" - :> Capture "qiId" String - :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] QuestionnaireImporterDTO) - -detail_GET - :: Maybe String - -> Maybe String - -> String - -> BaseContextM (Headers '[Header "x-trace-uuid" String] QuestionnaireImporterDTO) -detail_GET mTokenHeader mServerUrl qiId = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService Transactional $ addTraceUuidHeader =<< getQuestionnaireImporter qiId diff --git a/wizard-server/src/Wizard/Api/Handler/QuestionnaireImporter/Detail_PUT.hs b/wizard-server/src/Wizard/Api/Handler/QuestionnaireImporter/Detail_PUT.hs deleted file mode 100644 index 5a3a1828e..000000000 --- a/wizard-server/src/Wizard/Api/Handler/QuestionnaireImporter/Detail_PUT.hs +++ /dev/null @@ -1,31 +0,0 @@ -module Wizard.Api.Handler.QuestionnaireImporter.Detail_PUT where - -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterChangeDTO -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterChangeJM () -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterDTO -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.QuestionnaireImporter.QuestionnaireImporterService - -type Detail_PUT = - Header "Authorization" String - :> Header "Host" String - :> ReqBody '[SafeJSON] QuestionnaireImporterChangeDTO - :> "questionnaire-importers" - :> Capture "qiId" String - :> Put '[SafeJSON] (Headers '[Header "x-trace-uuid" String] QuestionnaireImporterDTO) - -detail_PUT - :: Maybe String - -> Maybe String - -> QuestionnaireImporterChangeDTO - -> String - -> BaseContextM (Headers '[Header "x-trace-uuid" String] QuestionnaireImporterDTO) -detail_PUT mTokenHeader mServerUrl reqDto qiId = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService Transactional $ addTraceUuidHeader =<< modifyQuestionnaireImporter qiId reqDto diff --git a/wizard-server/src/Wizard/Api/Handler/QuestionnaireImporter/List_GET.hs b/wizard-server/src/Wizard/Api/Handler/QuestionnaireImporter/List_GET.hs deleted file mode 100644 index 2c4b92aee..000000000 --- a/wizard-server/src/Wizard/Api/Handler/QuestionnaireImporter/List_GET.hs +++ /dev/null @@ -1,36 +0,0 @@ -module Wizard.Api.Handler.QuestionnaireImporter.List_GET where - -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.Pageable -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterDTO -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.QuestionnaireImporter.QuestionnaireImporterService - -type List_GET = - Header "Authorization" String - :> Header "Host" String - :> "questionnaire-importers" - :> QueryParam "q" String - :> QueryParam "page" Int - :> QueryParam "size" Int - :> QueryParam "sort" String - :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (Page QuestionnaireImporterDTO)) - -list_GET - :: Maybe String - -> Maybe String - -> Maybe String - -> Maybe Int - -> Maybe Int - -> Maybe String - -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page QuestionnaireImporterDTO)) -list_GET mTokenHeader mServerUrl mQuery mPage mSize mSort = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService NoTransaction $ - addTraceUuidHeader =<< getQuestionnaireImportersPageDto mQuery (Pageable mPage mSize) (parseSortQuery mSort) diff --git a/wizard-server/src/Wizard/Api/Handler/QuestionnaireImporter/List_Suggestions_GET.hs b/wizard-server/src/Wizard/Api/Handler/QuestionnaireImporter/List_Suggestions_GET.hs deleted file mode 100644 index d39d6948f..000000000 --- a/wizard-server/src/Wizard/Api/Handler/QuestionnaireImporter/List_Suggestions_GET.hs +++ /dev/null @@ -1,43 +0,0 @@ -module Wizard.Api.Handler.QuestionnaireImporter.List_Suggestions_GET where - -import qualified Data.UUID as U -import Servant - -import Shared.Common.Api.Handler.Common -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.Pageable -import Shared.Common.Model.Context.TransactionState -import Wizard.Api.Handler.Common -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterDTO -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterJM () -import Wizard.Model.Context.BaseContext -import Wizard.Service.QuestionnaireImporter.QuestionnaireImporterService - -type List_Suggestions_GET = - Header "Authorization" String - :> Header "Host" String - :> "questionnaire-importers" - :> "suggestions" - :> QueryParam "questionnaireUuid" U.UUID - :> QueryParam "q" String - :> QueryParam "enabled" Bool - :> QueryParam "page" Int - :> QueryParam "size" Int - :> QueryParam "sort" String - :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (Page QuestionnaireImporterDTO)) - -list_suggestions_GET - :: Maybe String - -> Maybe String - -> Maybe U.UUID - -> Maybe String - -> Maybe Bool - -> Maybe Int - -> Maybe Int - -> Maybe String - -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page QuestionnaireImporterDTO)) -list_suggestions_GET mTokenHeader mServerUrl mQuestionnaireUuid mQuery mEnabled mPage mSize mSort = - getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> - runInAuthService NoTransaction $ - addTraceUuidHeader - =<< getQuestionnaireImporterSuggestions mQuestionnaireUuid mQuery mEnabled (Pageable mPage mSize) (parseSortQuery mSort) diff --git a/wizard-server/src/Wizard/Api/Handler/Swagger/Api.hs b/wizard-server/src/Wizard/Api/Handler/Swagger/Api.hs index 5bda6046a..80e4248d1 100644 --- a/wizard-server/src/Wizard/Api/Handler/Swagger/Api.hs +++ b/wizard-server/src/Wizard/Api/Handler/Swagger/Api.hs @@ -73,33 +73,33 @@ import Wizard.Api.Resource.Locale.LocaleDetailSM () import Wizard.Api.Resource.Locale.LocaleSM () import Wizard.Api.Resource.PersistentCommand.PersistentCommandDetailSM () import Wizard.Api.Resource.PersistentCommand.PersistentCommandSM () -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventListSM () -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateChangeSM () -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateCreateSM () -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireCommentThreadAssignedSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireContentChangeSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireContentSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireCreateFromTemplateSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireCreateSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailPreviewSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailQuestionnaireSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailReportSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailSettingsSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailWsSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireReportSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSettingsChangeSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireShareChangeSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSimpleSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSuggestionSM () -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionChangeSM () -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionRevertSM () -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionChangeSM () -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionSM () -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterChangeSM () -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterSM () +import Wizard.Api.Resource.Project.Action.ProjectActionChangeSM () +import Wizard.Api.Resource.Project.Action.ProjectActionSM () +import Wizard.Api.Resource.Project.Comment.ProjectCommentThreadAssignedSM () +import Wizard.Api.Resource.Project.Detail.ProjectDetailPreviewSM () +import Wizard.Api.Resource.Project.Detail.ProjectDetailQuestionnaireSM () +import Wizard.Api.Resource.Project.Detail.ProjectDetailReportSM () +import Wizard.Api.Resource.Project.Detail.ProjectDetailSM () +import Wizard.Api.Resource.Project.Detail.ProjectDetailSettingsSM () +import Wizard.Api.Resource.Project.Detail.ProjectDetailWsSM () +import Wizard.Api.Resource.Project.Event.ProjectEventListSM () +import Wizard.Api.Resource.Project.Importer.ProjectImporterChangeSM () +import Wizard.Api.Resource.Project.Importer.ProjectImporterSM () +import Wizard.Api.Resource.Project.Migration.ProjectMigrationChangeSM () +import Wizard.Api.Resource.Project.Migration.ProjectMigrationCreateSM () +import Wizard.Api.Resource.Project.Migration.ProjectMigrationSM () +import Wizard.Api.Resource.Project.ProjectContentChangeSM () +import Wizard.Api.Resource.Project.ProjectContentSM () +import Wizard.Api.Resource.Project.ProjectCreateFromTemplateSM () +import Wizard.Api.Resource.Project.ProjectCreateSM () +import Wizard.Api.Resource.Project.ProjectReportSM () +import Wizard.Api.Resource.Project.ProjectSM () +import Wizard.Api.Resource.Project.ProjectSettingsChangeSM () +import Wizard.Api.Resource.Project.ProjectShareChangeSM () +import Wizard.Api.Resource.Project.ProjectSimpleSM () +import Wizard.Api.Resource.Project.ProjectSuggestionSM () +import Wizard.Api.Resource.Project.Version.ProjectVersionChangeSM () +import Wizard.Api.Resource.Project.Version.ProjectVersionRevertSM () import Wizard.Api.Resource.Registry.RegistryConfirmationSM () import Wizard.Api.Resource.Registry.RegistryCreateSM () import Wizard.Api.Resource.Registry.RegistryOrganizationSM () @@ -128,7 +128,7 @@ import Wizard.Api.Resource.User.UserSubmissionPropSM () import Wizard.Api.Resource.UserToken.ApiKeyCreateSM () import Wizard.Api.Resource.UserToken.AppKeyCreateSM () import Wizard.Api.Resource.UserToken.UserTokenListSM () -import Wizard.Api.Resource.Websocket.QuestionnaireActionSM () +import Wizard.Api.Resource.Websocket.ProjectMessageSM () import Wizard.Api.Resource.Websocket.WebsocketSM () import WizardLib.Public.Api.Resource.PersistentCommand.PersistentCommandListSM () import WizardLib.Public.Api.Resource.TemporaryFile.TemporaryFileSM () diff --git a/wizard-server/src/Wizard/Api/Handler/TypeHint/List_POST.hs b/wizard-server/src/Wizard/Api/Handler/TypeHint/List_POST.hs index 89f4ca1ca..fc1cb0aa8 100644 --- a/wizard-server/src/Wizard/Api/Handler/TypeHint/List_POST.hs +++ b/wizard-server/src/Wizard/Api/Handler/TypeHint/List_POST.hs @@ -24,7 +24,7 @@ list_POST -> Maybe String -> TypeHintRequestDTO -> BaseContextM (Headers '[Header "x-trace-uuid" String] [TypeHintIDTO]) -list_POST mTokenHeader mServerUrl reqDto@(QuestionnaireTypeHintRequest' _) = +list_POST mTokenHeader mServerUrl reqDto@(ProjectTypeHintRequest' _) = getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> runInAuthService Transactional $ addTraceUuidHeader =<< getTypeHints reqDto list_POST mTokenHeader mServerUrl reqDto = diff --git a/wizard-server/src/Wizard/Api/Resource/Common/PageSM.hs b/wizard-server/src/Wizard/Api/Resource/Common/PageSM.hs index 4f4f84fae..835fa852a 100644 --- a/wizard-server/src/Wizard/Api/Resource/Common/PageSM.hs +++ b/wizard-server/src/Wizard/Api/Resource/Common/PageSM.hs @@ -29,16 +29,16 @@ import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSuggestio import Wizard.Api.Resource.Locale.LocaleDTO import Wizard.Api.Resource.Locale.LocaleSM () import Wizard.Api.Resource.PersistentCommand.PersistentCommandSM () -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventListSM () -import Wizard.Api.Resource.Questionnaire.File.QuestionnaireFileListSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireCommentThreadAssignedSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSuggestionSM () -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionDTO -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionSM () -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterDTO -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterSM () +import Wizard.Api.Resource.Project.Action.ProjectActionDTO +import Wizard.Api.Resource.Project.Action.ProjectActionSM () +import Wizard.Api.Resource.Project.Comment.ProjectCommentThreadAssignedSM () +import Wizard.Api.Resource.Project.Event.ProjectEventListSM () +import Wizard.Api.Resource.Project.File.ProjectFileListSM () +import Wizard.Api.Resource.Project.Importer.ProjectImporterDTO +import Wizard.Api.Resource.Project.Importer.ProjectImporterSM () +import Wizard.Api.Resource.Project.ProjectDTO +import Wizard.Api.Resource.Project.ProjectSM () +import Wizard.Api.Resource.Project.ProjectSuggestionSM () import Wizard.Api.Resource.Tenant.TenantDTO import Wizard.Api.Resource.Tenant.TenantSM () import Wizard.Api.Resource.User.Group.UserGroupSuggestionSM () @@ -48,28 +48,28 @@ import Wizard.Database.Migration.Development.Document.Data.Documents import Wizard.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplates import Wizard.Database.Migration.Development.KnowledgeModel.Data.Editor.KnowledgeModelEditors import Wizard.Database.Migration.Development.Locale.Data.Locales -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireComments -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireFiles -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Database.Migration.Development.QuestionnaireAction.Data.QuestionnaireActions -import Wizard.Database.Migration.Development.QuestionnaireImporter.Data.QuestionnaireImporters +import Wizard.Database.Migration.Development.Project.Data.ProjectActions +import Wizard.Database.Migration.Development.Project.Data.ProjectComments +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.Project.Data.ProjectFiles +import Wizard.Database.Migration.Development.Project.Data.ProjectImporters +import Wizard.Database.Migration.Development.Project.Data.Projects import Wizard.Database.Migration.Development.Tenant.Data.Tenants import Wizard.Database.Migration.Development.User.Data.Users import Wizard.Model.DocumentTemplate.DocumentTemplateDraftList import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditorList import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditorSuggestion import Wizard.Model.KnowledgeModel.Package.KnowledgeModelPackageSuggestion -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireCommentThreadAssigned -import Wizard.Model.Questionnaire.QuestionnaireEventList -import Wizard.Model.Questionnaire.QuestionnaireFileList -import Wizard.Model.Questionnaire.QuestionnaireSuggestion +import Wizard.Model.Project.Comment.ProjectCommentThreadAssigned +import Wizard.Model.Project.Event.ProjectEventList +import Wizard.Model.Project.File.ProjectFileList +import Wizard.Model.Project.Project +import Wizard.Model.Project.ProjectSuggestion import Wizard.Model.User.UserGroupSuggestion import Wizard.Service.DocumentTemplate.Draft.DocumentTemplateDraftMapper import qualified Wizard.Service.KnowledgeModel.Package.KnowledgeModelPackageMapper as P_Mapper -import Wizard.Service.Questionnaire.Event.QuestionnaireEventMapper -import qualified Wizard.Service.Questionnaire.QuestionnaireMapper as QTN_Mapper +import Wizard.Service.Project.Event.ProjectEventMapper +import qualified Wizard.Service.Project.ProjectMapper as PRJ_Mapper import qualified Wizard.Service.Tenant.TenantMapper as TNT_Mapper import qualified Wizard.Service.User.Group.UserGroupMapper as UG_Mapper import qualified Wizard.Service.User.UserMapper as U_Mapper @@ -125,41 +125,41 @@ instance ToSchema (Page KnowledgeModelEditorSuggestion) where declareNamedSchema = toSwaggerWithDtoName "Page KnowledgeModelEditorSuggestion" (Page "knowledgeModelEditors" pageMetadata [amsterdamKnowledgeModelEditorSuggestion]) -instance ToSchema (Page QuestionnaireDTO) where +instance ToSchema (Page ProjectDTO) where declareNamedSchema = - toSwaggerWithDtoName "Page QuestionnaireDTO" (Page "questionnaires" pageMetadata [questionnaire1Dto]) + toSwaggerWithDtoName "Page ProjectDTO" (Page "projects" pageMetadata [project1Dto]) -instance ToSchema (Page QuestionnaireSuggestion) where +instance ToSchema (Page ProjectSuggestion) where declareNamedSchema = - toSwaggerWithDtoName "Page QuestionnaireSuggestion" (Page "questionnaires" pageMetadata [QTN_Mapper.toSuggestion questionnaire1]) + toSwaggerWithDtoName "Page ProjectSuggestion" (Page "projects" pageMetadata [PRJ_Mapper.toSuggestion project1]) -instance ToSchema (Page QuestionnaireCommentThreadAssigned) where +instance ToSchema (Page ProjectCommentThreadAssigned) where declareNamedSchema = - toSwaggerWithDtoName "Page QuestionnaireCommentThreadAssigned" (Page "commentThreads" pageMetadata [cmtAssigned]) + toSwaggerWithDtoName "Page ProjectCommentThreadAssigned" (Page "commentThreads" pageMetadata [cmtAssigned]) -instance ToSchema (Page QuestionnaireActionDTO) where +instance ToSchema (Page ProjectActionDTO) where declareNamedSchema = toSwaggerWithDtoName - "Page QuestionnaireActionDTO" - (Page "questionnaireActions" pageMetadata [questionnaireActionFtp3Dto]) + "Page ProjectActionDTO" + (Page "projectActions" pageMetadata [projectActionFtp3Dto]) -instance ToSchema (Page QuestionnaireEventList) where +instance ToSchema (Page ProjectEventList) where declareNamedSchema = toSwaggerWithDtoName - "Page QuestionnaireEventList" - (Page "questionnaireEvents" pageMetadata [SetReplyEventList' (toSetReplyEventList (sre_rQ1 questionnaire1.uuid) (Just userAlbert))]) + "Page ProjectEventList" + (Page "projectEvents" pageMetadata [SetReplyEventList' (toSetReplyEventList (sre_rQ1 project1.uuid) (Just userAlbert))]) -instance ToSchema (Page QuestionnaireFileList) where +instance ToSchema (Page ProjectFileList) where declareNamedSchema = toSwaggerWithDtoName - "Page QuestionnaireFileList" - (Page "questionnaireFiles" pageMetadata [questionnaireFileList]) + "Page ProjectFileList" + (Page "projectFiles" pageMetadata [projectFileList]) -instance ToSchema (Page QuestionnaireImporterDTO) where +instance ToSchema (Page ProjectImporterDTO) where declareNamedSchema = toSwaggerWithDtoName - "Page QuestionnaireImporterDTO" - (Page "questionnaireImporters" pageMetadata [questionnaireImporterBio3Dto]) + "Page ProjectImporterDTO" + (Page "projectImporters" pageMetadata [projectImporterBio3Dto]) instance ToSchema (Page DocumentTemplateSimpleDTO) where declareNamedSchema = diff --git a/wizard-server/src/Wizard/Api/Resource/Config/ClientConfigDTO.hs b/wizard-server/src/Wizard/Api/Resource/Config/ClientConfigDTO.hs index f892dc4e8..d11ed1f61 100644 --- a/wizard-server/src/Wizard/Api/Resource/Config/ClientConfigDTO.hs +++ b/wizard-server/src/Wizard/Api/Resource/Config/ClientConfigDTO.hs @@ -21,7 +21,7 @@ data ClientConfigDTO , dashboardAndLoginScreen :: TenantConfigDashboardAndLoginScreen , lookAndFeel :: TenantConfigLookAndFeel , registry :: ClientConfigRegistryDTO - , questionnaire :: ClientConfigQuestionnaireDTO + , project :: ClientConfigProjectDTO , submission :: SimpleFeature , cloud :: ClientConfigCloudDTO , owl :: TenantConfigOwl @@ -58,10 +58,10 @@ data ClientConfigRegistryDTO = ClientConfigRegistryDTO } deriving (Show, Eq, Generic) -data ClientConfigQuestionnaireDTO = ClientConfigQuestionnaireDTO - { questionnaireVisibility :: TenantConfigQuestionnaireVisibility - , questionnaireSharing :: TenantConfigQuestionnaireSharing - , questionnaireCreation :: QuestionnaireCreation +data ClientConfigProjectDTO = ClientConfigProjectDTO + { projectVisibility :: TenantConfigProjectVisibility + , projectSharing :: TenantConfigProjectSharing + , projectCreation :: ProjectCreation , projectTagging :: SimpleFeature , summaryReport :: SimpleFeature , feedback :: SimpleFeature diff --git a/wizard-server/src/Wizard/Api/Resource/Config/ClientConfigJM.hs b/wizard-server/src/Wizard/Api/Resource/Config/ClientConfigJM.hs index 86ede33ef..a3c9e9dd1 100644 --- a/wizard-server/src/Wizard/Api/Resource/Config/ClientConfigJM.hs +++ b/wizard-server/src/Wizard/Api/Resource/Config/ClientConfigJM.hs @@ -38,10 +38,10 @@ instance FromJSON ClientConfigRegistryDTO where instance ToJSON ClientConfigRegistryDTO where toJSON = genericToJSON jsonOptions -instance FromJSON ClientConfigQuestionnaireDTO where +instance FromJSON ClientConfigProjectDTO where parseJSON = genericParseJSON jsonOptions -instance ToJSON ClientConfigQuestionnaireDTO where +instance ToJSON ClientConfigProjectDTO where toJSON = genericToJSON jsonOptions instance FromJSON ClientConfigCloudDTO where diff --git a/wizard-server/src/Wizard/Api/Resource/Config/ClientConfigSM.hs b/wizard-server/src/Wizard/Api/Resource/Config/ClientConfigSM.hs index 691b03c86..e04e8c818 100644 --- a/wizard-server/src/Wizard/Api/Resource/Config/ClientConfigSM.hs +++ b/wizard-server/src/Wizard/Api/Resource/Config/ClientConfigSM.hs @@ -18,7 +18,7 @@ import Wizard.Service.User.UserMapper import qualified WizardLib.Public.Database.Migration.Development.Tenant.Data.TenantConfigs as STC instance ToSchema ClientConfigDTO where - declareNamedSchema = toSwaggerWithType "type" (toClientConfigDTO S.defaultConfig TC.defaultOrganization TC.defaultAuthentication TC.defaultPrivacyAndSupport TC.defaultDashboardAndLoginScreen STC.defaultLookAndFeel TC.defaultRegistry TC.defaultQuestionnaire TC.defaultSubmission STC.defaultFeatures TC.defaultOwl (Just $ toUserProfile (toDTO userAlbert) []) [] defaultTenant) + declareNamedSchema = toSwaggerWithType "type" (toClientConfigDTO S.defaultConfig TC.defaultOrganization TC.defaultAuthentication TC.defaultPrivacyAndSupport TC.defaultDashboardAndLoginScreen STC.defaultLookAndFeel TC.defaultRegistry TC.defaultProject TC.defaultSubmission STC.defaultFeatures TC.defaultOwl (Just $ toUserProfile (toDTO userAlbert) []) [] defaultTenant) instance ToSchema ClientConfigAuthDTO where declareNamedSchema = toSwagger (toClientAuthDTO TC.defaultAuthentication) @@ -32,8 +32,8 @@ instance ToSchema ClientConfigAuthExternalServiceDTO where instance ToSchema ClientConfigRegistryDTO where declareNamedSchema = toSwagger (toClientConfigRegistryDTO S.defaultRegistry TC.defaultRegistry) -instance ToSchema ClientConfigQuestionnaireDTO where - declareNamedSchema = toSwagger (toClientConfigQuestionnaireDTO TC.defaultQuestionnaire) +instance ToSchema ClientConfigProjectDTO where + declareNamedSchema = toSwagger (toClientConfigProjectDTO TC.defaultProject) instance ToSchema ClientConfigCloudDTO where declareNamedSchema = toSwagger (toClientConfigCloudDTO S_S.defaultCloud defaultTenant) diff --git a/wizard-server/src/Wizard/Api/Resource/Document/DocumentCreateDTO.hs b/wizard-server/src/Wizard/Api/Resource/Document/DocumentCreateDTO.hs index f6f76a8e4..3cfdf3693 100644 --- a/wizard-server/src/Wizard/Api/Resource/Document/DocumentCreateDTO.hs +++ b/wizard-server/src/Wizard/Api/Resource/Document/DocumentCreateDTO.hs @@ -5,8 +5,8 @@ import GHC.Generics data DocumentCreateDTO = DocumentCreateDTO { name :: String - , questionnaireUuid :: U.UUID - , questionnaireEventUuid :: Maybe U.UUID + , projectUuid :: U.UUID + , projectEventUuid :: Maybe U.UUID , documentTemplateId :: String , formatUuid :: U.UUID } diff --git a/wizard-server/src/Wizard/Api/Resource/Document/DocumentDTO.hs b/wizard-server/src/Wizard/Api/Resource/Document/DocumentDTO.hs index 3af611d16..cd894b005 100644 --- a/wizard-server/src/Wizard/Api/Resource/Document/DocumentDTO.hs +++ b/wizard-server/src/Wizard/Api/Resource/Document/DocumentDTO.hs @@ -8,16 +8,16 @@ import GHC.Int import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplateFormatSimple import Wizard.Api.Resource.Submission.SubmissionJM () import Wizard.Model.Document.Document -import Wizard.Model.Questionnaire.QuestionnaireSimple +import Wizard.Model.Project.ProjectSimple import Wizard.Model.Submission.SubmissionList data DocumentDTO = DocumentDTO { uuid :: U.UUID , name :: String , state :: DocumentState - , questionnaire :: Maybe QuestionnaireSimple - , questionnaireEventUuid :: Maybe U.UUID - , questionnaireVersion :: Maybe String + , project :: Maybe ProjectSimple + , projectEventUuid :: Maybe U.UUID + , projectVersion :: Maybe String , documentTemplateId :: String , documentTemplateName :: String , format :: Maybe DocumentTemplateFormatSimple diff --git a/wizard-server/src/Wizard/Api/Resource/Document/DocumentJM.hs b/wizard-server/src/Wizard/Api/Resource/Document/DocumentJM.hs index e37459714..f6836d5a0 100644 --- a/wizard-server/src/Wizard/Api/Resource/Document/DocumentJM.hs +++ b/wizard-server/src/Wizard/Api/Resource/Document/DocumentJM.hs @@ -5,7 +5,7 @@ import Data.Aeson import Shared.Common.Util.Aeson import Shared.DocumentTemplate.Api.Resource.DocumentTemplate.DocumentTemplateFormatSimpleJM () import Wizard.Api.Resource.Document.DocumentDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireSimpleJM () +import Wizard.Api.Resource.Project.ProjectSimpleJM () import Wizard.Model.Document.Document instance FromJSON DocumentState diff --git a/wizard-server/src/Wizard/Api/Resource/Document/DocumentSM.hs b/wizard-server/src/Wizard/Api/Resource/Document/DocumentSM.hs index a200bbc5e..f5caee507 100644 --- a/wizard-server/src/Wizard/Api/Resource/Document/DocumentSM.hs +++ b/wizard-server/src/Wizard/Api/Resource/Document/DocumentSM.hs @@ -6,7 +6,7 @@ import Shared.Common.Util.Swagger import Wizard.Api.Resource.Document.DocumentDTO import Wizard.Api.Resource.Document.DocumentJM () import Wizard.Api.Resource.DocumentTemplate.DocumentTemplateSimpleSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSimpleSM () +import Wizard.Api.Resource.Project.ProjectSimpleSM () import Wizard.Api.Resource.Submission.SubmissionSM () import Wizard.Database.Migration.Development.Document.Data.Documents import Wizard.Model.Document.Document diff --git a/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDataChangeDTO.hs b/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDataChangeDTO.hs index bf91354f0..10f8f4bbc 100644 --- a/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDataChangeDTO.hs +++ b/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDataChangeDTO.hs @@ -4,7 +4,7 @@ import qualified Data.UUID as U import GHC.Generics data DocumentTemplateDraftDataChangeDTO = DocumentTemplateDraftDataChangeDTO - { questionnaireUuid :: Maybe U.UUID + { projectUuid :: Maybe U.UUID , knowledgeModelEditorUuid :: Maybe U.UUID , formatUuid :: Maybe U.UUID } diff --git a/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDataDTO.hs b/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDataDTO.hs index a06942879..ba92e2f24 100644 --- a/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDataDTO.hs +++ b/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDataDTO.hs @@ -4,11 +4,11 @@ import qualified Data.UUID as U import GHC.Generics import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditorSuggestion -import Wizard.Model.Questionnaire.QuestionnaireSuggestion +import Wizard.Model.Project.ProjectSuggestion data DocumentTemplateDraftDataDTO = DocumentTemplateDraftDataDTO - { questionnaireUuid :: Maybe U.UUID - , questionnaire :: Maybe QuestionnaireSuggestion + { projectUuid :: Maybe U.UUID + , project :: Maybe ProjectSuggestion , knowledgeModelEditorUuid :: Maybe U.UUID , knowledgeModelEditor :: Maybe KnowledgeModelEditorSuggestion , formatUuid :: Maybe U.UUID diff --git a/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDataJM.hs b/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDataJM.hs index f0a48850a..06eab8dbb 100644 --- a/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDataJM.hs +++ b/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDataJM.hs @@ -5,7 +5,7 @@ import Data.Aeson import Shared.Common.Util.Aeson import Wizard.Api.Resource.DocumentTemplate.Draft.DocumentTemplateDraftDataDTO import Wizard.Api.Resource.KnowledgeModel.Editor.KnowledgeModelEditorSuggestionJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSuggestionJM () +import Wizard.Api.Resource.Project.ProjectSuggestionJM () instance FromJSON DocumentTemplateDraftDataDTO where parseJSON = genericParseJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDataSM.hs b/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDataSM.hs index 89bea6530..d155bace2 100644 --- a/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDataSM.hs +++ b/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDataSM.hs @@ -6,7 +6,7 @@ import Shared.Common.Util.Swagger import Wizard.Api.Resource.DocumentTemplate.Draft.DocumentTemplateDraftDataDTO import Wizard.Api.Resource.DocumentTemplate.Draft.DocumentTemplateDraftDataJM () import Wizard.Api.Resource.KnowledgeModel.Editor.KnowledgeModelEditorSuggestionSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSuggestionSM () +import Wizard.Api.Resource.Project.ProjectSuggestionSM () import Wizard.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplateDrafts instance ToSchema DocumentTemplateDraftDataDTO where diff --git a/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDetailJM.hs b/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDetailJM.hs index db91a672a..ebed3a6b4 100644 --- a/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDetailJM.hs +++ b/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDetailJM.hs @@ -6,7 +6,7 @@ import Shared.Common.Util.Aeson import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplateJM () import Shared.KnowledgeModel.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackagePatternJM () import Wizard.Api.Resource.KnowledgeModel.Editor.KnowledgeModelEditorSuggestionJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSuggestionJM () +import Wizard.Api.Resource.Project.ProjectSuggestionJM () import Wizard.Model.DocumentTemplate.DocumentTemplateDraftDetail instance FromJSON DocumentTemplateDraftDetail where diff --git a/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDetailSM.hs b/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDetailSM.hs index dfe9b2b26..7c202938f 100644 --- a/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDetailSM.hs +++ b/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDetailSM.hs @@ -9,7 +9,7 @@ import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.D import Shared.KnowledgeModel.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackagePatternSM () import Wizard.Api.Resource.DocumentTemplate.Draft.DocumentTemplateDraftDetailJM () import Wizard.Api.Resource.KnowledgeModel.Editor.KnowledgeModelEditorSuggestionSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSuggestionSM () +import Wizard.Api.Resource.Project.ProjectSuggestionSM () import Wizard.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplateDrafts import Wizard.Model.DocumentTemplate.DocumentTemplateDraftDetail import Wizard.Service.DocumentTemplate.Draft.DocumentTemplateDraftMapper diff --git a/wizard-server/src/Wizard/Api/Resource/Feedback/FeedbackSM.hs b/wizard-server/src/Wizard/Api/Resource/Feedback/FeedbackSM.hs index ae026d2d8..7dd8ad438 100644 --- a/wizard-server/src/Wizard/Api/Resource/Feedback/FeedbackSM.hs +++ b/wizard-server/src/Wizard/Api/Resource/Feedback/FeedbackSM.hs @@ -7,8 +7,8 @@ import Wizard.Api.Resource.Feedback.FeedbackDTO import Wizard.Api.Resource.Feedback.FeedbackJM () import Wizard.Database.Migration.Development.Feedback.Data.Feedbacks import Wizard.Database.Migration.Development.Tenant.Data.TenantConfigs -import Wizard.Model.Config.ServerConfigDM hiding (defaultQuestionnaire) +import Wizard.Model.Config.ServerConfigDM hiding (defaultProject) import Wizard.Service.Feedback.FeedbackMapper instance ToSchema FeedbackDTO where - declareNamedSchema = toSwagger (toDTO defaultConfig defaultQuestionnaire feedback1) + declareNamedSchema = toSwagger (toDTO defaultConfig defaultProject feedback1) diff --git a/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Editor/Event/SetRepliesDTO.hs b/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Editor/Event/SetRepliesDTO.hs index 8e604f28b..98cc9955a 100644 --- a/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Editor/Event/SetRepliesDTO.hs +++ b/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Editor/Event/SetRepliesDTO.hs @@ -4,7 +4,7 @@ import qualified Data.Map.Strict as M import qualified Data.UUID as U import GHC.Generics -import Wizard.Model.Questionnaire.QuestionnaireReply +import Wizard.Model.Project.ProjectReply data SetRepliesDTO = SetRepliesDTO { uuid :: U.UUID diff --git a/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Editor/Event/SetRepliesJM.hs b/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Editor/Event/SetRepliesJM.hs index 32599affb..c92a12004 100644 --- a/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Editor/Event/SetRepliesJM.hs +++ b/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Editor/Event/SetRepliesJM.hs @@ -4,7 +4,7 @@ import Data.Aeson import Shared.Common.Util.Aeson import Wizard.Api.Resource.KnowledgeModel.Editor.Event.SetRepliesDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireReplyJM () +import Wizard.Api.Resource.Project.ProjectReplyJM () instance FromJSON SetRepliesDTO where parseJSON = genericParseJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Editor/Event/SetRepliesSM.hs b/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Editor/Event/SetRepliesSM.hs index 75552f770..5c7d8ab5b 100644 --- a/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Editor/Event/SetRepliesSM.hs +++ b/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Editor/Event/SetRepliesSM.hs @@ -5,7 +5,7 @@ import Data.Swagger import Shared.Common.Util.Swagger import Wizard.Api.Resource.KnowledgeModel.Editor.Event.SetRepliesDTO import Wizard.Api.Resource.KnowledgeModel.Editor.Event.SetRepliesJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireReplySM () +import Wizard.Api.Resource.Project.ProjectReplySM () import Wizard.Database.Migration.Development.KnowledgeModel.Data.Editor.KnowledgeModelEditorEvents instance ToSchema SetRepliesDTO where diff --git a/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Editor/KnowledgeModelEditorDetailDTO.hs b/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Editor/KnowledgeModelEditorDetailDTO.hs index ef5e71ba6..b9c41c8a9 100644 --- a/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Editor/KnowledgeModelEditorDetailDTO.hs +++ b/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Editor/KnowledgeModelEditorDetailDTO.hs @@ -9,7 +9,7 @@ import Shared.KnowledgeModel.Model.KnowledgeModel.Event.KnowledgeModelEvent import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSimpleDTO import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditorState -import Wizard.Model.Questionnaire.QuestionnaireReply +import Wizard.Model.Project.ProjectReply data KnowledgeModelEditorDetailDTO = KnowledgeModelEditorDetailDTO { uuid :: U.UUID diff --git a/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Editor/KnowledgeModelEditorDetailJM.hs b/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Editor/KnowledgeModelEditorDetailJM.hs index 842288465..b95d04e44 100644 --- a/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Editor/KnowledgeModelEditorDetailJM.hs +++ b/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Editor/KnowledgeModelEditorDetailJM.hs @@ -7,7 +7,7 @@ import Shared.KnowledgeModel.Api.Resource.KnowledgeModel.Event.KnowledgeModelEve import Wizard.Api.Resource.KnowledgeModel.Editor.KnowledgeModelEditorDetailDTO import Wizard.Api.Resource.KnowledgeModel.Editor.KnowledgeModelEditorStateJM () import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSimpleJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireReplyJM () +import Wizard.Api.Resource.Project.ProjectReplyJM () instance FromJSON KnowledgeModelEditorDetailDTO where parseJSON = genericParseJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Editor/KnowledgeModelEditorDetailSM.hs b/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Editor/KnowledgeModelEditorDetailSM.hs index 583dfd2db..ef320457b 100644 --- a/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Editor/KnowledgeModelEditorDetailSM.hs +++ b/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Editor/KnowledgeModelEditorDetailSM.hs @@ -8,7 +8,7 @@ import Wizard.Api.Resource.KnowledgeModel.Editor.KnowledgeModelEditorDetailDTO import Wizard.Api.Resource.KnowledgeModel.Editor.KnowledgeModelEditorDetailJM () import Wizard.Api.Resource.KnowledgeModel.Editor.KnowledgeModelEditorStateSM () import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSimpleSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireReplySM () +import Wizard.Api.Resource.Project.ProjectReplySM () import Wizard.Database.Migration.Development.KnowledgeModel.Data.Editor.KnowledgeModelEditors instance ToSchema KnowledgeModelEditorDetailDTO where diff --git a/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Migration/KnowledgeModelMigrationCreateSM.hs b/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Migration/KnowledgeModelMigrationCreateSM.hs index d8cb83a46..784baca63 100644 --- a/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Migration/KnowledgeModelMigrationCreateSM.hs +++ b/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Migration/KnowledgeModelMigrationCreateSM.hs @@ -8,4 +8,4 @@ import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationCreat import Wizard.Database.Migration.Development.KnowledgeModel.Data.Migration.KnowledgeModelMigrations instance ToSchema KnowledgeModelMigrationCreateDTO where - declareNamedSchema = toSwagger migratorStateCreate + declareNamedSchema = toSwagger knowledgeModelMigrationCreateDTO diff --git a/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Migration/KnowledgeModelMigrationResolutionSM.hs b/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Migration/KnowledgeModelMigrationResolutionSM.hs index 3805c03a9..1d6c6c6f3 100644 --- a/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Migration/KnowledgeModelMigrationResolutionSM.hs +++ b/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Migration/KnowledgeModelMigrationResolutionSM.hs @@ -10,4 +10,4 @@ import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationResol import Wizard.Database.Migration.Development.KnowledgeModel.Data.Migration.KnowledgeModelMigrations instance ToSchema KnowledgeModelMigrationResolutionDTO where - declareNamedSchema = toSwagger migratorConflict + declareNamedSchema = toSwagger knowledgeModelMigrationResolutionDTO diff --git a/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Migration/KnowledgeModelMigrationSM.hs b/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Migration/KnowledgeModelMigrationSM.hs index 6531380fa..af4349679 100644 --- a/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Migration/KnowledgeModelMigrationSM.hs +++ b/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Migration/KnowledgeModelMigrationSM.hs @@ -9,4 +9,4 @@ import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationState import Wizard.Database.Migration.Development.KnowledgeModel.Data.Migration.KnowledgeModelMigrations instance ToSchema KnowledgeModelMigrationDTO where - declareNamedSchema = toSwagger migratorState + declareNamedSchema = toSwagger knowledgeModelMigrationDTO diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Acl/ProjectPermChangeDTO.hs b/wizard-server/src/Wizard/Api/Resource/Project/Acl/ProjectPermChangeDTO.hs new file mode 100644 index 000000000..48ec002e8 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Acl/ProjectPermChangeDTO.hs @@ -0,0 +1,13 @@ +module Wizard.Api.Resource.Project.Acl.ProjectPermChangeDTO where + +import qualified Data.UUID as U +import GHC.Generics + +import Wizard.Model.Project.Acl.ProjectPerm + +data ProjectPermChangeDTO = ProjectPermChangeDTO + { memberType :: ProjectPermType + , memberUuid :: U.UUID + , perms :: [String] + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Acl/ProjectPermChangeJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Acl/ProjectPermChangeJM.hs new file mode 100644 index 000000000..1d3764f0f --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Acl/ProjectPermChangeJM.hs @@ -0,0 +1,15 @@ +module Wizard.Api.Resource.Project.Acl.ProjectPermChangeJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.Project.Acl.ProjectPermChangeDTO +import Wizard.Api.Resource.Project.Acl.ProjectPermJM () +import Wizard.Api.Resource.Project.ProjectSharingJM () +import Wizard.Api.Resource.Project.ProjectVisibilityJM () + +instance FromJSON ProjectPermChangeDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectPermChangeDTO where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Acl/ProjectPermChangeSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Acl/ProjectPermChangeSM.hs new file mode 100644 index 000000000..417118362 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Acl/ProjectPermChangeSM.hs @@ -0,0 +1,15 @@ +module Wizard.Api.Resource.Project.Acl.ProjectPermChangeSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.Acl.ProjectPermChangeDTO +import Wizard.Api.Resource.Project.Acl.ProjectPermChangeJM () +import Wizard.Api.Resource.Project.Acl.ProjectPermSM () +import Wizard.Api.Resource.Project.ProjectSharingSM () +import Wizard.Api.Resource.Project.ProjectVisibilitySM () +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Service.Project.ProjectMapper + +instance ToSchema ProjectPermChangeDTO where + declareNamedSchema = toSwagger (toProjectPermChangeDTO project1AlbertEditProjectPerm) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Acl/ProjectPermDTO.hs b/wizard-server/src/Wizard/Api/Resource/Project/Acl/ProjectPermDTO.hs new file mode 100644 index 000000000..8d9207315 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Acl/ProjectPermDTO.hs @@ -0,0 +1,29 @@ +module Wizard.Api.Resource.Project.Acl.ProjectPermDTO where + +import qualified Data.UUID as U +import GHC.Generics +import GHC.Records + +import Wizard.Api.Resource.Acl.MemberDTO +import Wizard.Model.Project.Acl.ProjectPerm + +data ProjectPermDTO = ProjectPermDTO + { projectUuid :: U.UUID + , member :: MemberDTO + , perms :: [String] + } + deriving (Generic, Eq, Show) + +instance Ord ProjectPermDTO where + compare a b = compare a.member.uuid b.member.uuid + +instance ProjectPermC ProjectPermDTO + +instance HasField "memberType" ProjectPermDTO ProjectPermType where + getField perm = + case perm.member of + UserMemberDTO {} -> UserProjectPermType + UserGroupMemberDTO {} -> UserGroupProjectPermType + +instance HasField "memberUuid" ProjectPermDTO U.UUID where + getField perm = perm.member.uuid diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Acl/ProjectPermJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Acl/ProjectPermJM.hs new file mode 100644 index 000000000..4d4c77367 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Acl/ProjectPermJM.hs @@ -0,0 +1,24 @@ +module Wizard.Api.Resource.Project.Acl.ProjectPermJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.Acl.MemberJM () +import Wizard.Api.Resource.Project.Acl.ProjectPermDTO +import Wizard.Model.Project.Acl.ProjectPerm + +instance FromJSON ProjectPermType + +instance ToJSON ProjectPermType + +instance FromJSON ProjectPerm where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectPerm where + toJSON = genericToJSON jsonOptions + +instance FromJSON ProjectPermDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectPermDTO where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Acl/ProjectPermSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Acl/ProjectPermSM.hs new file mode 100644 index 000000000..0220fd0aa --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Acl/ProjectPermSM.hs @@ -0,0 +1,21 @@ +module Wizard.Api.Resource.Project.Acl.ProjectPermSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Acl.MemberSM () +import Wizard.Api.Resource.Project.Acl.ProjectPermDTO +import Wizard.Api.Resource.Project.Acl.ProjectPermJM () +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Database.Migration.Development.User.Data.Users +import Wizard.Model.Project.Acl.ProjectPerm +import Wizard.Service.Project.ProjectMapper + +instance ToSchema ProjectPermType + +instance ToSchema ProjectPerm where + declareNamedSchema = toSwagger bioGroupEditProjectPerm + +instance ToSchema ProjectPermDTO where + declareNamedSchema = + toSwagger (toUserProjectPermDTO bioGroupEditProjectPerm userAlbert) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Action/ProjectActionChangeDTO.hs b/wizard-server/src/Wizard/Api/Resource/Project/Action/ProjectActionChangeDTO.hs new file mode 100644 index 000000000..c18a47c57 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Action/ProjectActionChangeDTO.hs @@ -0,0 +1,8 @@ +module Wizard.Api.Resource.Project.Action.ProjectActionChangeDTO where + +import GHC.Generics + +data ProjectActionChangeDTO = ProjectActionChangeDTO + { enabled :: Bool + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Action/ProjectActionChangeJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Action/ProjectActionChangeJM.hs new file mode 100644 index 000000000..dc5330c4e --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Action/ProjectActionChangeJM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.Project.Action.ProjectActionChangeJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.Project.Action.ProjectActionChangeDTO + +instance FromJSON ProjectActionChangeDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectActionChangeDTO where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Action/ProjectActionChangeSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Action/ProjectActionChangeSM.hs new file mode 100644 index 000000000..2891bf36a --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Action/ProjectActionChangeSM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.Project.Action.ProjectActionChangeSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.Action.ProjectActionChangeDTO +import Wizard.Api.Resource.Project.Action.ProjectActionChangeJM () +import Wizard.Database.Migration.Development.Project.Data.ProjectActions +import Wizard.Service.Project.Action.ProjectActionMapper + +instance ToSchema ProjectActionChangeDTO where + declareNamedSchema = toSwagger (toChangeDTO projectActionFtp1) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Action/ProjectActionDTO.hs b/wizard-server/src/Wizard/Api/Resource/Project/Action/ProjectActionDTO.hs new file mode 100644 index 000000000..4259f09c8 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Action/ProjectActionDTO.hs @@ -0,0 +1,15 @@ +module Wizard.Api.Resource.Project.Action.ProjectActionDTO where + +import Data.Time +import GHC.Generics + +data ProjectActionDTO = ProjectActionDTO + { paId :: String + , name :: String + , description :: String + , url :: String + , enabled :: Bool + , createdAt :: UTCTime + , updatedAt :: UTCTime + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Action/ProjectActionJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Action/ProjectActionJM.hs new file mode 100644 index 000000000..86953a737 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Action/ProjectActionJM.hs @@ -0,0 +1,14 @@ +module Wizard.Api.Resource.Project.Action.ProjectActionJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSimpleJM () +import Wizard.Api.Resource.Project.Action.ProjectActionDTO +import Wizard.Api.Resource.User.UserJM () + +instance FromJSON ProjectActionDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectActionDTO where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Action/ProjectActionSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Action/ProjectActionSM.hs new file mode 100644 index 000000000..4ce8f22a2 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Action/ProjectActionSM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.Project.Action.ProjectActionSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.Action.ProjectActionDTO +import Wizard.Api.Resource.Project.Action.ProjectActionJM () +import Wizard.Database.Migration.Development.Project.Data.ProjectActions +import Wizard.Service.Project.Action.ProjectActionMapper + +instance ToSchema ProjectActionDTO where + declareNamedSchema = toSwagger (toDTO projectActionFtp1) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Comment/ProjectCommentThreadAssignedJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Comment/ProjectCommentThreadAssignedJM.hs new file mode 100644 index 000000000..d73a1b805 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Comment/ProjectCommentThreadAssignedJM.hs @@ -0,0 +1,13 @@ +module Wizard.Api.Resource.Project.Comment.ProjectCommentThreadAssignedJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Model.Project.Comment.ProjectCommentThreadAssigned +import WizardLib.Public.Api.Resource.User.UserSuggestionJM () + +instance FromJSON ProjectCommentThreadAssigned where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectCommentThreadAssigned where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Comment/ProjectCommentThreadAssignedSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Comment/ProjectCommentThreadAssignedSM.hs new file mode 100644 index 000000000..e47c09b34 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Comment/ProjectCommentThreadAssignedSM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.Project.Comment.ProjectCommentThreadAssignedSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.Comment.ProjectCommentThreadAssignedJM () +import Wizard.Database.Migration.Development.Project.Data.ProjectComments +import Wizard.Model.Project.Comment.ProjectCommentThreadAssigned +import WizardLib.Public.Api.Resource.User.UserSuggestionSM () + +instance ToSchema ProjectCommentThreadAssigned where + declareNamedSchema = toSwagger cmtAssigned diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Comment/ProjectCommentThreadListJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Comment/ProjectCommentThreadListJM.hs new file mode 100644 index 000000000..3ed504fe0 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Comment/ProjectCommentThreadListJM.hs @@ -0,0 +1,19 @@ +module Wizard.Api.Resource.Project.Comment.ProjectCommentThreadListJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Model.Project.Comment.ProjectCommentList +import WizardLib.Public.Api.Resource.User.UserSuggestionJM () + +instance FromJSON ProjectCommentThreadList where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectCommentThreadList where + toJSON = genericToJSON jsonOptions + +instance FromJSON ProjectCommentList where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectCommentList where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Comment/ProjectCommentThreadListSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Comment/ProjectCommentThreadListSM.hs new file mode 100644 index 000000000..8429b47ce --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Comment/ProjectCommentThreadListSM.hs @@ -0,0 +1,15 @@ +module Wizard.Api.Resource.Project.Comment.ProjectCommentThreadListSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.Comment.ProjectCommentThreadListJM () +import Wizard.Database.Migration.Development.Project.Data.ProjectComments +import Wizard.Model.Project.Comment.ProjectCommentList +import WizardLib.Public.Api.Resource.User.UserSuggestionSM () + +instance ToSchema ProjectCommentThreadList where + declareNamedSchema = toSwagger cmtQ1_t1Dto + +instance ToSchema ProjectCommentList where + declareNamedSchema = toSwagger cmtQ1_t1_1Dto diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Comment/ProjectCommentThreadNotificationJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Comment/ProjectCommentThreadNotificationJM.hs new file mode 100644 index 000000000..25ba7fb7a --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Comment/ProjectCommentThreadNotificationJM.hs @@ -0,0 +1,13 @@ +module Wizard.Api.Resource.Project.Comment.ProjectCommentThreadNotificationJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.User.UserSimpleJM () +import Wizard.Model.Project.Comment.ProjectCommentThreadNotification + +instance FromJSON ProjectCommentThreadNotification where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectCommentThreadNotification where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailDTO.hs b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailDTO.hs new file mode 100644 index 000000000..8da568fec --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailDTO.hs @@ -0,0 +1,20 @@ +module Wizard.Api.Resource.Project.Detail.ProjectDetailDTO where + +import qualified Data.UUID as U +import GHC.Generics + +import Wizard.Api.Resource.Project.Acl.ProjectPermDTO +import Wizard.Model.Project.Project + +data ProjectDetailDTO = ProjectDetailDTO + { uuid :: U.UUID + , name :: String + , sharing :: ProjectSharing + , visibility :: ProjectVisibility + , knowledgeModelPackageId :: String + , isTemplate :: Bool + , migrationUuid :: Maybe U.UUID + , permissions :: [ProjectPermDTO] + , fileCount :: Int + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailJM.hs new file mode 100644 index 000000000..ca8d3a6ac --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailJM.hs @@ -0,0 +1,15 @@ +module Wizard.Api.Resource.Project.Detail.ProjectDetailJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.Project.Acl.ProjectPermJM () +import Wizard.Api.Resource.Project.Detail.ProjectDetailDTO +import Wizard.Api.Resource.Project.ProjectSharingJM () +import Wizard.Api.Resource.Project.ProjectVisibilityJM () + +instance FromJSON ProjectDetailDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectDetailDTO where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailPreviewJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailPreviewJM.hs new file mode 100644 index 000000000..487ae6117 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailPreviewJM.hs @@ -0,0 +1,16 @@ +module Wizard.Api.Resource.Project.Detail.ProjectDetailPreviewJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Shared.DocumentTemplate.Api.Resource.DocumentTemplate.DocumentTemplateJM () +import Wizard.Api.Resource.Project.Acl.ProjectPermJM () +import Wizard.Api.Resource.Project.ProjectSharingJM () +import Wizard.Api.Resource.Project.ProjectVisibilityJM () +import Wizard.Model.Project.Detail.ProjectDetailPreview + +instance FromJSON ProjectDetailPreview where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectDetailPreview where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailPreviewSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailPreviewSM.hs new file mode 100644 index 000000000..452354b80 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailPreviewSM.hs @@ -0,0 +1,35 @@ +module Wizard.Api.Resource.Project.Detail.ProjectDetailPreviewSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Shared.DocumentTemplate.Api.Resource.DocumentTemplate.DocumentTemplateSM () +import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplateFormats +import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplates +import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplate +import qualified Shared.DocumentTemplate.Service.DocumentTemplate.DocumentTemplateMapper as DocumentTemplateMapper +import Shared.KnowledgeModel.Api.Resource.KnowledgeModel.KnowledgeModelSM () +import Wizard.Api.Resource.Project.Acl.ProjectPermSM () +import Wizard.Api.Resource.Project.Detail.ProjectDetailPreviewJM () +import Wizard.Api.Resource.Project.ProjectSharingSM () +import Wizard.Api.Resource.Project.ProjectVisibilitySM () +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Model.Project.Detail.ProjectDetailPreview +import Wizard.Model.Project.Project + +instance ToSchema ProjectDetailPreview where + declareNamedSchema = + toSwagger $ + ProjectDetailPreview + { uuid = project1.uuid + , name = project1.name + , visibility = project1.visibility + , sharing = project1.sharing + , knowledgeModelPackageId = project1.knowledgeModelPackageId + , isTemplate = project1.isTemplate + , documentTemplateId = Just wizardDocumentTemplate.tId + , migrationUuid = Nothing + , permissions = [project1AlbertEditProjectPermDto] + , format = Just . DocumentTemplateMapper.toFormatSimple $ formatJson + , fileCount = 0 + } diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailQuestionnaireDTO.hs b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailQuestionnaireDTO.hs new file mode 100644 index 000000000..dfc70f0ab --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailQuestionnaireDTO.hs @@ -0,0 +1,34 @@ +module Wizard.Api.Resource.Project.Detail.ProjectDetailQuestionnaireDTO where + +import qualified Data.Map.Strict as M +import qualified Data.UUID as U +import GHC.Generics + +import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel +import Wizard.Api.Resource.Project.Acl.ProjectPermDTO +import Wizard.Model.Project.File.ProjectFileSimple +import Wizard.Model.Project.Project +import Wizard.Model.Project.ProjectReply + +data ProjectDetailQuestionnaireDTO = ProjectDetailQuestionnaireDTO + { uuid :: U.UUID + , name :: String + , visibility :: ProjectVisibility + , sharing :: ProjectSharing + , knowledgeModelPackageId :: String + , selectedQuestionTagUuids :: [U.UUID] + , isTemplate :: Bool + , knowledgeModel :: KnowledgeModel + , replies :: M.Map String Reply + , labels :: M.Map String [U.UUID] + , phaseUuid :: Maybe U.UUID + , migrationUuid :: Maybe U.UUID + , permissions :: [ProjectPermDTO] + , files :: [ProjectFileSimple] + , unresolvedCommentCounts :: M.Map String (M.Map U.UUID Int) + , resolvedCommentCounts :: M.Map String (M.Map U.UUID Int) + , projectActionsAvailable :: Int + , projectImportersAvailable :: Int + , fileCount :: Int + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailQuestionnaireJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailQuestionnaireJM.hs new file mode 100644 index 000000000..7a8e250f4 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailQuestionnaireJM.hs @@ -0,0 +1,18 @@ +module Wizard.Api.Resource.Project.Detail.ProjectDetailQuestionnaireJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Shared.KnowledgeModel.Api.Resource.KnowledgeModel.KnowledgeModelJM () +import Wizard.Api.Resource.Project.Acl.ProjectPermJM () +import Wizard.Api.Resource.Project.Detail.ProjectDetailQuestionnaireDTO +import Wizard.Api.Resource.Project.File.ProjectFileSimpleJM () +import Wizard.Api.Resource.Project.ProjectReplyJM () +import Wizard.Api.Resource.Project.ProjectSharingJM () +import Wizard.Api.Resource.Project.ProjectVisibilityJM () + +instance FromJSON ProjectDetailQuestionnaireDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectDetailQuestionnaireDTO where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailQuestionnaireSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailQuestionnaireSM.hs new file mode 100644 index 000000000..611d6f2fa --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailQuestionnaireSM.hs @@ -0,0 +1,57 @@ +module Wizard.Api.Resource.Project.Detail.ProjectDetailQuestionnaireSM where + +import Data.Map.Strict as M +import Data.Swagger + +import Shared.Common.Util.Swagger +import Shared.Common.Util.Uuid +import Shared.KnowledgeModel.Api.Resource.KnowledgeModel.KnowledgeModelSM () +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.KnowledgeModels +import Wizard.Api.Resource.Project.Acl.ProjectPermSM () +import Wizard.Api.Resource.Project.Detail.ProjectDetailQuestionnaireDTO +import Wizard.Api.Resource.Project.Detail.ProjectDetailQuestionnaireJM () +import Wizard.Api.Resource.Project.File.ProjectFileSimpleSM () +import Wizard.Api.Resource.Project.ProjectReplySM () +import Wizard.Api.Resource.Project.ProjectSharingSM () +import Wizard.Api.Resource.Project.ProjectVisibilitySM () +import Wizard.Database.Migration.Development.Project.Data.ProjectLabels +import Wizard.Database.Migration.Development.Project.Data.ProjectReplies +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Model.Project.Project + +instance ToSchema ProjectDetailQuestionnaireDTO where + declareNamedSchema = + toSwagger $ + ProjectDetailQuestionnaireDTO + { uuid = project1.uuid + , name = project1.name + , visibility = project1.visibility + , sharing = project1.sharing + , knowledgeModelPackageId = project1.knowledgeModelPackageId + , selectedQuestionTagUuids = project1.selectedQuestionTagUuids + , isTemplate = project1.isTemplate + , knowledgeModel = km1 + , replies = fReplies + , labels = fLabels + , phaseUuid = Just . u' $ "4b376e49-1589-429b-9590-c654378f0bd5" + , migrationUuid = Nothing + , permissions = [project1AlbertEditProjectPermDto] + , files = [] + , unresolvedCommentCounts = + M.fromList + [ + ( "4f61fdfa-ce82-41b5-a1e6-218beaf41660.0dc58313-eb80-4f74-a8c1-347b644665d5" + , M.fromList [(u' "f1de85a9-7f22-4d0c-bc23-3315cc4c85d7", 4)] + ) + ] + , resolvedCommentCounts = + M.fromList + [ + ( "4f61fdfa-ce82-41b5-a1e6-218beaf41660.0dc58313-eb80-4f74-a8c1-347b644665d5" + , M.fromList [(u' "f1de85a9-7f22-4d0c-bc23-3315cc4c85d7", 2)] + ) + ] + , projectActionsAvailable = 1 + , projectImportersAvailable = 2 + , fileCount = 0 + } diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailReportDTO.hs b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailReportDTO.hs new file mode 100644 index 000000000..523e8e1ea --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailReportDTO.hs @@ -0,0 +1,26 @@ +module Wizard.Api.Resource.Project.Detail.ProjectDetailReportDTO where + +import qualified Data.UUID as U +import GHC.Generics + +import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel +import Wizard.Api.Resource.Project.Acl.ProjectPermDTO +import Wizard.Model.Project.Project +import Wizard.Model.Report.Report + +data ProjectDetailReportDTO = ProjectDetailReportDTO + { uuid :: U.UUID + , name :: String + , sharing :: ProjectSharing + , visibility :: ProjectVisibility + , knowledgeModelPackageId :: String + , isTemplate :: Bool + , migrationUuid :: Maybe U.UUID + , permissions :: [ProjectPermDTO] + , fileCount :: Int + , totalReport :: TotalReport + , chapterReports :: [ChapterReport] + , chapters :: [Chapter] + , metrics :: [Metric] + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailReportJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailReportJM.hs new file mode 100644 index 000000000..9d64a0489 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailReportJM.hs @@ -0,0 +1,17 @@ +module Wizard.Api.Resource.Project.Detail.ProjectDetailReportJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Shared.KnowledgeModel.Api.Resource.KnowledgeModel.KnowledgeModelJM () +import Wizard.Api.Resource.Project.Acl.ProjectPermJM () +import Wizard.Api.Resource.Project.Detail.ProjectDetailReportDTO +import Wizard.Api.Resource.Project.ProjectSharingJM () +import Wizard.Api.Resource.Project.ProjectVisibilityJM () +import Wizard.Api.Resource.Report.ReportJM () + +instance FromJSON ProjectDetailReportDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectDetailReportDTO where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailReportSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailReportSM.hs new file mode 100644 index 000000000..094f9f71a --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailReportSM.hs @@ -0,0 +1,35 @@ +module Wizard.Api.Resource.Project.Detail.ProjectDetailReportSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Shared.KnowledgeModel.Api.Resource.KnowledgeModel.KnowledgeModelSM () +import Wizard.Api.Resource.Project.Acl.ProjectPermSM () +import Wizard.Api.Resource.Project.Detail.ProjectDetailReportDTO +import Wizard.Api.Resource.Project.Detail.ProjectDetailReportJM () +import Wizard.Api.Resource.Project.ProjectSharingSM () +import Wizard.Api.Resource.Project.ProjectVisibilitySM () +import Wizard.Api.Resource.Report.ReportSM () +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Database.Migration.Development.Report.Data.Reports +import Wizard.Model.Project.Project +import Wizard.Model.Report.Report + +instance ToSchema ProjectDetailReportDTO where + declareNamedSchema = + toSwagger $ + ProjectDetailReportDTO + { uuid = project1.uuid + , name = project1.name + , visibility = project1.visibility + , sharing = project1.sharing + , knowledgeModelPackageId = project1.knowledgeModelPackageId + , isTemplate = project1.isTemplate + , migrationUuid = Nothing + , permissions = [project1AlbertEditProjectPermDto] + , fileCount = 0 + , totalReport = report1.totalReport + , chapterReports = report1.chapterReports + , chapters = report1.chapters + , metrics = report1.metrics + } diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailSM.hs new file mode 100644 index 000000000..9c1775733 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailSM.hs @@ -0,0 +1,27 @@ +module Wizard.Api.Resource.Project.Detail.ProjectDetailSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.Acl.ProjectPermSM () +import Wizard.Api.Resource.Project.Detail.ProjectDetailDTO +import Wizard.Api.Resource.Project.Detail.ProjectDetailJM () +import Wizard.Api.Resource.Project.ProjectSharingSM () +import Wizard.Api.Resource.Project.ProjectVisibilitySM () +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Model.Project.Project + +instance ToSchema ProjectDetailDTO where + declareNamedSchema = + toSwagger $ + ProjectDetailDTO + { uuid = project1.uuid + , name = project1.name + , visibility = project1.visibility + , sharing = project1.sharing + , knowledgeModelPackageId = project1.knowledgeModelPackageId + , isTemplate = project1.isTemplate + , migrationUuid = Nothing + , permissions = [project1AlbertEditProjectPermDto] + , fileCount = 0 + } diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailSettingsJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailSettingsJM.hs new file mode 100644 index 000000000..35d583bb7 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailSettingsJM.hs @@ -0,0 +1,22 @@ +module Wizard.Api.Resource.Project.Detail.ProjectDetailSettingsJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Shared.DocumentTemplate.Api.Resource.DocumentTemplate.DocumentTemplateJM () +import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplateJM () +import Shared.KnowledgeModel.Api.Resource.KnowledgeModel.KnowledgeModelJM () +import Wizard.Api.Resource.DocumentTemplate.DocumentTemplateStateJM () +import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSimpleJM () +import Wizard.Api.Resource.Project.Acl.ProjectPermJM () +import Wizard.Api.Resource.Project.ProjectReplyJM () +import Wizard.Api.Resource.Project.ProjectSharingJM () +import Wizard.Api.Resource.Project.ProjectStateJM () +import Wizard.Api.Resource.Project.ProjectVisibilityJM () +import Wizard.Model.Project.Detail.ProjectDetailSettings + +instance FromJSON ProjectDetailSettings where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectDetailSettings where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailSettingsSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailSettingsSM.hs new file mode 100644 index 000000000..e18c6c44d --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailSettingsSM.hs @@ -0,0 +1,54 @@ +module Wizard.Api.Resource.Project.Detail.ProjectDetailSettingsSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Shared.Common.Util.Uuid +import Shared.DocumentTemplate.Api.Resource.DocumentTemplate.DocumentTemplateSM () +import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplateFormats +import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplates +import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplate +import qualified Shared.DocumentTemplate.Service.DocumentTemplate.DocumentTemplateMapper as DocumentTemplateMapper +import Shared.KnowledgeModel.Api.Resource.KnowledgeModel.KnowledgeModelSM () +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Tags +import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackage +import Wizard.Api.Resource.DocumentTemplate.DocumentTemplateStateSM () +import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSimpleSM () +import Wizard.Api.Resource.Project.Acl.ProjectPermSM () +import Wizard.Api.Resource.Project.Comment.ProjectCommentThreadListSM () +import Wizard.Api.Resource.Project.Detail.ProjectDetailSettingsJM () +import Wizard.Api.Resource.Project.ProjectReplySM () +import Wizard.Api.Resource.Project.ProjectSharingSM () +import Wizard.Api.Resource.Project.ProjectStateSM () +import Wizard.Api.Resource.Project.ProjectVisibilitySM () +import Wizard.Api.Resource.Project.Version.ProjectVersionListSM () +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Model.DocumentTemplate.DocumentTemplateState +import Wizard.Model.Project.Detail.ProjectDetailSettings +import Wizard.Model.Project.Project +import qualified Wizard.Service.KnowledgeModel.Package.KnowledgeModelPackageMapper as PackageMapper + +instance ToSchema ProjectDetailSettings where + declareNamedSchema = + toSwagger $ + ProjectDetailSettings + { uuid = project1.uuid + , name = project1.name + , description = project1.description + , visibility = project1.visibility + , sharing = project1.sharing + , selectedQuestionTagUuids = project1.selectedQuestionTagUuids + , isTemplate = project1.isTemplate + , migrationUuid = Nothing + , permissions = [project1AlbertEditProjectPermDto] + , projectTags = project1.projectTags + , knowledgeModelPackageId = netherlandsKmPackageV2.pId + , knowledgeModelPackage = PackageMapper.toSimpleDTO netherlandsKmPackageV2 + , knowledgeModelTags = [tagDataScience] + , documentTemplate = Just $ DocumentTemplateMapper.toDTO wizardDocumentTemplate wizardDocumentTemplateFormats + , documentTemplateState = Just DefaultDocumentTemplateState + , documentTemplatePhase = Just DraftDocumentTemplatePhase + , formatUuid = Just . u' $ "ae3b9e68-e09e-4ad7-b476-67ab5626e873" + , fileCount = 0 + } diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailWsDTO.hs b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailWsDTO.hs new file mode 100644 index 000000000..c24298d23 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailWsDTO.hs @@ -0,0 +1,28 @@ +module Wizard.Api.Resource.Project.Detail.ProjectDetailWsDTO where + +import qualified Data.Map.Strict as M +import qualified Data.UUID as U +import GHC.Generics + +import Shared.DocumentTemplate.Api.Resource.DocumentTemplate.DocumentTemplateDTO +import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplateFormatSimple +import Wizard.Api.Resource.Project.Acl.ProjectPermDTO +import Wizard.Model.Project.Project + +data ProjectDetailWsDTO = ProjectDetailWsDTO + { name :: String + , description :: Maybe String + , visibility :: ProjectVisibility + , sharing :: ProjectSharing + , projectTags :: [String] + , permissions :: [ProjectPermDTO] + , documentTemplateId :: Maybe String + , documentTemplate :: Maybe DocumentTemplateDTO + , formatUuid :: Maybe U.UUID + , format :: Maybe DocumentTemplateFormatSimple + , isTemplate :: Bool + , labels :: M.Map String [U.UUID] + , unresolvedCommentCounts :: M.Map String (M.Map U.UUID Int) + , resolvedCommentCounts :: M.Map String (M.Map U.UUID Int) + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailWsJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailWsJM.hs new file mode 100644 index 000000000..2624ff4a8 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailWsJM.hs @@ -0,0 +1,17 @@ +module Wizard.Api.Resource.Project.Detail.ProjectDetailWsJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Shared.DocumentTemplate.Api.Resource.DocumentTemplate.DocumentTemplateJM () +import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplateJM () +import Wizard.Api.Resource.Project.Acl.ProjectPermJM () +import Wizard.Api.Resource.Project.Detail.ProjectDetailWsDTO +import Wizard.Api.Resource.Project.ProjectSharingJM () +import Wizard.Api.Resource.Project.ProjectVisibilityJM () + +instance FromJSON ProjectDetailWsDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectDetailWsDTO where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailWsSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailWsSM.hs new file mode 100644 index 000000000..9323c74f3 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Detail/ProjectDetailWsSM.hs @@ -0,0 +1,17 @@ +module Wizard.Api.Resource.Project.Detail.ProjectDetailWsSM where + +import qualified Data.Map.Strict as M +import Data.Swagger + +import Shared.Common.Util.Swagger +import Shared.DocumentTemplate.Api.Resource.DocumentTemplate.DocumentTemplateSM () +import Wizard.Api.Resource.Project.Acl.ProjectPermSM () +import Wizard.Api.Resource.Project.Detail.ProjectDetailWsDTO +import Wizard.Api.Resource.Project.Detail.ProjectDetailWsJM () +import Wizard.Api.Resource.Project.ProjectSharingSM () +import Wizard.Api.Resource.Project.ProjectVisibilitySM () +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Service.Project.ProjectMapper + +instance ToSchema ProjectDetailWsDTO where + declareNamedSchema = toSwagger (toDetailWsDTO project1 Nothing Nothing [] M.empty M.empty M.empty) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Event/ProjectEventChangeDTO.hs b/wizard-server/src/Wizard/Api/Resource/Project/Event/ProjectEventChangeDTO.hs new file mode 100644 index 000000000..e55a2e890 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Event/ProjectEventChangeDTO.hs @@ -0,0 +1,112 @@ +module Wizard.Api.Resource.Project.Event.ProjectEventChangeDTO where + +import qualified Data.UUID as U +import GHC.Generics + +import Wizard.Model.Project.ProjectReply +import WizardLib.Public.Model.User.UserSuggestion + +data ProjectEventChangeDTO + = SetReplyEventChangeDTO' SetReplyEventChangeDTO + | ClearReplyEventChangeDTO' ClearReplyEventChangeDTO + | SetPhaseEventChangeDTO' SetPhaseEventChangeDTO + | SetLabelsEventChangeDTO' SetLabelsEventChangeDTO + | ResolveCommentThreadEventChangeDTO' ResolveCommentThreadEventChangeDTO + | ReopenCommentThreadEventChangeDTO' ReopenCommentThreadEventChangeDTO + | AssignCommentThreadEventChangeDTO' AssignCommentThreadEventChangeDTO + | DeleteCommentThreadEventChangeDTO' DeleteCommentThreadEventChangeDTO + | AddCommentEventChangeDTO' AddCommentEventChangeDTO + | EditCommentEventChangeDTO' EditCommentEventChangeDTO + | DeleteCommentEventChangeDTO' DeleteCommentEventChangeDTO + deriving (Show, Eq, Generic) + +data SetReplyEventChangeDTO = SetReplyEventChangeDTO + { uuid :: U.UUID + , path :: String + , value :: ReplyValue + } + deriving (Show, Eq, Generic) + +data ClearReplyEventChangeDTO = ClearReplyEventChangeDTO + { uuid :: U.UUID + , path :: String + } + deriving (Show, Eq, Generic) + +data SetPhaseEventChangeDTO = SetPhaseEventChangeDTO + { uuid :: U.UUID + , phaseUuid :: Maybe U.UUID + } + deriving (Show, Eq, Generic) + +data SetLabelsEventChangeDTO = SetLabelsEventChangeDTO + { uuid :: U.UUID + , path :: String + , value :: [U.UUID] + } + deriving (Show, Eq, Generic) + +data ResolveCommentThreadEventChangeDTO = ResolveCommentThreadEventChangeDTO + { uuid :: U.UUID + , threadUuid :: U.UUID + , path :: String + , private :: Bool + , commentCount :: Int + } + deriving (Show, Eq, Generic) + +data ReopenCommentThreadEventChangeDTO = ReopenCommentThreadEventChangeDTO + { uuid :: U.UUID + , threadUuid :: U.UUID + , path :: String + , private :: Bool + , commentCount :: Int + } + deriving (Show, Eq, Generic) + +data AssignCommentThreadEventChangeDTO = AssignCommentThreadEventChangeDTO + { uuid :: U.UUID + , threadUuid :: U.UUID + , path :: String + , private :: Bool + , assignedTo :: Maybe UserSuggestion + } + deriving (Show, Eq, Generic) + +data DeleteCommentThreadEventChangeDTO = DeleteCommentThreadEventChangeDTO + { uuid :: U.UUID + , path :: String + , threadUuid :: U.UUID + , private :: Bool + } + deriving (Show, Eq, Generic) + +data AddCommentEventChangeDTO = AddCommentEventChangeDTO + { uuid :: U.UUID + , path :: String + , threadUuid :: U.UUID + , commentUuid :: U.UUID + , text :: String + , private :: Bool + , newThread :: Bool + } + deriving (Show, Eq, Generic) + +data EditCommentEventChangeDTO = EditCommentEventChangeDTO + { uuid :: U.UUID + , path :: String + , threadUuid :: U.UUID + , commentUuid :: U.UUID + , text :: String + , private :: Bool + } + deriving (Show, Eq, Generic) + +data DeleteCommentEventChangeDTO = DeleteCommentEventChangeDTO + { uuid :: U.UUID + , path :: String + , threadUuid :: U.UUID + , commentUuid :: U.UUID + , private :: Bool + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Event/ProjectEventChangeJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Event/ProjectEventChangeJM.hs new file mode 100644 index 000000000..244b3adba --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Event/ProjectEventChangeJM.hs @@ -0,0 +1,96 @@ +module Wizard.Api.Resource.Project.Event.ProjectEventChangeJM where + +import Control.Monad +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.Project.Event.ProjectEventChangeDTO +import Wizard.Api.Resource.Project.ProjectReplyJM () +import WizardLib.Public.Api.Resource.User.UserSuggestionJM () + +instance ToJSON ProjectEventChangeDTO where + toJSON = toSumJSONWithTypeField "type" "ChangeDTO" + +instance FromJSON ProjectEventChangeDTO where + parseJSON (Object o) = do + eventType <- o .: "type" + case eventType of + "SetReplyEvent" -> parseJSON (Object o) >>= \event -> return (SetReplyEventChangeDTO' event) + "ClearReplyEvent" -> parseJSON (Object o) >>= \event -> return (ClearReplyEventChangeDTO' event) + "SetPhaseEvent" -> parseJSON (Object o) >>= \event -> return (SetPhaseEventChangeDTO' event) + "SetLabelsEvent" -> parseJSON (Object o) >>= \event -> return (SetLabelsEventChangeDTO' event) + "ResolveCommentThreadEvent" -> parseJSON (Object o) >>= \event -> return (ResolveCommentThreadEventChangeDTO' event) + "ReopenCommentThreadEvent" -> parseJSON (Object o) >>= \event -> return (ReopenCommentThreadEventChangeDTO' event) + "AssignCommentThreadEvent" -> parseJSON (Object o) >>= \event -> return (AssignCommentThreadEventChangeDTO' event) + "DeleteCommentThreadEvent" -> parseJSON (Object o) >>= \event -> return (DeleteCommentThreadEventChangeDTO' event) + "AddCommentEvent" -> parseJSON (Object o) >>= \event -> return (AddCommentEventChangeDTO' event) + "EditCommentEvent" -> parseJSON (Object o) >>= \event -> return (EditCommentEventChangeDTO' event) + "DeleteCommentEvent" -> parseJSON (Object o) >>= \event -> return (DeleteCommentEventChangeDTO' event) + _ -> fail "One of the events has unsupported type" + parseJSON _ = mzero + +instance FromJSON SetReplyEventChangeDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON SetReplyEventChangeDTO where + toJSON = genericToJSON jsonOptions + +instance FromJSON ClearReplyEventChangeDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ClearReplyEventChangeDTO where + toJSON = genericToJSON jsonOptions + +instance FromJSON SetPhaseEventChangeDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON SetPhaseEventChangeDTO where + toJSON = genericToJSON jsonOptions + +instance FromJSON SetLabelsEventChangeDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON SetLabelsEventChangeDTO where + toJSON = genericToJSON jsonOptions + +instance FromJSON ResolveCommentThreadEventChangeDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ResolveCommentThreadEventChangeDTO where + toJSON = genericToJSON jsonOptions + +instance FromJSON ReopenCommentThreadEventChangeDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ReopenCommentThreadEventChangeDTO where + toJSON = genericToJSON jsonOptions + +instance FromJSON AssignCommentThreadEventChangeDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON AssignCommentThreadEventChangeDTO where + toJSON = genericToJSON jsonOptions + +instance FromJSON DeleteCommentThreadEventChangeDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON DeleteCommentThreadEventChangeDTO where + toJSON = genericToJSON jsonOptions + +instance FromJSON AddCommentEventChangeDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON AddCommentEventChangeDTO where + toJSON = genericToJSON jsonOptions + +instance FromJSON EditCommentEventChangeDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON EditCommentEventChangeDTO where + toJSON = genericToJSON jsonOptions + +instance FromJSON DeleteCommentEventChangeDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON DeleteCommentEventChangeDTO where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Event/ProjectEventChangeSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Event/ProjectEventChangeSM.hs new file mode 100644 index 000000000..4730b0ae9 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Event/ProjectEventChangeSM.hs @@ -0,0 +1,54 @@ +module Wizard.Api.Resource.Project.Event.ProjectEventChangeSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.Event.ProjectEventChangeDTO +import Wizard.Api.Resource.Project.Event.ProjectEventChangeJM () +import Wizard.Api.Resource.Project.Event.ProjectEventJM () +import Wizard.Api.Resource.Project.ProjectReplySM () +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Model.Project.Project +import Wizard.Service.Project.Event.ProjectEventMapper +import WizardLib.Public.Api.Resource.User.UserSuggestionSM () + +instance ToSchema ProjectEventChangeDTO where + declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions + +instance ToSchema SetReplyEventChangeDTO where + declareNamedSchema = + toSwagger (toSetReplyEventChangeDTO (sre_rQ1 project1.uuid)) + +instance ToSchema ClearReplyEventChangeDTO where + declareNamedSchema = + toSwagger (toClearReplyEventChangeDTO (cre_rQ1 project1.uuid)) + +instance ToSchema SetPhaseEventChangeDTO where + declareNamedSchema = + toSwagger (toSetPhaseEventChangeDTO (sphse_1 project1.uuid)) + +instance ToSchema SetLabelsEventChangeDTO where + declareNamedSchema = + toSwagger (toSetLabelsEventChangeDTO (slble_rQ2 project1.uuid)) + +instance ToSchema ResolveCommentThreadEventChangeDTO where + declareNamedSchema = toSwagger rtche_rQ1_t1 + +instance ToSchema ReopenCommentThreadEventChangeDTO where + declareNamedSchema = toSwagger otche_rQ1_t1 + +instance ToSchema AssignCommentThreadEventChangeDTO where + declareNamedSchema = toSwagger asche_rQ1_t1 + +instance ToSchema DeleteCommentThreadEventChangeDTO where + declareNamedSchema = toSwagger dtche_rQ1_t1 + +instance ToSchema AddCommentEventChangeDTO where + declareNamedSchema = toSwagger acche_rQ2_t1_1 + +instance ToSchema EditCommentEventChangeDTO where + declareNamedSchema = toSwagger ecche_rQ1_t1_1 + +instance ToSchema DeleteCommentEventChangeDTO where + declareNamedSchema = toSwagger dcche_rQ1_t1_1 diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Event/ProjectEventDTO.hs b/wizard-server/src/Wizard/Api/Resource/Project/Event/ProjectEventDTO.hs new file mode 100644 index 000000000..7ebfe0c09 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Event/ProjectEventDTO.hs @@ -0,0 +1,209 @@ +module Wizard.Api.Resource.Project.Event.ProjectEventDTO where + +import Data.Time +import qualified Data.UUID as U +import GHC.Generics + +import Wizard.Model.Project.ProjectReply +import WizardLib.Public.Model.User.UserSuggestion + +data ProjectEventDTO + = SetReplyEventDTO' SetReplyEventDTO + | ClearReplyEventDTO' ClearReplyEventDTO + | SetPhaseEventDTO' SetPhaseEventDTO + | SetLabelsEventDTO' SetLabelsEventDTO + | ResolveCommentThreadEventDTO' ResolveCommentThreadEventDTO + | ReopenCommentThreadEventDTO' ReopenCommentThreadEventDTO + | AssignCommentThreadEventDTO' AssignCommentThreadEventDTO + | DeleteCommentThreadEventDTO' DeleteCommentThreadEventDTO + | AddCommentEventDTO' AddCommentEventDTO + | EditCommentEventDTO' EditCommentEventDTO + | DeleteCommentEventDTO' DeleteCommentEventDTO + deriving (Show, Eq, Generic) + +data SetReplyEventDTO = SetReplyEventDTO + { uuid :: U.UUID + , path :: String + , value :: ReplyValue + , createdBy :: Maybe UserSuggestion + , createdAt :: UTCTime + } + deriving (Show, Generic) + +instance Eq SetReplyEventDTO where + a == b = + a.uuid == b.uuid + && a.path == b.path + && a.value == b.value + && a.createdBy == b.createdBy + +data ClearReplyEventDTO = ClearReplyEventDTO + { uuid :: U.UUID + , path :: String + , createdBy :: Maybe UserSuggestion + , createdAt :: UTCTime + } + deriving (Show, Generic) + +instance Eq ClearReplyEventDTO where + a == b = + a.uuid == b.uuid + && a.path == b.path + && a.createdBy == b.createdBy + +data SetPhaseEventDTO = SetPhaseEventDTO + { uuid :: U.UUID + , phaseUuid :: Maybe U.UUID + , createdBy :: Maybe UserSuggestion + , createdAt :: UTCTime + } + deriving (Show, Generic) + +instance Eq SetPhaseEventDTO where + a == b = + a.uuid == b.uuid + && a.phaseUuid == b.phaseUuid + && a.createdBy == b.createdBy + +data SetLabelsEventDTO = SetLabelsEventDTO + { uuid :: U.UUID + , path :: String + , value :: [U.UUID] + , createdBy :: Maybe UserSuggestion + , createdAt :: UTCTime + } + deriving (Show, Generic) + +instance Eq SetLabelsEventDTO where + a == b = + a.uuid == b.uuid + && a.path == b.path + && a.value == b.value + && a.createdBy == b.createdBy + +data ResolveCommentThreadEventDTO = ResolveCommentThreadEventDTO + { uuid :: U.UUID + , path :: String + , threadUuid :: U.UUID + , commentCount :: Int + , createdBy :: Maybe UserSuggestion + , createdAt :: UTCTime + } + deriving (Show, Generic) + +instance Eq ResolveCommentThreadEventDTO where + a == b = + a.uuid == b.uuid + && a.path == b.path + && a.threadUuid == b.threadUuid + && a.createdBy == b.createdBy + +data ReopenCommentThreadEventDTO = ReopenCommentThreadEventDTO + { uuid :: U.UUID + , path :: String + , threadUuid :: U.UUID + , commentCount :: Int + , createdBy :: Maybe UserSuggestion + , createdAt :: UTCTime + } + deriving (Show, Generic) + +instance Eq ReopenCommentThreadEventDTO where + a == b = + a.uuid == b.uuid + && a.path == b.path + && a.threadUuid == b.threadUuid + && a.createdBy == b.createdBy + +data AssignCommentThreadEventDTO = AssignCommentThreadEventDTO + { uuid :: U.UUID + , path :: String + , threadUuid :: U.UUID + , private :: Bool + , assignedTo :: Maybe UserSuggestion + , createdBy :: Maybe UserSuggestion + , createdAt :: UTCTime + } + deriving (Show, Generic) + +instance Eq AssignCommentThreadEventDTO where + a == b = + a.uuid == b.uuid + && a.path == b.path + && a.threadUuid == b.threadUuid + && a.createdBy == b.createdBy + +data DeleteCommentThreadEventDTO = DeleteCommentThreadEventDTO + { uuid :: U.UUID + , path :: String + , threadUuid :: U.UUID + , createdBy :: Maybe UserSuggestion + , createdAt :: UTCTime + } + deriving (Show, Generic) + +instance Eq DeleteCommentThreadEventDTO where + a == b = + a.uuid == b.uuid + && a.path == b.path + && a.threadUuid == b.threadUuid + && a.createdBy == b.createdBy + +data AddCommentEventDTO = AddCommentEventDTO + { uuid :: U.UUID + , path :: String + , threadUuid :: U.UUID + , commentUuid :: U.UUID + , text :: String + , private :: Bool + , createdBy :: Maybe UserSuggestion + , createdAt :: UTCTime + } + deriving (Show, Generic) + +instance Eq AddCommentEventDTO where + a == b = + a.uuid == b.uuid + && a.path == b.path + && a.threadUuid == b.threadUuid + && a.commentUuid == b.commentUuid + && a.text == b.text + && a.createdBy == b.createdBy + +data EditCommentEventDTO = EditCommentEventDTO + { uuid :: U.UUID + , path :: String + , threadUuid :: U.UUID + , commentUuid :: U.UUID + , text :: String + , createdBy :: Maybe UserSuggestion + , createdAt :: UTCTime + } + deriving (Show, Generic) + +instance Eq EditCommentEventDTO where + a == b = + a.uuid == b.uuid + && a.path == b.path + && a.threadUuid == b.threadUuid + && a.commentUuid == b.commentUuid + && a.text == b.text + && a.createdBy == b.createdBy + +data DeleteCommentEventDTO = DeleteCommentEventDTO + { uuid :: U.UUID + , path :: String + , threadUuid :: U.UUID + , commentUuid :: U.UUID + , createdBy :: Maybe UserSuggestion + , createdAt :: UTCTime + } + deriving (Show, Generic) + +instance Eq DeleteCommentEventDTO where + a == b = + a.uuid == b.uuid + && a.path == b.path + && a.threadUuid == b.threadUuid + && a.commentUuid == b.commentUuid + && a.createdBy == b.createdBy diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Event/ProjectEventJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Event/ProjectEventJM.hs new file mode 100644 index 000000000..a7abc18d2 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Event/ProjectEventJM.hs @@ -0,0 +1,137 @@ +module Wizard.Api.Resource.Project.Event.ProjectEventJM where + +import Control.Monad +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.Project.Event.ProjectEventDTO +import Wizard.Api.Resource.Project.ProjectReplyJM () +import Wizard.Model.Project.Event.ProjectEvent +import WizardLib.Public.Api.Resource.User.UserSuggestionJM () + +instance ToJSON ProjectEventDTO where + toJSON = toSumJSON + +instance FromJSON ProjectEventDTO where + parseJSON (Object o) = do + eventType <- o .: "type" + case eventType of + "SetReplyEvent" -> parseJSON (Object o) >>= \event -> return (SetReplyEventDTO' event) + "ClearReplyEvent" -> parseJSON (Object o) >>= \event -> return (ClearReplyEventDTO' event) + "SetPhaseEvent" -> parseJSON (Object o) >>= \event -> return (SetPhaseEventDTO' event) + "SetLabelsEvent" -> parseJSON (Object o) >>= \event -> return (SetLabelsEventDTO' event) + "ResolveCommentThreadEvent" -> parseJSON (Object o) >>= \event -> return (ResolveCommentThreadEventDTO' event) + "ReopenCommentThreadEvent" -> parseJSON (Object o) >>= \event -> return (ReopenCommentThreadEventDTO' event) + "AssignCommentThreadEvent" -> parseJSON (Object o) >>= \event -> return (AssignCommentThreadEventDTO' event) + "DeleteCommentThreadEvent" -> parseJSON (Object o) >>= \event -> return (DeleteCommentThreadEventDTO' event) + "AddCommentEvent" -> parseJSON (Object o) >>= \event -> return (AddCommentEventDTO' event) + "EditCommentEvent" -> parseJSON (Object o) >>= \event -> return (EditCommentEventDTO' event) + "DeleteCommentEvent" -> parseJSON (Object o) >>= \event -> return (DeleteCommentEventDTO' event) + _ -> fail "One of the events has unsupported type" + parseJSON _ = mzero + +instance FromJSON SetReplyEventDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON SetReplyEventDTO where + toJSON = genericToJSON (jsonOptionsWithTypeField "type") + +instance FromJSON ClearReplyEventDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ClearReplyEventDTO where + toJSON = genericToJSON (jsonOptionsWithTypeField "type") + +instance FromJSON SetPhaseEventDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON SetPhaseEventDTO where + toJSON = genericToJSON (jsonOptionsWithTypeField "type") + +instance FromJSON SetLabelsEventDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON SetLabelsEventDTO where + toJSON = genericToJSON (jsonOptionsWithTypeField "type") + +instance FromJSON ResolveCommentThreadEventDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ResolveCommentThreadEventDTO where + toJSON = genericToJSON (jsonOptionsWithTypeField "type") + +instance FromJSON ReopenCommentThreadEventDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ReopenCommentThreadEventDTO where + toJSON = genericToJSON (jsonOptionsWithTypeField "type") + +instance FromJSON AssignCommentThreadEventDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON AssignCommentThreadEventDTO where + toJSON = genericToJSON (jsonOptionsWithTypeField "type") + +instance FromJSON DeleteCommentThreadEventDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON DeleteCommentThreadEventDTO where + toJSON = genericToJSON (jsonOptionsWithTypeField "type") + +instance FromJSON AddCommentEventDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON AddCommentEventDTO where + toJSON = genericToJSON (jsonOptionsWithTypeField "type") + +instance FromJSON EditCommentEventDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON EditCommentEventDTO where + toJSON = genericToJSON (jsonOptionsWithTypeField "type") + +instance FromJSON DeleteCommentEventDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON DeleteCommentEventDTO where + toJSON = genericToJSON (jsonOptionsWithTypeField "type") + +-- -------------------------------------------- +-- -------------------------------------------- +instance ToJSON ProjectEvent where + toJSON = toSumJSONWithTypeField "type" "" + +instance FromJSON ProjectEvent where + parseJSON (Object o) = do + eventType <- o .: "type" + case eventType of + "SetReplyEvent" -> parseJSON (Object o) >>= \event -> return (SetReplyEvent' event) + "ClearReplyEvent" -> parseJSON (Object o) >>= \event -> return (ClearReplyEvent' event) + "SetPhaseEvent" -> parseJSON (Object o) >>= \event -> return (SetPhaseEvent' event) + "SetLabelsEvent" -> parseJSON (Object o) >>= \event -> return (SetLabelsEvent' event) + _ -> fail "One of the events has unsupported type" + parseJSON _ = mzero + +instance FromJSON SetReplyEvent where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON SetReplyEvent where + toJSON = genericToJSON (jsonOptionsWithTypeField "type") + +instance FromJSON ClearReplyEvent where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ClearReplyEvent where + toJSON = genericToJSON (jsonOptionsWithTypeField "type") + +instance FromJSON SetPhaseEvent where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON SetPhaseEvent where + toJSON = genericToJSON (jsonOptionsWithTypeField "type") + +instance FromJSON SetLabelsEvent where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON SetLabelsEvent where + toJSON = genericToJSON (jsonOptionsWithTypeField "type") diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Event/ProjectEventListJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Event/ProjectEventListJM.hs new file mode 100644 index 000000000..c3798f921 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Event/ProjectEventListJM.hs @@ -0,0 +1,47 @@ +module Wizard.Api.Resource.Project.Event.ProjectEventListJM where + +import Control.Monad +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.Project.ProjectReplyJM () +import Wizard.Model.Project.Event.ProjectEventList +import WizardLib.Public.Api.Resource.User.UserSuggestionJM () + +instance ToJSON ProjectEventList where + toJSON = toSumJSONWithTypeField "type" "List" + +instance FromJSON ProjectEventList where + parseJSON (Object o) = do + eventType <- o .: "type" + case eventType of + "SetReplyEvent" -> parseJSON (Object o) >>= \event -> return (SetReplyEventList' event) + "ClearReplyEvent" -> parseJSON (Object o) >>= \event -> return (ClearReplyEventList' event) + "SetPhaseEvent" -> parseJSON (Object o) >>= \event -> return (SetPhaseEventList' event) + "SetLabelsEvent" -> parseJSON (Object o) >>= \event -> return (SetLabelsEventList' event) + _ -> fail "One of the events has unsupported type" + parseJSON _ = mzero + +instance FromJSON SetReplyEventList where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON SetReplyEventList where + toJSON = genericToJSON jsonOptions + +instance FromJSON ClearReplyEventList where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ClearReplyEventList where + toJSON = genericToJSON jsonOptions + +instance FromJSON SetPhaseEventList where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON SetPhaseEventList where + toJSON = genericToJSON jsonOptions + +instance FromJSON SetLabelsEventList where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON SetLabelsEventList where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Event/ProjectEventListSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Event/ProjectEventListSM.hs new file mode 100644 index 000000000..431796454 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Event/ProjectEventListSM.hs @@ -0,0 +1,29 @@ +module Wizard.Api.Resource.Project.Event.ProjectEventListSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.Event.ProjectEventListJM () +import Wizard.Api.Resource.Project.ProjectReplySM () +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Database.Migration.Development.User.Data.Users +import Wizard.Model.Project.Event.ProjectEventList +import Wizard.Model.Project.Project +import Wizard.Service.Project.Event.ProjectEventMapper +import WizardLib.Public.Api.Resource.User.UserSuggestionSM () + +instance ToSchema ProjectEventList where + declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions + +instance ToSchema SetReplyEventList where + declareNamedSchema = toSwagger (toSetReplyEventList (sre_rQ1 project1.uuid) (Just userAlbert)) + +instance ToSchema ClearReplyEventList where + declareNamedSchema = toSwagger (toClearReplyEventList (cre_rQ1 project1.uuid) (Just userAlbert)) + +instance ToSchema SetPhaseEventList where + declareNamedSchema = toSwagger (toSetPhaseEventList (sphse_1 project1.uuid) (Just userAlbert)) + +instance ToSchema SetLabelsEventList where + declareNamedSchema = toSwagger (toSetLabelsEventList (slble_rQ2 project1.uuid) (Just userAlbert)) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Event/ProjectEventSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Event/ProjectEventSM.hs new file mode 100644 index 000000000..1f07d956f --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Event/ProjectEventSM.hs @@ -0,0 +1,50 @@ +module Wizard.Api.Resource.Project.Event.ProjectEventSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.Event.ProjectEventDTO +import Wizard.Api.Resource.Project.Event.ProjectEventJM () +import Wizard.Api.Resource.Project.ProjectReplySM () +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Database.Migration.Development.User.Data.Users +import Wizard.Model.Project.Project +import Wizard.Service.Project.Event.ProjectEventMapper +import WizardLib.Public.Api.Resource.User.UserSuggestionSM () + +instance ToSchema ProjectEventDTO where + declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions + +instance ToSchema SetReplyEventDTO where + declareNamedSchema = toSwagger (toSetReplyEventDTO (sre_rQ1 project1.uuid) (Just userAlbert)) + +instance ToSchema ClearReplyEventDTO where + declareNamedSchema = toSwagger (toClearReplyEventDTO (cre_rQ1 project1.uuid) (Just userAlbert)) + +instance ToSchema SetPhaseEventDTO where + declareNamedSchema = toSwagger (toSetPhaseEventDTO (sphse_1 project1.uuid) (Just userAlbert)) + +instance ToSchema SetLabelsEventDTO where + declareNamedSchema = toSwagger (toSetLabelsEventDTO (slble_rQ2 project1.uuid) (Just userAlbert)) + +instance ToSchema ResolveCommentThreadEventDTO where + declareNamedSchema = toSwagger rte_rQ1_t1 + +instance ToSchema ReopenCommentThreadEventDTO where + declareNamedSchema = toSwagger ote_rQ1_t1 + +instance ToSchema AssignCommentThreadEventDTO where + declareNamedSchema = toSwagger aste_rQ1_t1 + +instance ToSchema DeleteCommentThreadEventDTO where + declareNamedSchema = toSwagger dte_rQ1_t1 + +instance ToSchema AddCommentEventDTO where + declareNamedSchema = toSwagger ace_rQ1_t1_1 + +instance ToSchema EditCommentEventDTO where + declareNamedSchema = toSwagger ece_rQ1_t1_1 + +instance ToSchema DeleteCommentEventDTO where + declareNamedSchema = toSwagger dce_rQ1_t1_1 diff --git a/wizard-server/src/Wizard/Api/Resource/Project/File/ProjectFileListJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/File/ProjectFileListJM.hs new file mode 100644 index 000000000..992c92574 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/File/ProjectFileListJM.hs @@ -0,0 +1,14 @@ +module Wizard.Api.Resource.Project.File.ProjectFileListJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.Project.ProjectSimpleJM () +import Wizard.Model.Project.File.ProjectFileList +import WizardLib.Public.Api.Resource.User.UserSuggestionJM () + +instance FromJSON ProjectFileList where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectFileList where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/File/ProjectFileListSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/File/ProjectFileListSM.hs new file mode 100644 index 000000000..d7ec8b539 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/File/ProjectFileListSM.hs @@ -0,0 +1,13 @@ +module Wizard.Api.Resource.Project.File.ProjectFileListSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.File.ProjectFileListJM () +import Wizard.Api.Resource.Project.ProjectSimpleSM () +import Wizard.Database.Migration.Development.Project.Data.ProjectFiles +import Wizard.Model.Project.File.ProjectFileList +import WizardLib.Public.Api.Resource.User.UserSuggestionSM () + +instance ToSchema ProjectFileList where + declareNamedSchema = toSwagger projectFileList diff --git a/wizard-server/src/Wizard/Api/Resource/Project/File/ProjectFileSimpleJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/File/ProjectFileSimpleJM.hs new file mode 100644 index 000000000..22fc98024 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/File/ProjectFileSimpleJM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.Project.File.ProjectFileSimpleJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Model.Project.File.ProjectFileSimple + +instance FromJSON ProjectFileSimple where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectFileSimple where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/File/ProjectFileSimpleSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/File/ProjectFileSimpleSM.hs new file mode 100644 index 000000000..04e39be53 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/File/ProjectFileSimpleSM.hs @@ -0,0 +1,11 @@ +module Wizard.Api.Resource.Project.File.ProjectFileSimpleSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.File.ProjectFileSimpleJM () +import Wizard.Database.Migration.Development.Project.Data.ProjectFiles +import Wizard.Model.Project.File.ProjectFileSimple + +instance ToSchema ProjectFileSimple where + declareNamedSchema = toSwagger projectFileSimple diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Importer/ProjectImporterChangeDTO.hs b/wizard-server/src/Wizard/Api/Resource/Project/Importer/ProjectImporterChangeDTO.hs new file mode 100644 index 000000000..f1d26c6df --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Importer/ProjectImporterChangeDTO.hs @@ -0,0 +1,8 @@ +module Wizard.Api.Resource.Project.Importer.ProjectImporterChangeDTO where + +import GHC.Generics + +data ProjectImporterChangeDTO = ProjectImporterChangeDTO + { enabled :: Bool + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Importer/ProjectImporterChangeJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Importer/ProjectImporterChangeJM.hs new file mode 100644 index 000000000..8b84721dc --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Importer/ProjectImporterChangeJM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.Project.Importer.ProjectImporterChangeJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.Project.Importer.ProjectImporterChangeDTO + +instance FromJSON ProjectImporterChangeDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectImporterChangeDTO where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Importer/ProjectImporterChangeSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Importer/ProjectImporterChangeSM.hs new file mode 100644 index 000000000..2380eb711 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Importer/ProjectImporterChangeSM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.Project.Importer.ProjectImporterChangeSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.Importer.ProjectImporterChangeDTO +import Wizard.Api.Resource.Project.Importer.ProjectImporterChangeJM () +import Wizard.Database.Migration.Development.Project.Data.ProjectImporters +import Wizard.Service.Project.Importer.ProjectImporterMapper + +instance ToSchema ProjectImporterChangeDTO where + declareNamedSchema = toSwagger (toChangeDTO projectImporterBio1) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Importer/ProjectImporterDTO.hs b/wizard-server/src/Wizard/Api/Resource/Project/Importer/ProjectImporterDTO.hs new file mode 100644 index 000000000..b78ba843f --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Importer/ProjectImporterDTO.hs @@ -0,0 +1,15 @@ +module Wizard.Api.Resource.Project.Importer.ProjectImporterDTO where + +import Data.Time +import GHC.Generics + +data ProjectImporterDTO = ProjectImporterDTO + { piId :: String + , name :: String + , description :: String + , url :: String + , enabled :: Bool + , createdAt :: UTCTime + , updatedAt :: UTCTime + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Importer/ProjectImporterJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Importer/ProjectImporterJM.hs new file mode 100644 index 000000000..5ce289d8d --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Importer/ProjectImporterJM.hs @@ -0,0 +1,14 @@ +module Wizard.Api.Resource.Project.Importer.ProjectImporterJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSimpleJM () +import Wizard.Api.Resource.Project.Importer.ProjectImporterDTO +import Wizard.Api.Resource.User.UserJM () + +instance FromJSON ProjectImporterDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectImporterDTO where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Importer/ProjectImporterSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Importer/ProjectImporterSM.hs new file mode 100644 index 000000000..82eaef2c7 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Importer/ProjectImporterSM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.Project.Importer.ProjectImporterSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.Importer.ProjectImporterDTO +import Wizard.Api.Resource.Project.Importer.ProjectImporterJM () +import Wizard.Database.Migration.Development.Project.Data.ProjectImporters +import Wizard.Service.Project.Importer.ProjectImporterMapper + +instance ToSchema ProjectImporterDTO where + declareNamedSchema = toSwagger (toDTO projectImporterBio1) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationChangeDTO.hs b/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationChangeDTO.hs new file mode 100644 index 000000000..a3c1a4ba0 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationChangeDTO.hs @@ -0,0 +1,9 @@ +module Wizard.Api.Resource.Project.Migration.ProjectMigrationChangeDTO where + +import qualified Data.UUID as U +import GHC.Generics + +data ProjectMigrationChangeDTO = ProjectMigrationChangeDTO + { resolvedQuestionUuids :: [U.UUID] + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationChangeJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationChangeJM.hs new file mode 100644 index 000000000..425568528 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationChangeJM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.Project.Migration.ProjectMigrationChangeJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.Project.Migration.ProjectMigrationChangeDTO + +instance FromJSON ProjectMigrationChangeDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectMigrationChangeDTO where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationChangeSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationChangeSM.hs new file mode 100644 index 000000000..0aba1f1bb --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationChangeSM.hs @@ -0,0 +1,11 @@ +module Wizard.Api.Resource.Project.Migration.ProjectMigrationChangeSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.Migration.ProjectMigrationChangeDTO +import Wizard.Api.Resource.Project.Migration.ProjectMigrationChangeJM () +import Wizard.Database.Migration.Development.Project.Data.ProjectMigrations + +instance ToSchema ProjectMigrationChangeDTO where + declareNamedSchema = toSwagger projectMigrationChangeDto diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationCreateDTO.hs b/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationCreateDTO.hs new file mode 100644 index 000000000..1045e0025 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationCreateDTO.hs @@ -0,0 +1,10 @@ +module Wizard.Api.Resource.Project.Migration.ProjectMigrationCreateDTO where + +import qualified Data.UUID as U +import GHC.Generics + +data ProjectMigrationCreateDTO = ProjectMigrationCreateDTO + { targetKnowledgeModelPackageId :: String + , targetTagUuids :: [U.UUID] + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationCreateJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationCreateJM.hs new file mode 100644 index 000000000..ac9b6acc4 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationCreateJM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.Project.Migration.ProjectMigrationCreateJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.Project.Migration.ProjectMigrationCreateDTO + +instance FromJSON ProjectMigrationCreateDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectMigrationCreateDTO where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationCreateSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationCreateSM.hs new file mode 100644 index 000000000..7d27c3611 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationCreateSM.hs @@ -0,0 +1,11 @@ +module Wizard.Api.Resource.Project.Migration.ProjectMigrationCreateSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.Migration.ProjectMigrationCreateDTO +import Wizard.Api.Resource.Project.Migration.ProjectMigrationCreateJM () +import Wizard.Database.Migration.Development.Project.Data.ProjectMigrations + +instance ToSchema ProjectMigrationCreateDTO where + declareNamedSchema = toSwagger projectMigrationCreateDto diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationDTO.hs b/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationDTO.hs new file mode 100644 index 000000000..299d3c572 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationDTO.hs @@ -0,0 +1,14 @@ +module Wizard.Api.Resource.Project.Migration.ProjectMigrationDTO where + +import qualified Data.UUID as U +import GHC.Generics + +import Wizard.Api.Resource.Project.Detail.ProjectDetailQuestionnaireDTO + +data ProjectMigrationDTO = ProjectMigrationDTO + { oldProject :: ProjectDetailQuestionnaireDTO + , newProject :: ProjectDetailQuestionnaireDTO + , resolvedQuestionUuids :: [U.UUID] + , tenantUuid :: U.UUID + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationJM.hs new file mode 100644 index 000000000..226c643e6 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationJM.hs @@ -0,0 +1,13 @@ +module Wizard.Api.Resource.Project.Migration.ProjectMigrationJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.Project.Detail.ProjectDetailQuestionnaireJM () +import Wizard.Api.Resource.Project.Migration.ProjectMigrationDTO + +instance FromJSON ProjectMigrationDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectMigrationDTO where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationSM.hs new file mode 100644 index 000000000..30740a771 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Migration/ProjectMigrationSM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.Project.Migration.ProjectMigrationSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.Detail.ProjectDetailQuestionnaireSM () +import Wizard.Api.Resource.Project.Migration.ProjectMigrationDTO +import Wizard.Api.Resource.Project.Migration.ProjectMigrationJM () +import Wizard.Database.Migration.Development.Project.Data.ProjectMigrations + +instance ToSchema ProjectMigrationDTO where + declareNamedSchema = toSwagger projectMigrationDto diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectContentChangeDTO.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectContentChangeDTO.hs new file mode 100644 index 000000000..e2af715a2 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectContentChangeDTO.hs @@ -0,0 +1,10 @@ +module Wizard.Api.Resource.Project.ProjectContentChangeDTO where + +import GHC.Generics + +import Wizard.Api.Resource.Project.Event.ProjectEventChangeDTO + +data ProjectContentChangeDTO = ProjectContentChangeDTO + { events :: [ProjectEventChangeDTO] + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectContentChangeJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectContentChangeJM.hs new file mode 100644 index 000000000..d966dd263 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectContentChangeJM.hs @@ -0,0 +1,13 @@ +module Wizard.Api.Resource.Project.ProjectContentChangeJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.Project.Event.ProjectEventChangeJM () +import Wizard.Api.Resource.Project.ProjectContentChangeDTO + +instance FromJSON ProjectContentChangeDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectContentChangeDTO where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectContentChangeSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectContentChangeSM.hs new file mode 100644 index 000000000..555fb4ea2 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectContentChangeSM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.Project.ProjectContentChangeSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.Event.ProjectEventChangeSM () +import Wizard.Api.Resource.Project.ProjectContentChangeDTO +import Wizard.Api.Resource.Project.ProjectContentChangeJM () +import Wizard.Database.Migration.Development.Project.Data.Projects + +instance ToSchema ProjectContentChangeDTO where + declareNamedSchema = toSwagger contentChangeDTO diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectContentDTO.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectContentDTO.hs new file mode 100644 index 000000000..7b7a8ec4a --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectContentDTO.hs @@ -0,0 +1,20 @@ +module Wizard.Api.Resource.Project.ProjectContentDTO where + +import qualified Data.Map.Strict as M +import qualified Data.UUID as U +import GHC.Generics + +import Wizard.Model.Project.Comment.ProjectCommentList +import Wizard.Model.Project.Event.ProjectEventList +import Wizard.Model.Project.ProjectReply +import Wizard.Model.Project.Version.ProjectVersionList + +data ProjectContentDTO = ProjectContentDTO + { phaseUuid :: Maybe U.UUID + , replies :: M.Map String Reply + , commentThreadsMap :: M.Map String [ProjectCommentThreadList] + , labels :: M.Map String [U.UUID] + , events :: [ProjectEventList] + , versions :: [ProjectVersionList] + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectContentJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectContentJM.hs new file mode 100644 index 000000000..18f3d270e --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectContentJM.hs @@ -0,0 +1,16 @@ +module Wizard.Api.Resource.Project.ProjectContentJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.Project.Comment.ProjectCommentThreadListJM () +import Wizard.Api.Resource.Project.Event.ProjectEventListJM () +import Wizard.Api.Resource.Project.ProjectContentDTO +import Wizard.Api.Resource.Project.ProjectReplyJM () +import Wizard.Api.Resource.Project.Version.ProjectVersionListJM () + +instance FromJSON ProjectContentDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectContentDTO where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectContentSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectContentSM.hs new file mode 100644 index 000000000..3e920e513 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectContentSM.hs @@ -0,0 +1,17 @@ +module Wizard.Api.Resource.Project.ProjectContentSM where + +import qualified Data.Map.Strict as M +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.Comment.ProjectCommentThreadListSM () +import Wizard.Api.Resource.Project.Event.ProjectEventListSM () +import Wizard.Api.Resource.Project.ProjectContentDTO +import Wizard.Api.Resource.Project.ProjectContentJM () +import Wizard.Api.Resource.Project.ProjectReplySM () +import Wizard.Api.Resource.Project.Version.ProjectVersionListSM () +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Service.Project.ProjectMapper + +instance ToSchema ProjectContentDTO where + declareNamedSchema = toSwagger (toContentDTO project1Ctn M.empty [] []) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectCreateDTO.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectCreateDTO.hs new file mode 100644 index 000000000..8c7e146da --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectCreateDTO.hs @@ -0,0 +1,17 @@ +module Wizard.Api.Resource.Project.ProjectCreateDTO where + +import qualified Data.UUID as U +import GHC.Generics + +import Wizard.Model.Project.Project + +data ProjectCreateDTO = ProjectCreateDTO + { name :: String + , knowledgeModelPackageId :: String + , visibility :: ProjectVisibility + , sharing :: ProjectSharing + , questionTagUuids :: [U.UUID] + , documentTemplateId :: Maybe String + , formatUuid :: Maybe U.UUID + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectCreateFromTemplateDTO.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectCreateFromTemplateDTO.hs new file mode 100644 index 000000000..dd1bacc12 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectCreateFromTemplateDTO.hs @@ -0,0 +1,10 @@ +module Wizard.Api.Resource.Project.ProjectCreateFromTemplateDTO where + +import qualified Data.UUID as U +import GHC.Generics + +data ProjectCreateFromTemplateDTO = ProjectCreateFromTemplateDTO + { name :: String + , projectUuid :: U.UUID + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectCreateFromTemplateJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectCreateFromTemplateJM.hs new file mode 100644 index 000000000..32b68e689 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectCreateFromTemplateJM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.Project.ProjectCreateFromTemplateJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.Project.ProjectCreateFromTemplateDTO + +instance FromJSON ProjectCreateFromTemplateDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectCreateFromTemplateDTO where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectCreateFromTemplateSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectCreateFromTemplateSM.hs new file mode 100644 index 000000000..8f4d24e03 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectCreateFromTemplateSM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.Project.ProjectCreateFromTemplateSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.ProjectCreateFromTemplateDTO +import Wizard.Api.Resource.Project.ProjectCreateFromTemplateJM () +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Service.Project.ProjectMapper + +instance ToSchema ProjectCreateFromTemplateDTO where + declareNamedSchema = toSwagger (toCreateFromTemplateDTO project1) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectCreateJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectCreateJM.hs new file mode 100644 index 000000000..45f28d884 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectCreateJM.hs @@ -0,0 +1,14 @@ +module Wizard.Api.Resource.Project.ProjectCreateJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.Project.ProjectCreateDTO +import Wizard.Api.Resource.Project.ProjectSharingJM () +import Wizard.Api.Resource.Project.ProjectVisibilityJM () + +instance FromJSON ProjectCreateDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectCreateDTO where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectCreateSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectCreateSM.hs new file mode 100644 index 000000000..43b235928 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectCreateSM.hs @@ -0,0 +1,13 @@ +module Wizard.Api.Resource.Project.ProjectCreateSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.ProjectCreateDTO +import Wizard.Api.Resource.Project.ProjectCreateJM () +import Wizard.Api.Resource.Project.ProjectSharingSM () +import Wizard.Api.Resource.Project.ProjectVisibilitySM () +import Wizard.Database.Migration.Development.Project.Data.Projects + +instance ToSchema ProjectCreateDTO where + declareNamedSchema = toSwagger project1Create diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectDTO.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectDTO.hs new file mode 100644 index 000000000..89c48a30c --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectDTO.hs @@ -0,0 +1,37 @@ +module Wizard.Api.Resource.Project.ProjectDTO where + +import Data.Time +import qualified Data.UUID as U +import GHC.Generics + +import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackageSimple +import Wizard.Api.Resource.Project.Acl.ProjectPermDTO +import Wizard.Model.Project.Project +import Wizard.Model.Project.ProjectState + +data ProjectDTO = ProjectDTO + { uuid :: U.UUID + , name :: String + , description :: Maybe String + , visibility :: ProjectVisibility + , sharing :: ProjectSharing + , state :: ProjectState + , knowledgeModelPackage :: KnowledgeModelPackageSimple + , permissions :: [ProjectPermDTO] + , isTemplate :: Bool + , createdAt :: UTCTime + , updatedAt :: UTCTime + } + deriving (Show, Generic) + +instance Eq ProjectDTO where + a == b = + a.uuid == b.uuid + && a.name == b.name + && a.description == b.description + && a.visibility == b.visibility + && a.sharing == b.sharing + && a.state == b.state + && a.knowledgeModelPackage == b.knowledgeModelPackage + && a.permissions == b.permissions + && a.isTemplate == b.isTemplate diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectJM.hs new file mode 100644 index 000000000..adcf55d0c --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectJM.hs @@ -0,0 +1,19 @@ +module Wizard.Api.Resource.Project.ProjectJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSimpleJM () +import Wizard.Api.Resource.Project.Acl.ProjectPermJM () +import Wizard.Api.Resource.Project.ProjectDTO +import Wizard.Api.Resource.Project.ProjectReportJM () +import Wizard.Api.Resource.Project.ProjectSharingJM () +import Wizard.Api.Resource.Project.ProjectStateJM () +import Wizard.Api.Resource.Project.ProjectVisibilityJM () +import Wizard.Api.Resource.User.UserJM () + +instance FromJSON ProjectDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectDTO where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectReplyJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectReplyJM.hs new file mode 100644 index 000000000..a44010886 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectReplyJM.hs @@ -0,0 +1,26 @@ +module Wizard.Api.Resource.Project.ProjectReplyJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Model.Project.ProjectReply +import WizardLib.Public.Api.Resource.User.UserSuggestionJM () + +instance ToJSON Reply where + toJSON = genericToJSON jsonOptions + +instance FromJSON Reply where + parseJSON = genericParseJSON jsonOptions + +instance FromJSON ReplyValue where + parseJSON = genericParseJSON (jsonOptionsWithTypeField "type") + +instance ToJSON ReplyValue where + toJSON = genericToJSON (jsonOptionsWithTypeField "type") + +-- -------------------------------------------------------------------- +instance FromJSON IntegrationReplyType where + parseJSON = genericParseJSON (jsonOptionsWithTypeField "type") + +instance ToJSON IntegrationReplyType where + toJSON = genericToJSON (jsonOptionsWithTypeField "type") diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectReplySM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectReplySM.hs new file mode 100644 index 000000000..870fa4974 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectReplySM.hs @@ -0,0 +1,19 @@ +module Wizard.Api.Resource.Project.ProjectReplySM where + +import Data.Swagger + +import Shared.Common.Api.Resource.Common.AesonSM () +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.ProjectReplyJM () +import Wizard.Database.Migration.Development.Project.Data.ProjectReplies +import Wizard.Model.Project.ProjectReply +import WizardLib.Public.Api.Resource.User.UserSuggestionSM () + +instance ToSchema Reply where + declareNamedSchema = toSwagger (fst rQ1Updated) + +instance ToSchema ReplyValue where + declareNamedSchema = toSwagger ((snd rQ1).value) + +instance ToSchema IntegrationReplyType where + declareNamedSchema = toSwagger rQ10IntValue diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectReportDTO.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectReportDTO.hs new file mode 100644 index 000000000..cdbdff2e8 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectReportDTO.hs @@ -0,0 +1,10 @@ +module Wizard.Api.Resource.Project.ProjectReportDTO where + +import GHC.Generics + +import Wizard.Model.Report.Report + +data ProjectReportDTO = ProjectReportDTO + { indications :: [Indication] + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectReportJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectReportJM.hs new file mode 100644 index 000000000..ec631b917 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectReportJM.hs @@ -0,0 +1,13 @@ +module Wizard.Api.Resource.Project.ProjectReportJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.Project.ProjectReportDTO +import Wizard.Api.Resource.Report.ReportJM () + +instance FromJSON ProjectReportDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectReportDTO where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectReportSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectReportSM.hs new file mode 100644 index 000000000..281fd2f11 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectReportSM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.Project.ProjectReportSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.ProjectReportDTO +import Wizard.Api.Resource.Project.ProjectReportJM () +import Wizard.Api.Resource.Report.ReportSM () +import Wizard.Database.Migration.Development.Report.Data.Reports + +instance ToSchema ProjectReportDTO where + declareNamedSchema = toSwagger projectReport diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectSM.hs new file mode 100644 index 000000000..9c6086cfd --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectSM.hs @@ -0,0 +1,22 @@ +module Wizard.Api.Resource.Project.ProjectSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSimpleSM () +import Wizard.Api.Resource.Project.Acl.ProjectPermSM () +import Wizard.Api.Resource.Project.ProjectDTO +import Wizard.Api.Resource.Project.ProjectJM () +import Wizard.Api.Resource.Project.ProjectReportSM () +import Wizard.Api.Resource.Project.ProjectSharingSM () +import Wizard.Api.Resource.Project.ProjectStateSM () +import Wizard.Api.Resource.Project.ProjectVisibilitySM () +import Wizard.Api.Resource.User.UserSM () +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Model.Project.ProjectState +import Wizard.Service.Project.ProjectMapper + +instance ToSchema ProjectDTO where + declareNamedSchema = + toSwagger (toDTO project1 germanyKmPackage DefaultProjectState [project1AlbertEditProjectPermDto]) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectSettingsChangeDTO.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectSettingsChangeDTO.hs new file mode 100644 index 000000000..9a9f5b659 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectSettingsChangeDTO.hs @@ -0,0 +1,14 @@ +module Wizard.Api.Resource.Project.ProjectSettingsChangeDTO where + +import qualified Data.UUID as U +import GHC.Generics + +data ProjectSettingsChangeDTO = ProjectSettingsChangeDTO + { name :: String + , description :: Maybe String + , projectTags :: [String] + , documentTemplateId :: Maybe String + , formatUuid :: Maybe U.UUID + , isTemplate :: Bool + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectSettingsChangeJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectSettingsChangeJM.hs new file mode 100644 index 000000000..a12dbcc41 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectSettingsChangeJM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.Project.ProjectSettingsChangeJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.Project.ProjectSettingsChangeDTO + +instance FromJSON ProjectSettingsChangeDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectSettingsChangeDTO where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectSettingsChangeSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectSettingsChangeSM.hs new file mode 100644 index 000000000..a142adb4a --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectSettingsChangeSM.hs @@ -0,0 +1,11 @@ +module Wizard.Api.Resource.Project.ProjectSettingsChangeSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.ProjectSettingsChangeDTO +import Wizard.Api.Resource.Project.ProjectSettingsChangeJM () +import Wizard.Database.Migration.Development.Project.Data.Projects + +instance ToSchema ProjectSettingsChangeDTO where + declareNamedSchema = toSwagger project1SettingsChange diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectShareChangeDTO.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectShareChangeDTO.hs new file mode 100644 index 000000000..1b0dd5faa --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectShareChangeDTO.hs @@ -0,0 +1,13 @@ +module Wizard.Api.Resource.Project.ProjectShareChangeDTO where + +import GHC.Generics + +import Wizard.Api.Resource.Project.Acl.ProjectPermChangeDTO +import Wizard.Model.Project.Project + +data ProjectShareChangeDTO = ProjectShareChangeDTO + { visibility :: ProjectVisibility + , sharing :: ProjectSharing + , permissions :: [ProjectPermChangeDTO] + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectShareChangeJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectShareChangeJM.hs new file mode 100644 index 000000000..6fb4d5fea --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectShareChangeJM.hs @@ -0,0 +1,15 @@ +module Wizard.Api.Resource.Project.ProjectShareChangeJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.Project.Acl.ProjectPermChangeJM () +import Wizard.Api.Resource.Project.ProjectShareChangeDTO +import Wizard.Api.Resource.Project.ProjectSharingJM () +import Wizard.Api.Resource.Project.ProjectVisibilityJM () + +instance FromJSON ProjectShareChangeDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectShareChangeDTO where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectShareChangeSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectShareChangeSM.hs new file mode 100644 index 000000000..69e26de8d --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectShareChangeSM.hs @@ -0,0 +1,14 @@ +module Wizard.Api.Resource.Project.ProjectShareChangeSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.Acl.ProjectPermChangeSM () +import Wizard.Api.Resource.Project.ProjectShareChangeDTO +import Wizard.Api.Resource.Project.ProjectShareChangeJM () +import Wizard.Api.Resource.Project.ProjectSharingSM () +import Wizard.Api.Resource.Project.ProjectVisibilitySM () +import Wizard.Database.Migration.Development.Project.Data.Projects + +instance ToSchema ProjectShareChangeDTO where + declareNamedSchema = toSwagger project1EditedShareChange diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectSharingJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectSharingJM.hs new file mode 100644 index 000000000..a76d0c106 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectSharingJM.hs @@ -0,0 +1,9 @@ +module Wizard.Api.Resource.Project.ProjectSharingJM where + +import Data.Aeson + +import Wizard.Model.Project.Project + +instance FromJSON ProjectSharing + +instance ToJSON ProjectSharing diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectSharingSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectSharingSM.hs new file mode 100644 index 000000000..d68adece8 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectSharingSM.hs @@ -0,0 +1,7 @@ +module Wizard.Api.Resource.Project.ProjectSharingSM where + +import Data.Swagger + +import Wizard.Model.Project.Project + +instance ToSchema ProjectSharing diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectSimpleJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectSimpleJM.hs new file mode 100644 index 000000000..86de51d54 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectSimpleJM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.Project.ProjectSimpleJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Model.Project.ProjectSimple + +instance FromJSON ProjectSimple where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectSimple where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectSimpleSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectSimpleSM.hs new file mode 100644 index 000000000..7ba58072c --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectSimpleSM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.Project.ProjectSimpleSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.ProjectSimpleJM () +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Model.Project.ProjectSimple +import Wizard.Service.Project.ProjectMapper + +instance ToSchema ProjectSimple where + declareNamedSchema = toSwagger (toSimple project1) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectStateJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectStateJM.hs new file mode 100644 index 000000000..f962cff34 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectStateJM.hs @@ -0,0 +1,9 @@ +module Wizard.Api.Resource.Project.ProjectStateJM where + +import Data.Aeson + +import Wizard.Model.Project.ProjectState + +instance FromJSON ProjectState + +instance ToJSON ProjectState diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectStateSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectStateSM.hs new file mode 100644 index 000000000..640d7158f --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectStateSM.hs @@ -0,0 +1,7 @@ +module Wizard.Api.Resource.Project.ProjectStateSM where + +import Data.Swagger + +import Wizard.Model.Project.ProjectState + +instance ToSchema ProjectState diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectSuggestionJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectSuggestionJM.hs new file mode 100644 index 000000000..72c70d49f --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectSuggestionJM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.Project.ProjectSuggestionJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Model.Project.ProjectSuggestion + +instance FromJSON ProjectSuggestion where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectSuggestion where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectSuggestionSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectSuggestionSM.hs new file mode 100644 index 000000000..6aeff11c0 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectSuggestionSM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.Project.ProjectSuggestionSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.ProjectSuggestionJM () +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Model.Project.ProjectSuggestion +import Wizard.Service.Project.ProjectMapper + +instance ToSchema ProjectSuggestion where + declareNamedSchema = toSwagger (toSuggestion project1) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectVisibilityJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectVisibilityJM.hs new file mode 100644 index 000000000..df2855c32 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectVisibilityJM.hs @@ -0,0 +1,9 @@ +module Wizard.Api.Resource.Project.ProjectVisibilityJM where + +import Data.Aeson + +import Wizard.Model.Project.Project + +instance FromJSON ProjectVisibility + +instance ToJSON ProjectVisibility diff --git a/wizard-server/src/Wizard/Api/Resource/Project/ProjectVisibilitySM.hs b/wizard-server/src/Wizard/Api/Resource/Project/ProjectVisibilitySM.hs new file mode 100644 index 000000000..7e3397ce3 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/ProjectVisibilitySM.hs @@ -0,0 +1,7 @@ +module Wizard.Api.Resource.Project.ProjectVisibilitySM where + +import Data.Swagger + +import Wizard.Model.Project.Project + +instance ToSchema ProjectVisibility diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Version/ProjectVersionChangeDTO.hs b/wizard-server/src/Wizard/Api/Resource/Project/Version/ProjectVersionChangeDTO.hs new file mode 100644 index 000000000..9ddfb0201 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Version/ProjectVersionChangeDTO.hs @@ -0,0 +1,11 @@ +module Wizard.Api.Resource.Project.Version.ProjectVersionChangeDTO where + +import qualified Data.UUID as U +import GHC.Generics + +data ProjectVersionChangeDTO = ProjectVersionChangeDTO + { name :: String + , description :: Maybe String + , eventUuid :: U.UUID + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Version/ProjectVersionChangeJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Version/ProjectVersionChangeJM.hs new file mode 100644 index 000000000..aac5d2fe6 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Version/ProjectVersionChangeJM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.Project.Version.ProjectVersionChangeJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.Project.Version.ProjectVersionChangeDTO + +instance FromJSON ProjectVersionChangeDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectVersionChangeDTO where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Version/ProjectVersionChangeSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Version/ProjectVersionChangeSM.hs new file mode 100644 index 000000000..0e0d3f309 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Version/ProjectVersionChangeSM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.Project.Version.ProjectVersionChangeSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.Version.ProjectVersionChangeDTO +import Wizard.Api.Resource.Project.Version.ProjectVersionChangeJM () +import Wizard.Database.Migration.Development.Project.Data.ProjectVersions +import Wizard.Database.Migration.Development.Project.Data.Projects + +instance ToSchema ProjectVersionChangeDTO where + declareNamedSchema = toSwagger (projectVersion2ChangeDto project1Uuid) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Version/ProjectVersionListJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Version/ProjectVersionListJM.hs new file mode 100644 index 000000000..2b2dcd7e1 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Version/ProjectVersionListJM.hs @@ -0,0 +1,20 @@ +module Wizard.Api.Resource.Project.Version.ProjectVersionListJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Model.Project.Version.ProjectVersion +import Wizard.Model.Project.Version.ProjectVersionList +import WizardLib.Public.Api.Resource.User.UserSuggestionJM () + +instance FromJSON ProjectVersion where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectVersion where + toJSON = genericToJSON jsonOptions + +instance FromJSON ProjectVersionList where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectVersionList where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Version/ProjectVersionListSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Version/ProjectVersionListSM.hs new file mode 100644 index 000000000..5494cac08 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Version/ProjectVersionListSM.hs @@ -0,0 +1,13 @@ +module Wizard.Api.Resource.Project.Version.ProjectVersionListSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.Version.ProjectVersionListJM () +import Wizard.Database.Migration.Development.Project.Data.ProjectVersions +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Model.Project.Version.ProjectVersionList +import WizardLib.Public.Api.Resource.User.UserSuggestionSM () + +instance ToSchema ProjectVersionList where + declareNamedSchema = toSwagger (projectVersion1List project1Uuid) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Version/ProjectVersionRevertDTO.hs b/wizard-server/src/Wizard/Api/Resource/Project/Version/ProjectVersionRevertDTO.hs new file mode 100644 index 000000000..7197f4be9 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Version/ProjectVersionRevertDTO.hs @@ -0,0 +1,9 @@ +module Wizard.Api.Resource.Project.Version.ProjectVersionRevertDTO where + +import qualified Data.UUID as U +import GHC.Generics + +data ProjectVersionRevertDTO = ProjectVersionRevertDTO + { eventUuid :: U.UUID + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Version/ProjectVersionRevertJM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Version/ProjectVersionRevertJM.hs new file mode 100644 index 000000000..199207323 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Version/ProjectVersionRevertJM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.Project.Version.ProjectVersionRevertJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.Project.Version.ProjectVersionRevertDTO + +instance FromJSON ProjectVersionRevertDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectVersionRevertDTO where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Project/Version/ProjectVersionRevertSM.hs b/wizard-server/src/Wizard/Api/Resource/Project/Version/ProjectVersionRevertSM.hs new file mode 100644 index 000000000..473874035 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Project/Version/ProjectVersionRevertSM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.Project.Version.ProjectVersionRevertSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.Version.ProjectVersionRevertDTO +import Wizard.Api.Resource.Project.Version.ProjectVersionRevertJM () +import Wizard.Database.Migration.Development.Project.Data.ProjectVersions +import Wizard.Database.Migration.Development.Project.Data.Projects + +instance ToSchema ProjectVersionRevertDTO where + declareNamedSchema = toSwagger (projectVersion1RevertDto project1Uuid) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Event/QuestionnaireEventChangeDTO.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/Event/QuestionnaireEventChangeDTO.hs deleted file mode 100644 index 9238449a8..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Event/QuestionnaireEventChangeDTO.hs +++ /dev/null @@ -1,112 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventChangeDTO where - -import qualified Data.UUID as U -import GHC.Generics - -import Wizard.Model.Questionnaire.QuestionnaireReply -import WizardLib.Public.Model.User.UserSuggestion - -data QuestionnaireEventChangeDTO - = SetReplyEventChangeDTO' SetReplyEventChangeDTO - | ClearReplyEventChangeDTO' ClearReplyEventChangeDTO - | SetPhaseEventChangeDTO' SetPhaseEventChangeDTO - | SetLabelsEventChangeDTO' SetLabelsEventChangeDTO - | ResolveCommentThreadEventChangeDTO' ResolveCommentThreadEventChangeDTO - | ReopenCommentThreadEventChangeDTO' ReopenCommentThreadEventChangeDTO - | AssignCommentThreadEventChangeDTO' AssignCommentThreadEventChangeDTO - | DeleteCommentThreadEventChangeDTO' DeleteCommentThreadEventChangeDTO - | AddCommentEventChangeDTO' AddCommentEventChangeDTO - | EditCommentEventChangeDTO' EditCommentEventChangeDTO - | DeleteCommentEventChangeDTO' DeleteCommentEventChangeDTO - deriving (Show, Eq, Generic) - -data SetReplyEventChangeDTO = SetReplyEventChangeDTO - { uuid :: U.UUID - , path :: String - , value :: ReplyValue - } - deriving (Show, Eq, Generic) - -data ClearReplyEventChangeDTO = ClearReplyEventChangeDTO - { uuid :: U.UUID - , path :: String - } - deriving (Show, Eq, Generic) - -data SetPhaseEventChangeDTO = SetPhaseEventChangeDTO - { uuid :: U.UUID - , phaseUuid :: Maybe U.UUID - } - deriving (Show, Eq, Generic) - -data SetLabelsEventChangeDTO = SetLabelsEventChangeDTO - { uuid :: U.UUID - , path :: String - , value :: [U.UUID] - } - deriving (Show, Eq, Generic) - -data ResolveCommentThreadEventChangeDTO = ResolveCommentThreadEventChangeDTO - { uuid :: U.UUID - , threadUuid :: U.UUID - , path :: String - , private :: Bool - , commentCount :: Int - } - deriving (Show, Eq, Generic) - -data ReopenCommentThreadEventChangeDTO = ReopenCommentThreadEventChangeDTO - { uuid :: U.UUID - , threadUuid :: U.UUID - , path :: String - , private :: Bool - , commentCount :: Int - } - deriving (Show, Eq, Generic) - -data AssignCommentThreadEventChangeDTO = AssignCommentThreadEventChangeDTO - { uuid :: U.UUID - , threadUuid :: U.UUID - , path :: String - , private :: Bool - , assignedTo :: Maybe UserSuggestion - } - deriving (Show, Eq, Generic) - -data DeleteCommentThreadEventChangeDTO = DeleteCommentThreadEventChangeDTO - { uuid :: U.UUID - , path :: String - , threadUuid :: U.UUID - , private :: Bool - } - deriving (Show, Eq, Generic) - -data AddCommentEventChangeDTO = AddCommentEventChangeDTO - { uuid :: U.UUID - , path :: String - , threadUuid :: U.UUID - , commentUuid :: U.UUID - , text :: String - , private :: Bool - , newThread :: Bool - } - deriving (Show, Eq, Generic) - -data EditCommentEventChangeDTO = EditCommentEventChangeDTO - { uuid :: U.UUID - , path :: String - , threadUuid :: U.UUID - , commentUuid :: U.UUID - , text :: String - , private :: Bool - } - deriving (Show, Eq, Generic) - -data DeleteCommentEventChangeDTO = DeleteCommentEventChangeDTO - { uuid :: U.UUID - , path :: String - , threadUuid :: U.UUID - , commentUuid :: U.UUID - , private :: Bool - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Event/QuestionnaireEventChangeJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/Event/QuestionnaireEventChangeJM.hs deleted file mode 100644 index 8980f81ea..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Event/QuestionnaireEventChangeJM.hs +++ /dev/null @@ -1,96 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventChangeJM where - -import Control.Monad -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventChangeDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireReplyJM () -import WizardLib.Public.Api.Resource.User.UserSuggestionJM () - -instance ToJSON QuestionnaireEventChangeDTO where - toJSON = toSumJSONWithTypeField "type" "ChangeDTO" - -instance FromJSON QuestionnaireEventChangeDTO where - parseJSON (Object o) = do - eventType <- o .: "type" - case eventType of - "SetReplyEvent" -> parseJSON (Object o) >>= \event -> return (SetReplyEventChangeDTO' event) - "ClearReplyEvent" -> parseJSON (Object o) >>= \event -> return (ClearReplyEventChangeDTO' event) - "SetPhaseEvent" -> parseJSON (Object o) >>= \event -> return (SetPhaseEventChangeDTO' event) - "SetLabelsEvent" -> parseJSON (Object o) >>= \event -> return (SetLabelsEventChangeDTO' event) - "ResolveCommentThreadEvent" -> parseJSON (Object o) >>= \event -> return (ResolveCommentThreadEventChangeDTO' event) - "ReopenCommentThreadEvent" -> parseJSON (Object o) >>= \event -> return (ReopenCommentThreadEventChangeDTO' event) - "AssignCommentThreadEvent" -> parseJSON (Object o) >>= \event -> return (AssignCommentThreadEventChangeDTO' event) - "DeleteCommentThreadEvent" -> parseJSON (Object o) >>= \event -> return (DeleteCommentThreadEventChangeDTO' event) - "AddCommentEvent" -> parseJSON (Object o) >>= \event -> return (AddCommentEventChangeDTO' event) - "EditCommentEvent" -> parseJSON (Object o) >>= \event -> return (EditCommentEventChangeDTO' event) - "DeleteCommentEvent" -> parseJSON (Object o) >>= \event -> return (DeleteCommentEventChangeDTO' event) - _ -> fail "One of the events has unsupported type" - parseJSON _ = mzero - -instance FromJSON SetReplyEventChangeDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON SetReplyEventChangeDTO where - toJSON = genericToJSON jsonOptions - -instance FromJSON ClearReplyEventChangeDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON ClearReplyEventChangeDTO where - toJSON = genericToJSON jsonOptions - -instance FromJSON SetPhaseEventChangeDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON SetPhaseEventChangeDTO where - toJSON = genericToJSON jsonOptions - -instance FromJSON SetLabelsEventChangeDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON SetLabelsEventChangeDTO where - toJSON = genericToJSON jsonOptions - -instance FromJSON ResolveCommentThreadEventChangeDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON ResolveCommentThreadEventChangeDTO where - toJSON = genericToJSON jsonOptions - -instance FromJSON ReopenCommentThreadEventChangeDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON ReopenCommentThreadEventChangeDTO where - toJSON = genericToJSON jsonOptions - -instance FromJSON AssignCommentThreadEventChangeDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON AssignCommentThreadEventChangeDTO where - toJSON = genericToJSON jsonOptions - -instance FromJSON DeleteCommentThreadEventChangeDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON DeleteCommentThreadEventChangeDTO where - toJSON = genericToJSON jsonOptions - -instance FromJSON AddCommentEventChangeDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON AddCommentEventChangeDTO where - toJSON = genericToJSON jsonOptions - -instance FromJSON EditCommentEventChangeDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON EditCommentEventChangeDTO where - toJSON = genericToJSON jsonOptions - -instance FromJSON DeleteCommentEventChangeDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON DeleteCommentEventChangeDTO where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Event/QuestionnaireEventChangeSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/Event/QuestionnaireEventChangeSM.hs deleted file mode 100644 index e173cb0ee..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Event/QuestionnaireEventChangeSM.hs +++ /dev/null @@ -1,54 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventChangeSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventChangeDTO -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventChangeJM () -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireReplySM () -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Service.Questionnaire.Event.QuestionnaireEventMapper -import WizardLib.Public.Api.Resource.User.UserSuggestionSM () - -instance ToSchema QuestionnaireEventChangeDTO where - declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions - -instance ToSchema SetReplyEventChangeDTO where - declareNamedSchema = - toSwagger (toSetReplyEventChangeDTO (sre_rQ1 questionnaire1.uuid)) - -instance ToSchema ClearReplyEventChangeDTO where - declareNamedSchema = - toSwagger (toClearReplyEventChangeDTO (cre_rQ1 questionnaire1.uuid)) - -instance ToSchema SetPhaseEventChangeDTO where - declareNamedSchema = - toSwagger (toSetPhaseEventChangeDTO (sphse_1 questionnaire1.uuid)) - -instance ToSchema SetLabelsEventChangeDTO where - declareNamedSchema = - toSwagger (toSetLabelsEventChangeDTO (slble_rQ2 questionnaire1.uuid)) - -instance ToSchema ResolveCommentThreadEventChangeDTO where - declareNamedSchema = toSwagger rtche_rQ1_t1 - -instance ToSchema ReopenCommentThreadEventChangeDTO where - declareNamedSchema = toSwagger otche_rQ1_t1 - -instance ToSchema AssignCommentThreadEventChangeDTO where - declareNamedSchema = toSwagger asche_rQ1_t1 - -instance ToSchema DeleteCommentThreadEventChangeDTO where - declareNamedSchema = toSwagger dtche_rQ1_t1 - -instance ToSchema AddCommentEventChangeDTO where - declareNamedSchema = toSwagger acche_rQ2_t1_1 - -instance ToSchema EditCommentEventChangeDTO where - declareNamedSchema = toSwagger ecche_rQ1_t1_1 - -instance ToSchema DeleteCommentEventChangeDTO where - declareNamedSchema = toSwagger dcche_rQ1_t1_1 diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Event/QuestionnaireEventDTO.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/Event/QuestionnaireEventDTO.hs deleted file mode 100644 index b5ab520d1..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Event/QuestionnaireEventDTO.hs +++ /dev/null @@ -1,209 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventDTO where - -import Data.Time -import qualified Data.UUID as U -import GHC.Generics - -import Wizard.Model.Questionnaire.QuestionnaireReply -import WizardLib.Public.Model.User.UserSuggestion - -data QuestionnaireEventDTO - = SetReplyEventDTO' SetReplyEventDTO - | ClearReplyEventDTO' ClearReplyEventDTO - | SetPhaseEventDTO' SetPhaseEventDTO - | SetLabelsEventDTO' SetLabelsEventDTO - | ResolveCommentThreadEventDTO' ResolveCommentThreadEventDTO - | ReopenCommentThreadEventDTO' ReopenCommentThreadEventDTO - | AssignCommentThreadEventDTO' AssignCommentThreadEventDTO - | DeleteCommentThreadEventDTO' DeleteCommentThreadEventDTO - | AddCommentEventDTO' AddCommentEventDTO - | EditCommentEventDTO' EditCommentEventDTO - | DeleteCommentEventDTO' DeleteCommentEventDTO - deriving (Show, Eq, Generic) - -data SetReplyEventDTO = SetReplyEventDTO - { uuid :: U.UUID - , path :: String - , value :: ReplyValue - , createdBy :: Maybe UserSuggestion - , createdAt :: UTCTime - } - deriving (Show, Generic) - -instance Eq SetReplyEventDTO where - a == b = - a.uuid == b.uuid - && a.path == b.path - && a.value == b.value - && a.createdBy == b.createdBy - -data ClearReplyEventDTO = ClearReplyEventDTO - { uuid :: U.UUID - , path :: String - , createdBy :: Maybe UserSuggestion - , createdAt :: UTCTime - } - deriving (Show, Generic) - -instance Eq ClearReplyEventDTO where - a == b = - a.uuid == b.uuid - && a.path == b.path - && a.createdBy == b.createdBy - -data SetPhaseEventDTO = SetPhaseEventDTO - { uuid :: U.UUID - , phaseUuid :: Maybe U.UUID - , createdBy :: Maybe UserSuggestion - , createdAt :: UTCTime - } - deriving (Show, Generic) - -instance Eq SetPhaseEventDTO where - a == b = - a.uuid == b.uuid - && a.phaseUuid == b.phaseUuid - && a.createdBy == b.createdBy - -data SetLabelsEventDTO = SetLabelsEventDTO - { uuid :: U.UUID - , path :: String - , value :: [U.UUID] - , createdBy :: Maybe UserSuggestion - , createdAt :: UTCTime - } - deriving (Show, Generic) - -instance Eq SetLabelsEventDTO where - a == b = - a.uuid == b.uuid - && a.path == b.path - && a.value == b.value - && a.createdBy == b.createdBy - -data ResolveCommentThreadEventDTO = ResolveCommentThreadEventDTO - { uuid :: U.UUID - , path :: String - , threadUuid :: U.UUID - , commentCount :: Int - , createdBy :: Maybe UserSuggestion - , createdAt :: UTCTime - } - deriving (Show, Generic) - -instance Eq ResolveCommentThreadEventDTO where - a == b = - a.uuid == b.uuid - && a.path == b.path - && a.threadUuid == b.threadUuid - && a.createdBy == b.createdBy - -data ReopenCommentThreadEventDTO = ReopenCommentThreadEventDTO - { uuid :: U.UUID - , path :: String - , threadUuid :: U.UUID - , commentCount :: Int - , createdBy :: Maybe UserSuggestion - , createdAt :: UTCTime - } - deriving (Show, Generic) - -instance Eq ReopenCommentThreadEventDTO where - a == b = - a.uuid == b.uuid - && a.path == b.path - && a.threadUuid == b.threadUuid - && a.createdBy == b.createdBy - -data AssignCommentThreadEventDTO = AssignCommentThreadEventDTO - { uuid :: U.UUID - , path :: String - , threadUuid :: U.UUID - , private :: Bool - , assignedTo :: Maybe UserSuggestion - , createdBy :: Maybe UserSuggestion - , createdAt :: UTCTime - } - deriving (Show, Generic) - -instance Eq AssignCommentThreadEventDTO where - a == b = - a.uuid == b.uuid - && a.path == b.path - && a.threadUuid == b.threadUuid - && a.createdBy == b.createdBy - -data DeleteCommentThreadEventDTO = DeleteCommentThreadEventDTO - { uuid :: U.UUID - , path :: String - , threadUuid :: U.UUID - , createdBy :: Maybe UserSuggestion - , createdAt :: UTCTime - } - deriving (Show, Generic) - -instance Eq DeleteCommentThreadEventDTO where - a == b = - a.uuid == b.uuid - && a.path == b.path - && a.threadUuid == b.threadUuid - && a.createdBy == b.createdBy - -data AddCommentEventDTO = AddCommentEventDTO - { uuid :: U.UUID - , path :: String - , threadUuid :: U.UUID - , commentUuid :: U.UUID - , text :: String - , private :: Bool - , createdBy :: Maybe UserSuggestion - , createdAt :: UTCTime - } - deriving (Show, Generic) - -instance Eq AddCommentEventDTO where - a == b = - a.uuid == b.uuid - && a.path == b.path - && a.threadUuid == b.threadUuid - && a.commentUuid == b.commentUuid - && a.text == b.text - && a.createdBy == b.createdBy - -data EditCommentEventDTO = EditCommentEventDTO - { uuid :: U.UUID - , path :: String - , threadUuid :: U.UUID - , commentUuid :: U.UUID - , text :: String - , createdBy :: Maybe UserSuggestion - , createdAt :: UTCTime - } - deriving (Show, Generic) - -instance Eq EditCommentEventDTO where - a == b = - a.uuid == b.uuid - && a.path == b.path - && a.threadUuid == b.threadUuid - && a.commentUuid == b.commentUuid - && a.text == b.text - && a.createdBy == b.createdBy - -data DeleteCommentEventDTO = DeleteCommentEventDTO - { uuid :: U.UUID - , path :: String - , threadUuid :: U.UUID - , commentUuid :: U.UUID - , createdBy :: Maybe UserSuggestion - , createdAt :: UTCTime - } - deriving (Show, Generic) - -instance Eq DeleteCommentEventDTO where - a == b = - a.uuid == b.uuid - && a.path == b.path - && a.threadUuid == b.threadUuid - && a.commentUuid == b.commentUuid - && a.createdBy == b.createdBy diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Event/QuestionnaireEventJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/Event/QuestionnaireEventJM.hs deleted file mode 100644 index e56464a45..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Event/QuestionnaireEventJM.hs +++ /dev/null @@ -1,137 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventJM where - -import Control.Monad -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireReplyJM () -import Wizard.Model.Questionnaire.QuestionnaireEvent -import WizardLib.Public.Api.Resource.User.UserSuggestionJM () - -instance ToJSON QuestionnaireEventDTO where - toJSON = toSumJSON - -instance FromJSON QuestionnaireEventDTO where - parseJSON (Object o) = do - eventType <- o .: "type" - case eventType of - "SetReplyEvent" -> parseJSON (Object o) >>= \event -> return (SetReplyEventDTO' event) - "ClearReplyEvent" -> parseJSON (Object o) >>= \event -> return (ClearReplyEventDTO' event) - "SetPhaseEvent" -> parseJSON (Object o) >>= \event -> return (SetPhaseEventDTO' event) - "SetLabelsEvent" -> parseJSON (Object o) >>= \event -> return (SetLabelsEventDTO' event) - "ResolveCommentThreadEvent" -> parseJSON (Object o) >>= \event -> return (ResolveCommentThreadEventDTO' event) - "ReopenCommentThreadEvent" -> parseJSON (Object o) >>= \event -> return (ReopenCommentThreadEventDTO' event) - "AssignCommentThreadEvent" -> parseJSON (Object o) >>= \event -> return (AssignCommentThreadEventDTO' event) - "DeleteCommentThreadEvent" -> parseJSON (Object o) >>= \event -> return (DeleteCommentThreadEventDTO' event) - "AddCommentEvent" -> parseJSON (Object o) >>= \event -> return (AddCommentEventDTO' event) - "EditCommentEvent" -> parseJSON (Object o) >>= \event -> return (EditCommentEventDTO' event) - "DeleteCommentEvent" -> parseJSON (Object o) >>= \event -> return (DeleteCommentEventDTO' event) - _ -> fail "One of the events has unsupported type" - parseJSON _ = mzero - -instance FromJSON SetReplyEventDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON SetReplyEventDTO where - toJSON = genericToJSON (jsonOptionsWithTypeField "type") - -instance FromJSON ClearReplyEventDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON ClearReplyEventDTO where - toJSON = genericToJSON (jsonOptionsWithTypeField "type") - -instance FromJSON SetPhaseEventDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON SetPhaseEventDTO where - toJSON = genericToJSON (jsonOptionsWithTypeField "type") - -instance FromJSON SetLabelsEventDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON SetLabelsEventDTO where - toJSON = genericToJSON (jsonOptionsWithTypeField "type") - -instance FromJSON ResolveCommentThreadEventDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON ResolveCommentThreadEventDTO where - toJSON = genericToJSON (jsonOptionsWithTypeField "type") - -instance FromJSON ReopenCommentThreadEventDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON ReopenCommentThreadEventDTO where - toJSON = genericToJSON (jsonOptionsWithTypeField "type") - -instance FromJSON AssignCommentThreadEventDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON AssignCommentThreadEventDTO where - toJSON = genericToJSON (jsonOptionsWithTypeField "type") - -instance FromJSON DeleteCommentThreadEventDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON DeleteCommentThreadEventDTO where - toJSON = genericToJSON (jsonOptionsWithTypeField "type") - -instance FromJSON AddCommentEventDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON AddCommentEventDTO where - toJSON = genericToJSON (jsonOptionsWithTypeField "type") - -instance FromJSON EditCommentEventDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON EditCommentEventDTO where - toJSON = genericToJSON (jsonOptionsWithTypeField "type") - -instance FromJSON DeleteCommentEventDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON DeleteCommentEventDTO where - toJSON = genericToJSON (jsonOptionsWithTypeField "type") - --- -------------------------------------------- --- -------------------------------------------- -instance ToJSON QuestionnaireEvent where - toJSON = toSumJSONWithTypeField "type" "" - -instance FromJSON QuestionnaireEvent where - parseJSON (Object o) = do - eventType <- o .: "type" - case eventType of - "SetReplyEvent" -> parseJSON (Object o) >>= \event -> return (SetReplyEvent' event) - "ClearReplyEvent" -> parseJSON (Object o) >>= \event -> return (ClearReplyEvent' event) - "SetPhaseEvent" -> parseJSON (Object o) >>= \event -> return (SetPhaseEvent' event) - "SetLabelsEvent" -> parseJSON (Object o) >>= \event -> return (SetLabelsEvent' event) - _ -> fail "One of the events has unsupported type" - parseJSON _ = mzero - -instance FromJSON SetReplyEvent where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON SetReplyEvent where - toJSON = genericToJSON (jsonOptionsWithTypeField "type") - -instance FromJSON ClearReplyEvent where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON ClearReplyEvent where - toJSON = genericToJSON (jsonOptionsWithTypeField "type") - -instance FromJSON SetPhaseEvent where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON SetPhaseEvent where - toJSON = genericToJSON (jsonOptionsWithTypeField "type") - -instance FromJSON SetLabelsEvent where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON SetLabelsEvent where - toJSON = genericToJSON (jsonOptionsWithTypeField "type") diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Event/QuestionnaireEventListJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/Event/QuestionnaireEventListJM.hs deleted file mode 100644 index e14477dcf..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Event/QuestionnaireEventListJM.hs +++ /dev/null @@ -1,47 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventListJM where - -import Control.Monad -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.Questionnaire.QuestionnaireReplyJM () -import Wizard.Model.Questionnaire.QuestionnaireEventList -import WizardLib.Public.Api.Resource.User.UserSuggestionJM () - -instance ToJSON QuestionnaireEventList where - toJSON = toSumJSONWithTypeField "type" "List" - -instance FromJSON QuestionnaireEventList where - parseJSON (Object o) = do - eventType <- o .: "type" - case eventType of - "SetReplyEvent" -> parseJSON (Object o) >>= \event -> return (SetReplyEventList' event) - "ClearReplyEvent" -> parseJSON (Object o) >>= \event -> return (ClearReplyEventList' event) - "SetPhaseEvent" -> parseJSON (Object o) >>= \event -> return (SetPhaseEventList' event) - "SetLabelsEvent" -> parseJSON (Object o) >>= \event -> return (SetLabelsEventList' event) - _ -> fail "One of the events has unsupported type" - parseJSON _ = mzero - -instance FromJSON SetReplyEventList where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON SetReplyEventList where - toJSON = genericToJSON jsonOptions - -instance FromJSON ClearReplyEventList where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON ClearReplyEventList where - toJSON = genericToJSON jsonOptions - -instance FromJSON SetPhaseEventList where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON SetPhaseEventList where - toJSON = genericToJSON jsonOptions - -instance FromJSON SetLabelsEventList where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON SetLabelsEventList where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Event/QuestionnaireEventListSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/Event/QuestionnaireEventListSM.hs deleted file mode 100644 index 5e99a8edd..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Event/QuestionnaireEventListSM.hs +++ /dev/null @@ -1,29 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventListSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventListJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireReplySM () -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Database.Migration.Development.User.Data.Users -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireEventList -import Wizard.Service.Questionnaire.Event.QuestionnaireEventMapper -import WizardLib.Public.Api.Resource.User.UserSuggestionSM () - -instance ToSchema QuestionnaireEventList where - declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions - -instance ToSchema SetReplyEventList where - declareNamedSchema = toSwagger (toSetReplyEventList (sre_rQ1 questionnaire1.uuid) (Just userAlbert)) - -instance ToSchema ClearReplyEventList where - declareNamedSchema = toSwagger (toClearReplyEventList (cre_rQ1 questionnaire1.uuid) (Just userAlbert)) - -instance ToSchema SetPhaseEventList where - declareNamedSchema = toSwagger (toSetPhaseEventList (sphse_1 questionnaire1.uuid) (Just userAlbert)) - -instance ToSchema SetLabelsEventList where - declareNamedSchema = toSwagger (toSetLabelsEventList (slble_rQ2 questionnaire1.uuid) (Just userAlbert)) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Event/QuestionnaireEventSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/Event/QuestionnaireEventSM.hs deleted file mode 100644 index 020052619..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Event/QuestionnaireEventSM.hs +++ /dev/null @@ -1,50 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventDTO -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireReplySM () -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Database.Migration.Development.User.Data.Users -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Service.Questionnaire.Event.QuestionnaireEventMapper -import WizardLib.Public.Api.Resource.User.UserSuggestionSM () - -instance ToSchema QuestionnaireEventDTO where - declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions - -instance ToSchema SetReplyEventDTO where - declareNamedSchema = toSwagger (toSetReplyEventDTO (sre_rQ1 questionnaire1.uuid) (Just userAlbert)) - -instance ToSchema ClearReplyEventDTO where - declareNamedSchema = toSwagger (toClearReplyEventDTO (cre_rQ1 questionnaire1.uuid) (Just userAlbert)) - -instance ToSchema SetPhaseEventDTO where - declareNamedSchema = toSwagger (toSetPhaseEventDTO (sphse_1 questionnaire1.uuid) (Just userAlbert)) - -instance ToSchema SetLabelsEventDTO where - declareNamedSchema = toSwagger (toSetLabelsEventDTO (slble_rQ2 questionnaire1.uuid) (Just userAlbert)) - -instance ToSchema ResolveCommentThreadEventDTO where - declareNamedSchema = toSwagger rte_rQ1_t1 - -instance ToSchema ReopenCommentThreadEventDTO where - declareNamedSchema = toSwagger ote_rQ1_t1 - -instance ToSchema AssignCommentThreadEventDTO where - declareNamedSchema = toSwagger aste_rQ1_t1 - -instance ToSchema DeleteCommentThreadEventDTO where - declareNamedSchema = toSwagger dte_rQ1_t1 - -instance ToSchema AddCommentEventDTO where - declareNamedSchema = toSwagger ace_rQ1_t1_1 - -instance ToSchema EditCommentEventDTO where - declareNamedSchema = toSwagger ece_rQ1_t1_1 - -instance ToSchema DeleteCommentEventDTO where - declareNamedSchema = toSwagger dce_rQ1_t1_1 diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/File/QuestionnaireFileListJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/File/QuestionnaireFileListJM.hs deleted file mode 100644 index 151214d36..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/File/QuestionnaireFileListJM.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.File.QuestionnaireFileListJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.Questionnaire.QuestionnaireSimpleJM () -import Wizard.Model.Questionnaire.QuestionnaireFileList -import WizardLib.Public.Api.Resource.User.UserSuggestionJM () - -instance FromJSON QuestionnaireFileList where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireFileList where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/File/QuestionnaireFileListSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/File/QuestionnaireFileListSM.hs deleted file mode 100644 index 64604a868..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/File/QuestionnaireFileListSM.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.File.QuestionnaireFileListSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Questionnaire.File.QuestionnaireFileListJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSimpleSM () -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireFiles -import Wizard.Model.Questionnaire.QuestionnaireFileList -import WizardLib.Public.Api.Resource.User.UserSuggestionSM () - -instance ToSchema QuestionnaireFileList where - declareNamedSchema = toSwagger questionnaireFileList diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/File/QuestionnaireFileSimpleJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/File/QuestionnaireFileSimpleJM.hs deleted file mode 100644 index 2c5da897d..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/File/QuestionnaireFileSimpleJM.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.File.QuestionnaireFileSimpleJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Model.Questionnaire.QuestionnaireFileSimple - -instance FromJSON QuestionnaireFileSimple where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireFileSimple where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/File/QuestionnaireFileSimpleSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/File/QuestionnaireFileSimpleSM.hs deleted file mode 100644 index 621e22fa2..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/File/QuestionnaireFileSimpleSM.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.File.QuestionnaireFileSimpleSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Questionnaire.File.QuestionnaireFileSimpleJM () -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireFiles -import Wizard.Model.Questionnaire.QuestionnaireFileSimple - -instance ToSchema QuestionnaireFileSimple where - declareNamedSchema = toSwagger questionnaireFileSimple diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateChangeDTO.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateChangeDTO.hs deleted file mode 100644 index 27908c237..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateChangeDTO.hs +++ /dev/null @@ -1,9 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.Migration.MigratorStateChangeDTO where - -import qualified Data.UUID as U -import GHC.Generics - -data MigratorStateChangeDTO = MigratorStateChangeDTO - { resolvedQuestionUuids :: [U.UUID] - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateChangeJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateChangeJM.hs deleted file mode 100644 index c20d8697d..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateChangeJM.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.Migration.MigratorStateChangeJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateChangeDTO - -instance FromJSON MigratorStateChangeDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON MigratorStateChangeDTO where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateChangeSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateChangeSM.hs deleted file mode 100644 index 0c2f27799..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateChangeSM.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.Migration.MigratorStateChangeSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateChangeDTO -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateChangeJM () -import Wizard.Database.Migration.Development.Questionnaire.Data.MigratorStates - -instance ToSchema MigratorStateChangeDTO where - declareNamedSchema = toSwagger migratorStateChange diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateCreateDTO.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateCreateDTO.hs deleted file mode 100644 index 1b3520fa0..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateCreateDTO.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.Migration.MigratorStateCreateDTO where - -import qualified Data.UUID as U -import GHC.Generics - -data MigratorStateCreateDTO = MigratorStateCreateDTO - { targetKnowledgeModelPackageId :: String - , targetTagUuids :: [U.UUID] - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateCreateJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateCreateJM.hs deleted file mode 100644 index 144e645c7..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateCreateJM.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.Migration.MigratorStateCreateJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateCreateDTO - -instance FromJSON MigratorStateCreateDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON MigratorStateCreateDTO where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateCreateSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateCreateSM.hs deleted file mode 100644 index e955a1f2f..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateCreateSM.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.Migration.MigratorStateCreateSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateCreateDTO -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateCreateJM () -import Wizard.Database.Migration.Development.Questionnaire.Data.MigratorStates - -instance ToSchema MigratorStateCreateDTO where - declareNamedSchema = toSwagger migratorStateCreate diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateDTO.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateDTO.hs deleted file mode 100644 index 68ea1fef6..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateDTO.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.Migration.MigratorStateDTO where - -import qualified Data.UUID as U -import GHC.Generics - -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailQuestionnaireDTO - -data MigratorStateDTO = MigratorStateDTO - { oldQuestionnaire :: QuestionnaireDetailQuestionnaireDTO - , newQuestionnaire :: QuestionnaireDetailQuestionnaireDTO - , resolvedQuestionUuids :: [U.UUID] - , tenantUuid :: U.UUID - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateJM.hs deleted file mode 100644 index 73801b86c..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateJM.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.Migration.MigratorStateJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailQuestionnaireJM () - -instance FromJSON MigratorStateDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON MigratorStateDTO where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateSM.hs deleted file mode 100644 index 02cc75fa7..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Migration/MigratorStateSM.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.Migration.MigratorStateSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateDTO -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailQuestionnaireSM () -import Wizard.Database.Migration.Development.Questionnaire.Data.MigratorStates - -instance ToSchema MigratorStateDTO where - declareNamedSchema = toSwagger nlQtnMigrationStateDto diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCommentThreadAssignedJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCommentThreadAssignedJM.hs deleted file mode 100644 index be9494a06..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCommentThreadAssignedJM.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireCommentThreadAssignedJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Model.Questionnaire.QuestionnaireCommentThreadAssigned -import WizardLib.Public.Api.Resource.User.UserSuggestionJM () - -instance FromJSON QuestionnaireCommentThreadAssigned where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireCommentThreadAssigned where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCommentThreadAssignedSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCommentThreadAssignedSM.hs deleted file mode 100644 index 6d1ebdba0..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCommentThreadAssignedSM.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireCommentThreadAssignedSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Questionnaire.QuestionnaireCommentThreadAssignedJM () -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireComments -import Wizard.Model.Questionnaire.QuestionnaireCommentThreadAssigned -import WizardLib.Public.Api.Resource.User.UserSuggestionSM () - -instance ToSchema QuestionnaireCommentThreadAssigned where - declareNamedSchema = toSwagger cmtAssigned diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCommentThreadListJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCommentThreadListJM.hs deleted file mode 100644 index fd4a07c54..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCommentThreadListJM.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireCommentThreadListJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Model.Questionnaire.QuestionnaireCommentList -import WizardLib.Public.Api.Resource.User.UserSuggestionJM () - -instance FromJSON QuestionnaireCommentThreadList where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireCommentThreadList where - toJSON = genericToJSON jsonOptions - -instance FromJSON QuestionnaireCommentList where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireCommentList where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCommentThreadListSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCommentThreadListSM.hs deleted file mode 100644 index 853037de5..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCommentThreadListSM.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireCommentThreadListSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Questionnaire.QuestionnaireCommentThreadListJM () -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireComments -import Wizard.Model.Questionnaire.QuestionnaireCommentList -import WizardLib.Public.Api.Resource.User.UserSuggestionSM () - -instance ToSchema QuestionnaireCommentThreadList where - declareNamedSchema = toSwagger cmtQ1_t1Dto - -instance ToSchema QuestionnaireCommentList where - declareNamedSchema = toSwagger cmtQ1_t1_1Dto diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCommentThreadNotificationJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCommentThreadNotificationJM.hs deleted file mode 100644 index 62b4c24c1..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCommentThreadNotificationJM.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireCommentThreadNotificationJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.User.UserSimpleJM () -import Wizard.Model.Questionnaire.QuestionnaireCommentThreadNotification - -instance FromJSON QuestionnaireCommentThreadNotification where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireCommentThreadNotification where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireContentChangeDTO.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireContentChangeDTO.hs deleted file mode 100644 index c1de53e1d..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireContentChangeDTO.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireContentChangeDTO where - -import GHC.Generics - -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventChangeDTO - -data QuestionnaireContentChangeDTO = QuestionnaireContentChangeDTO - { events :: [QuestionnaireEventChangeDTO] - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireContentChangeJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireContentChangeJM.hs deleted file mode 100644 index b47eed7ad..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireContentChangeJM.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireContentChangeJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventChangeJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireContentChangeDTO - -instance FromJSON QuestionnaireContentChangeDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireContentChangeDTO where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireContentChangeSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireContentChangeSM.hs deleted file mode 100644 index e4c42ad5e..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireContentChangeSM.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireContentChangeSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventChangeSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireContentChangeDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireContentChangeJM () -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires - -instance ToSchema QuestionnaireContentChangeDTO where - declareNamedSchema = toSwagger contentChangeDTO diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireContentDTO.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireContentDTO.hs deleted file mode 100644 index c4d5e972a..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireContentDTO.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireContentDTO where - -import qualified Data.Map.Strict as M -import qualified Data.UUID as U -import GHC.Generics - -import Wizard.Model.Questionnaire.QuestionnaireCommentList -import Wizard.Model.Questionnaire.QuestionnaireEventList -import Wizard.Model.Questionnaire.QuestionnaireReply -import Wizard.Model.Questionnaire.QuestionnaireVersionList - -data QuestionnaireContentDTO = QuestionnaireContentDTO - { phaseUuid :: Maybe U.UUID - , replies :: M.Map String Reply - , commentThreadsMap :: M.Map String [QuestionnaireCommentThreadList] - , labels :: M.Map String [U.UUID] - , events :: [QuestionnaireEventList] - , versions :: [QuestionnaireVersionList] - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireContentJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireContentJM.hs deleted file mode 100644 index 2c65d4398..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireContentJM.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireContentJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventListJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireCommentThreadListJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireContentDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireReplyJM () -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionListJM () - -instance FromJSON QuestionnaireContentDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireContentDTO where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireContentSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireContentSM.hs deleted file mode 100644 index 4ea6f2ccc..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireContentSM.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireContentSM where - -import qualified Data.Map.Strict as M -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventListSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireCommentThreadListSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireContentDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireContentJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireReplySM () -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionListSM () -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Service.Questionnaire.QuestionnaireMapper - -instance ToSchema QuestionnaireContentDTO where - declareNamedSchema = toSwagger (toContentDTO questionnaire1Ctn M.empty [] []) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCreateDTO.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCreateDTO.hs deleted file mode 100644 index 989e73fda..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCreateDTO.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireCreateDTO where - -import qualified Data.UUID as U -import GHC.Generics - -import Wizard.Model.Questionnaire.Questionnaire - -data QuestionnaireCreateDTO = QuestionnaireCreateDTO - { name :: String - , knowledgeModelPackageId :: String - , visibility :: QuestionnaireVisibility - , sharing :: QuestionnaireSharing - , questionTagUuids :: [U.UUID] - , documentTemplateId :: Maybe String - , formatUuid :: Maybe U.UUID - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCreateFromTemplateDTO.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCreateFromTemplateDTO.hs deleted file mode 100644 index 89f0288d7..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCreateFromTemplateDTO.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireCreateFromTemplateDTO where - -import qualified Data.UUID as U -import GHC.Generics - -data QuestionnaireCreateFromTemplateDTO = QuestionnaireCreateFromTemplateDTO - { name :: String - , questionnaireUuid :: U.UUID - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCreateFromTemplateJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCreateFromTemplateJM.hs deleted file mode 100644 index 10c3563c4..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCreateFromTemplateJM.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireCreateFromTemplateJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.Questionnaire.QuestionnaireCreateFromTemplateDTO - -instance FromJSON QuestionnaireCreateFromTemplateDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireCreateFromTemplateDTO where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCreateFromTemplateSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCreateFromTemplateSM.hs deleted file mode 100644 index 4daf331d7..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCreateFromTemplateSM.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireCreateFromTemplateSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Questionnaire.QuestionnaireCreateFromTemplateDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireCreateFromTemplateJM () -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Service.Questionnaire.QuestionnaireMapper - -instance ToSchema QuestionnaireCreateFromTemplateDTO where - declareNamedSchema = toSwagger (toCreateFromTemplateDTO questionnaire1) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCreateJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCreateJM.hs deleted file mode 100644 index 1b7a96e99..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCreateJM.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireCreateJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.Questionnaire.QuestionnaireCreateDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireSharingJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireVisibilityJM () - -instance FromJSON QuestionnaireCreateDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireCreateDTO where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCreateSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCreateSM.hs deleted file mode 100644 index 05d34a69c..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireCreateSM.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireCreateSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Questionnaire.QuestionnaireCreateDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireCreateJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSharingSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireVisibilitySM () -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires - -instance ToSchema QuestionnaireCreateDTO where - declareNamedSchema = toSwagger questionnaire1Create diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDTO.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDTO.hs deleted file mode 100644 index c5cef66ea..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDTO.hs +++ /dev/null @@ -1,37 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireDTO where - -import Data.Time -import qualified Data.UUID as U -import GHC.Generics - -import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackageSimple -import Wizard.Api.Resource.Questionnaire.QuestionnairePermDTO -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireState - -data QuestionnaireDTO = QuestionnaireDTO - { uuid :: U.UUID - , name :: String - , description :: Maybe String - , visibility :: QuestionnaireVisibility - , sharing :: QuestionnaireSharing - , state :: QuestionnaireState - , knowledgeModelPackage :: KnowledgeModelPackageSimple - , permissions :: [QuestionnairePermDTO] - , isTemplate :: Bool - , createdAt :: UTCTime - , updatedAt :: UTCTime - } - deriving (Show, Generic) - -instance Eq QuestionnaireDTO where - a == b = - a.uuid == b.uuid - && a.name == b.name - && a.description == b.description - && a.visibility == b.visibility - && a.sharing == b.sharing - && a.state == b.state - && a.knowledgeModelPackage == b.knowledgeModelPackage - && a.permissions == b.permissions - && a.isTemplate == b.isTemplate diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailDTO.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailDTO.hs deleted file mode 100644 index 67e0f1bf9..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailDTO.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireDetailDTO where - -import qualified Data.UUID as U -import GHC.Generics - -import Wizard.Api.Resource.Questionnaire.QuestionnairePermDTO -import Wizard.Model.Questionnaire.Questionnaire - -data QuestionnaireDetailDTO = QuestionnaireDetailDTO - { uuid :: U.UUID - , name :: String - , sharing :: QuestionnaireSharing - , visibility :: QuestionnaireVisibility - , knowledgeModelPackageId :: String - , isTemplate :: Bool - , migrationUuid :: Maybe U.UUID - , permissions :: [QuestionnairePermDTO] - , fileCount :: Int - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailJM.hs deleted file mode 100644 index 1874f4cc1..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailJM.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireDetailJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailDTO -import Wizard.Api.Resource.Questionnaire.QuestionnairePermJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSharingJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireVisibilityJM () - -instance FromJSON QuestionnaireDetailDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireDetailDTO where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailPreviewJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailPreviewJM.hs deleted file mode 100644 index 1fd3dc486..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailPreviewJM.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireDetailPreviewJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Shared.DocumentTemplate.Api.Resource.DocumentTemplate.DocumentTemplateJM () -import Wizard.Api.Resource.Questionnaire.QuestionnairePermJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSharingJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireVisibilityJM () -import Wizard.Model.Questionnaire.QuestionnaireDetailPreview - -instance FromJSON QuestionnaireDetailPreview where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireDetailPreview where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailPreviewSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailPreviewSM.hs deleted file mode 100644 index 151c1e1de..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailPreviewSM.hs +++ /dev/null @@ -1,35 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireDetailPreviewSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Shared.DocumentTemplate.Api.Resource.DocumentTemplate.DocumentTemplateSM () -import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplateFormats -import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplates -import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplate -import qualified Shared.DocumentTemplate.Service.DocumentTemplate.DocumentTemplateMapper as DocumentTemplateMapper -import Shared.KnowledgeModel.Api.Resource.KnowledgeModel.KnowledgeModelSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailPreviewJM () -import Wizard.Api.Resource.Questionnaire.QuestionnairePermSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSharingSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireVisibilitySM () -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireDetailPreview - -instance ToSchema QuestionnaireDetailPreview where - declareNamedSchema = - toSwagger $ - QuestionnaireDetailPreview - { uuid = questionnaire1.uuid - , name = questionnaire1.name - , visibility = questionnaire1.visibility - , sharing = questionnaire1.sharing - , knowledgeModelPackageId = questionnaire1.knowledgeModelPackageId - , isTemplate = questionnaire1.isTemplate - , documentTemplateId = Just wizardDocumentTemplate.tId - , migrationUuid = Nothing - , permissions = [qtn1AlbertEditQtnPermDto] - , format = Just . DocumentTemplateMapper.toFormatSimple $ formatJson - , fileCount = 0 - } diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailQuestionnaireDTO.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailQuestionnaireDTO.hs deleted file mode 100644 index 126844b4f..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailQuestionnaireDTO.hs +++ /dev/null @@ -1,34 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireDetailQuestionnaireDTO where - -import qualified Data.Map.Strict as M -import qualified Data.UUID as U -import GHC.Generics - -import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel -import Wizard.Api.Resource.Questionnaire.QuestionnairePermDTO -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireFileSimple -import Wizard.Model.Questionnaire.QuestionnaireReply - -data QuestionnaireDetailQuestionnaireDTO = QuestionnaireDetailQuestionnaireDTO - { uuid :: U.UUID - , name :: String - , visibility :: QuestionnaireVisibility - , sharing :: QuestionnaireSharing - , knowledgeModelPackageId :: String - , selectedQuestionTagUuids :: [U.UUID] - , isTemplate :: Bool - , knowledgeModel :: KnowledgeModel - , replies :: M.Map String Reply - , labels :: M.Map String [U.UUID] - , phaseUuid :: Maybe U.UUID - , migrationUuid :: Maybe U.UUID - , permissions :: [QuestionnairePermDTO] - , files :: [QuestionnaireFileSimple] - , unresolvedCommentCounts :: M.Map String (M.Map U.UUID Int) - , resolvedCommentCounts :: M.Map String (M.Map U.UUID Int) - , questionnaireActionsAvailable :: Int - , questionnaireImportersAvailable :: Int - , fileCount :: Int - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailQuestionnaireJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailQuestionnaireJM.hs deleted file mode 100644 index 9b50720da..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailQuestionnaireJM.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireDetailQuestionnaireJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Shared.KnowledgeModel.Api.Resource.KnowledgeModel.KnowledgeModelJM () -import Wizard.Api.Resource.Questionnaire.File.QuestionnaireFileSimpleJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailQuestionnaireDTO -import Wizard.Api.Resource.Questionnaire.QuestionnairePermJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireReplyJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSharingJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireVisibilityJM () - -instance FromJSON QuestionnaireDetailQuestionnaireDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireDetailQuestionnaireDTO where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailQuestionnaireSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailQuestionnaireSM.hs deleted file mode 100644 index 2d04a4bf1..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailQuestionnaireSM.hs +++ /dev/null @@ -1,57 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireDetailQuestionnaireSM where - -import Data.Map.Strict as M -import Data.Swagger - -import Shared.Common.Util.Swagger -import Shared.Common.Util.Uuid -import Shared.KnowledgeModel.Api.Resource.KnowledgeModel.KnowledgeModelSM () -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.KnowledgeModels -import Wizard.Api.Resource.Questionnaire.File.QuestionnaireFileSimpleSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailQuestionnaireDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailQuestionnaireJM () -import Wizard.Api.Resource.Questionnaire.QuestionnairePermSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireReplySM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSharingSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireVisibilitySM () -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireLabels -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireReplies -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Model.Questionnaire.Questionnaire - -instance ToSchema QuestionnaireDetailQuestionnaireDTO where - declareNamedSchema = - toSwagger $ - QuestionnaireDetailQuestionnaireDTO - { uuid = questionnaire1.uuid - , name = questionnaire1.name - , visibility = questionnaire1.visibility - , sharing = questionnaire1.sharing - , knowledgeModelPackageId = questionnaire1.knowledgeModelPackageId - , selectedQuestionTagUuids = questionnaire1.selectedQuestionTagUuids - , isTemplate = questionnaire1.isTemplate - , knowledgeModel = km1 - , replies = fReplies - , labels = fLabels - , phaseUuid = Just . u' $ "4b376e49-1589-429b-9590-c654378f0bd5" - , migrationUuid = Nothing - , permissions = [qtn1AlbertEditQtnPermDto] - , files = [] - , unresolvedCommentCounts = - M.fromList - [ - ( "4f61fdfa-ce82-41b5-a1e6-218beaf41660.0dc58313-eb80-4f74-a8c1-347b644665d5" - , M.fromList [(u' "f1de85a9-7f22-4d0c-bc23-3315cc4c85d7", 4)] - ) - ] - , resolvedCommentCounts = - M.fromList - [ - ( "4f61fdfa-ce82-41b5-a1e6-218beaf41660.0dc58313-eb80-4f74-a8c1-347b644665d5" - , M.fromList [(u' "f1de85a9-7f22-4d0c-bc23-3315cc4c85d7", 2)] - ) - ] - , questionnaireActionsAvailable = 1 - , questionnaireImportersAvailable = 2 - , fileCount = 0 - } diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailReportDTO.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailReportDTO.hs deleted file mode 100644 index 39b9813c0..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailReportDTO.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireDetailReportDTO where - -import qualified Data.UUID as U -import GHC.Generics - -import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel -import Wizard.Api.Resource.Questionnaire.QuestionnairePermDTO -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Report.Report - -data QuestionnaireDetailReportDTO = QuestionnaireDetailReportDTO - { uuid :: U.UUID - , name :: String - , sharing :: QuestionnaireSharing - , visibility :: QuestionnaireVisibility - , knowledgeModelPackageId :: String - , isTemplate :: Bool - , migrationUuid :: Maybe U.UUID - , permissions :: [QuestionnairePermDTO] - , fileCount :: Int - , totalReport :: TotalReport - , chapterReports :: [ChapterReport] - , chapters :: [Chapter] - , metrics :: [Metric] - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailReportJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailReportJM.hs deleted file mode 100644 index 4414d2985..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailReportJM.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireDetailReportJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Shared.KnowledgeModel.Api.Resource.KnowledgeModel.KnowledgeModelJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailReportDTO -import Wizard.Api.Resource.Questionnaire.QuestionnairePermJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSharingJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireVisibilityJM () -import Wizard.Api.Resource.Report.ReportJM () - -instance FromJSON QuestionnaireDetailReportDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireDetailReportDTO where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailReportSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailReportSM.hs deleted file mode 100644 index a04efe87f..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailReportSM.hs +++ /dev/null @@ -1,35 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireDetailReportSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Shared.KnowledgeModel.Api.Resource.KnowledgeModel.KnowledgeModelSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailReportDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailReportJM () -import Wizard.Api.Resource.Questionnaire.QuestionnairePermSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSharingSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireVisibilitySM () -import Wizard.Api.Resource.Report.ReportSM () -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Database.Migration.Development.Report.Data.Reports -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Report.Report - -instance ToSchema QuestionnaireDetailReportDTO where - declareNamedSchema = - toSwagger $ - QuestionnaireDetailReportDTO - { uuid = questionnaire1.uuid - , name = questionnaire1.name - , visibility = questionnaire1.visibility - , sharing = questionnaire1.sharing - , knowledgeModelPackageId = questionnaire1.knowledgeModelPackageId - , isTemplate = questionnaire1.isTemplate - , migrationUuid = Nothing - , permissions = [qtn1AlbertEditQtnPermDto] - , fileCount = 0 - , totalReport = report1.totalReport - , chapterReports = report1.chapterReports - , chapters = report1.chapters - , metrics = report1.metrics - } diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailSM.hs deleted file mode 100644 index 38c57507a..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailSM.hs +++ /dev/null @@ -1,27 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireDetailSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailJM () -import Wizard.Api.Resource.Questionnaire.QuestionnairePermSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSharingSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireVisibilitySM () -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Model.Questionnaire.Questionnaire - -instance ToSchema QuestionnaireDetailDTO where - declareNamedSchema = - toSwagger $ - QuestionnaireDetailDTO - { uuid = questionnaire1.uuid - , name = questionnaire1.name - , visibility = questionnaire1.visibility - , sharing = questionnaire1.sharing - , knowledgeModelPackageId = questionnaire1.knowledgeModelPackageId - , isTemplate = questionnaire1.isTemplate - , migrationUuid = Nothing - , permissions = [qtn1AlbertEditQtnPermDto] - , fileCount = 0 - } diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailSettingsJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailSettingsJM.hs deleted file mode 100644 index 0cf03d5ed..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailSettingsJM.hs +++ /dev/null @@ -1,22 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireDetailSettingsJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Shared.DocumentTemplate.Api.Resource.DocumentTemplate.DocumentTemplateJM () -import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplateJM () -import Shared.KnowledgeModel.Api.Resource.KnowledgeModel.KnowledgeModelJM () -import Wizard.Api.Resource.DocumentTemplate.DocumentTemplateStateJM () -import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSimpleJM () -import Wizard.Api.Resource.Questionnaire.QuestionnairePermJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireReplyJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSharingJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireStateJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireVisibilityJM () -import Wizard.Model.Questionnaire.QuestionnaireDetailSettings - -instance FromJSON QuestionnaireDetailSettings where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireDetailSettings where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailSettingsSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailSettingsSM.hs deleted file mode 100644 index 9632e5d4f..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailSettingsSM.hs +++ /dev/null @@ -1,54 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireDetailSettingsSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Shared.Common.Util.Uuid -import Shared.DocumentTemplate.Api.Resource.DocumentTemplate.DocumentTemplateSM () -import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplateFormats -import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplates -import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplate -import qualified Shared.DocumentTemplate.Service.DocumentTemplate.DocumentTemplateMapper as DocumentTemplateMapper -import Shared.KnowledgeModel.Api.Resource.KnowledgeModel.KnowledgeModelSM () -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Tags -import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackage -import Wizard.Api.Resource.DocumentTemplate.DocumentTemplateStateSM () -import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSimpleSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireCommentThreadListSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailSettingsJM () -import Wizard.Api.Resource.Questionnaire.QuestionnairePermSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireReplySM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSharingSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireStateSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireVisibilitySM () -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionListSM () -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Model.DocumentTemplate.DocumentTemplateState -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireDetailSettings -import qualified Wizard.Service.KnowledgeModel.Package.KnowledgeModelPackageMapper as PackageMapper - -instance ToSchema QuestionnaireDetailSettings where - declareNamedSchema = - toSwagger $ - QuestionnaireDetailSettings - { uuid = questionnaire1.uuid - , name = questionnaire1.name - , description = questionnaire1.description - , visibility = questionnaire1.visibility - , sharing = questionnaire1.sharing - , selectedQuestionTagUuids = questionnaire1.selectedQuestionTagUuids - , isTemplate = questionnaire1.isTemplate - , migrationUuid = Nothing - , permissions = [qtn1AlbertEditQtnPermDto] - , projectTags = questionnaire1.projectTags - , knowledgeModelPackageId = netherlandsKmPackageV2.pId - , knowledgeModelPackage = PackageMapper.toSimpleDTO netherlandsKmPackageV2 - , knowledgeModelTags = [tagDataScience] - , documentTemplate = Just $ DocumentTemplateMapper.toDTO wizardDocumentTemplate wizardDocumentTemplateFormats - , documentTemplateState = Just DefaultDocumentTemplateState - , documentTemplatePhase = Just DraftDocumentTemplatePhase - , formatUuid = Just . u' $ "ae3b9e68-e09e-4ad7-b476-67ab5626e873" - , fileCount = 0 - } diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailWsDTO.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailWsDTO.hs deleted file mode 100644 index 4b72a3147..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailWsDTO.hs +++ /dev/null @@ -1,28 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireDetailWsDTO where - -import qualified Data.Map.Strict as M -import qualified Data.UUID as U -import GHC.Generics - -import Shared.DocumentTemplate.Api.Resource.DocumentTemplate.DocumentTemplateDTO -import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplateFormatSimple -import Wizard.Api.Resource.Questionnaire.QuestionnairePermDTO -import Wizard.Model.Questionnaire.Questionnaire - -data QuestionnaireDetailWsDTO = QuestionnaireDetailWsDTO - { name :: String - , description :: Maybe String - , visibility :: QuestionnaireVisibility - , sharing :: QuestionnaireSharing - , projectTags :: [String] - , permissions :: [QuestionnairePermDTO] - , documentTemplateId :: Maybe String - , documentTemplate :: Maybe DocumentTemplateDTO - , formatUuid :: Maybe U.UUID - , format :: Maybe DocumentTemplateFormatSimple - , isTemplate :: Bool - , labels :: M.Map String [U.UUID] - , unresolvedCommentCounts :: M.Map String (M.Map U.UUID Int) - , resolvedCommentCounts :: M.Map String (M.Map U.UUID Int) - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailWsJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailWsJM.hs deleted file mode 100644 index 515624e87..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailWsJM.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireDetailWsJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Shared.DocumentTemplate.Api.Resource.DocumentTemplate.DocumentTemplateJM () -import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplateJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailWsDTO -import Wizard.Api.Resource.Questionnaire.QuestionnairePermJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSharingJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireVisibilityJM () - -instance FromJSON QuestionnaireDetailWsDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireDetailWsDTO where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailWsSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailWsSM.hs deleted file mode 100644 index da015cb4b..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireDetailWsSM.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireDetailWsSM where - -import qualified Data.Map.Strict as M -import Data.Swagger - -import Shared.Common.Util.Swagger -import Shared.DocumentTemplate.Api.Resource.DocumentTemplate.DocumentTemplateSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailWsDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailWsJM () -import Wizard.Api.Resource.Questionnaire.QuestionnairePermSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSharingSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireVisibilitySM () -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Service.Questionnaire.QuestionnaireMapper - -instance ToSchema QuestionnaireDetailWsDTO where - declareNamedSchema = toSwagger (toDetailWsDTO questionnaire1 Nothing Nothing [] M.empty M.empty M.empty) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireJM.hs deleted file mode 100644 index 841059824..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireJM.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSimpleJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireDTO -import Wizard.Api.Resource.Questionnaire.QuestionnairePermJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireReportJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSharingJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireStateJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireVisibilityJM () -import Wizard.Api.Resource.User.UserJM () - -instance FromJSON QuestionnaireDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireDTO where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnairePermChangeDTO.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnairePermChangeDTO.hs deleted file mode 100644 index 0edcef1f2..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnairePermChangeDTO.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnairePermChangeDTO where - -import qualified Data.UUID as U -import GHC.Generics - -import Wizard.Model.Questionnaire.QuestionnairePerm - -data QuestionnairePermChangeDTO = QuestionnairePermChangeDTO - { memberType :: QuestionnairePermType - , memberUuid :: U.UUID - , perms :: [String] - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnairePermChangeJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnairePermChangeJM.hs deleted file mode 100644 index 47a653b77..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnairePermChangeJM.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnairePermChangeJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.Questionnaire.QuestionnairePermChangeDTO -import Wizard.Api.Resource.Questionnaire.QuestionnairePermJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSharingJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireVisibilityJM () - -instance FromJSON QuestionnairePermChangeDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnairePermChangeDTO where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnairePermChangeSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnairePermChangeSM.hs deleted file mode 100644 index eecbded0c..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnairePermChangeSM.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnairePermChangeSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Questionnaire.QuestionnairePermChangeDTO -import Wizard.Api.Resource.Questionnaire.QuestionnairePermChangeJM () -import Wizard.Api.Resource.Questionnaire.QuestionnairePermSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSharingSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireVisibilitySM () -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Service.Questionnaire.QuestionnaireMapper - -instance ToSchema QuestionnairePermChangeDTO where - declareNamedSchema = toSwagger (toQuestionnairePermChangeDTO qtn1AlbertEditQtnPerm) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnairePermDTO.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnairePermDTO.hs deleted file mode 100644 index 93dfb5e95..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnairePermDTO.hs +++ /dev/null @@ -1,29 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnairePermDTO where - -import qualified Data.UUID as U -import GHC.Generics -import GHC.Records - -import Wizard.Api.Resource.Acl.MemberDTO -import Wizard.Model.Questionnaire.QuestionnairePerm - -data QuestionnairePermDTO = QuestionnairePermDTO - { questionnaireUuid :: U.UUID - , member :: MemberDTO - , perms :: [String] - } - deriving (Generic, Eq, Show) - -instance Ord QuestionnairePermDTO where - compare a b = compare a.member.uuid b.member.uuid - -instance QuestionnairePermC QuestionnairePermDTO - -instance HasField "memberType" QuestionnairePermDTO QuestionnairePermType where - getField perm = - case perm.member of - UserMemberDTO {} -> UserQuestionnairePermType - UserGroupMemberDTO {} -> UserGroupQuestionnairePermType - -instance HasField "memberUuid" QuestionnairePermDTO U.UUID where - getField perm = perm.member.uuid diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnairePermJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnairePermJM.hs deleted file mode 100644 index a002ba98f..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnairePermJM.hs +++ /dev/null @@ -1,24 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnairePermJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.Acl.MemberJM () -import Wizard.Api.Resource.Questionnaire.QuestionnairePermDTO -import Wizard.Model.Questionnaire.QuestionnairePerm - -instance FromJSON QuestionnairePermType - -instance ToJSON QuestionnairePermType - -instance FromJSON QuestionnairePerm where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnairePerm where - toJSON = genericToJSON jsonOptions - -instance FromJSON QuestionnairePermDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnairePermDTO where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnairePermSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnairePermSM.hs deleted file mode 100644 index 9be77f0e7..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnairePermSM.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnairePermSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Acl.MemberSM () -import Wizard.Api.Resource.Questionnaire.QuestionnairePermDTO -import Wizard.Api.Resource.Questionnaire.QuestionnairePermJM () -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Database.Migration.Development.User.Data.Users -import Wizard.Model.Questionnaire.QuestionnairePerm -import Wizard.Service.Questionnaire.QuestionnaireMapper - -instance ToSchema QuestionnairePermType - -instance ToSchema QuestionnairePerm where - declareNamedSchema = toSwagger bioGroupEditQtnPerm - -instance ToSchema QuestionnairePermDTO where - declareNamedSchema = - toSwagger (toUserQuestionnairePermDTO bioGroupEditQtnPerm userAlbert) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireReplyJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireReplyJM.hs deleted file mode 100644 index c8bd8ff1c..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireReplyJM.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireReplyJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Model.Questionnaire.QuestionnaireReply -import WizardLib.Public.Api.Resource.User.UserSuggestionJM () - -instance ToJSON Reply where - toJSON = genericToJSON jsonOptions - -instance FromJSON Reply where - parseJSON = genericParseJSON jsonOptions - -instance FromJSON ReplyValue where - parseJSON = genericParseJSON (jsonOptionsWithTypeField "type") - -instance ToJSON ReplyValue where - toJSON = genericToJSON (jsonOptionsWithTypeField "type") - --- -------------------------------------------------------------------- -instance FromJSON IntegrationReplyType where - parseJSON = genericParseJSON (jsonOptionsWithTypeField "type") - -instance ToJSON IntegrationReplyType where - toJSON = genericToJSON (jsonOptionsWithTypeField "type") diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireReplySM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireReplySM.hs deleted file mode 100644 index f628ec3f8..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireReplySM.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireReplySM where - -import Data.Swagger - -import Shared.Common.Api.Resource.Common.AesonSM () -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Questionnaire.QuestionnaireReplyJM () -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireReplies -import Wizard.Model.Questionnaire.QuestionnaireReply -import WizardLib.Public.Api.Resource.User.UserSuggestionSM () - -instance ToSchema Reply where - declareNamedSchema = toSwagger (fst rQ1Updated) - -instance ToSchema ReplyValue where - declareNamedSchema = toSwagger ((snd rQ1).value) - -instance ToSchema IntegrationReplyType where - declareNamedSchema = toSwagger rQ10IntValue diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireReportDTO.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireReportDTO.hs deleted file mode 100644 index 71c2b5901..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireReportDTO.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireReportDTO where - -import GHC.Generics - -import Wizard.Model.Report.Report - -data QuestionnaireReportDTO = QuestionnaireReportDTO - { indications :: [Indication] - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireReportJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireReportJM.hs deleted file mode 100644 index 314fb66fa..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireReportJM.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireReportJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.Questionnaire.QuestionnaireReportDTO -import Wizard.Api.Resource.Report.ReportJM () - -instance FromJSON QuestionnaireReportDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireReportDTO where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireReportSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireReportSM.hs deleted file mode 100644 index f61a2dfbe..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireReportSM.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireReportSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Questionnaire.QuestionnaireReportDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireReportJM () -import Wizard.Api.Resource.Report.ReportSM () -import Wizard.Database.Migration.Development.Report.Data.Reports - -instance ToSchema QuestionnaireReportDTO where - declareNamedSchema = toSwagger questionnaireReport diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSM.hs deleted file mode 100644 index 8d0d034f8..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSM.hs +++ /dev/null @@ -1,22 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSimpleSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireJM () -import Wizard.Api.Resource.Questionnaire.QuestionnairePermSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireReportSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSharingSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireStateSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireVisibilitySM () -import Wizard.Api.Resource.User.UserSM () -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Model.Questionnaire.QuestionnaireState -import Wizard.Service.Questionnaire.QuestionnaireMapper - -instance ToSchema QuestionnaireDTO where - declareNamedSchema = - toSwagger (toDTO questionnaire1 germanyKmPackage QSDefault [qtn1AlbertEditQtnPermDto]) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSettingsChangeDTO.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSettingsChangeDTO.hs deleted file mode 100644 index e307fa2c5..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSettingsChangeDTO.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireSettingsChangeDTO where - -import qualified Data.UUID as U -import GHC.Generics - -data QuestionnaireSettingsChangeDTO = QuestionnaireSettingsChangeDTO - { name :: String - , description :: Maybe String - , projectTags :: [String] - , documentTemplateId :: Maybe String - , formatUuid :: Maybe U.UUID - , isTemplate :: Bool - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSettingsChangeJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSettingsChangeJM.hs deleted file mode 100644 index 1032b294b..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSettingsChangeJM.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireSettingsChangeJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.Questionnaire.QuestionnaireSettingsChangeDTO - -instance FromJSON QuestionnaireSettingsChangeDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireSettingsChangeDTO where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSettingsChangeSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSettingsChangeSM.hs deleted file mode 100644 index f0ad4cb9a..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSettingsChangeSM.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireSettingsChangeSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Questionnaire.QuestionnaireSettingsChangeDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireSettingsChangeJM () -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires - -instance ToSchema QuestionnaireSettingsChangeDTO where - declareNamedSchema = toSwagger questionnaire1SettingsChange diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireShareChangeDTO.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireShareChangeDTO.hs deleted file mode 100644 index a6ae9b0e3..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireShareChangeDTO.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireShareChangeDTO where - -import GHC.Generics - -import Wizard.Api.Resource.Questionnaire.QuestionnairePermChangeDTO -import Wizard.Model.Questionnaire.Questionnaire - -data QuestionnaireShareChangeDTO = QuestionnaireShareChangeDTO - { visibility :: QuestionnaireVisibility - , sharing :: QuestionnaireSharing - , permissions :: [QuestionnairePermChangeDTO] - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireShareChangeJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireShareChangeJM.hs deleted file mode 100644 index 594884746..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireShareChangeJM.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireShareChangeJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.Questionnaire.QuestionnairePermChangeJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireShareChangeDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireSharingJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireVisibilityJM () - -instance FromJSON QuestionnaireShareChangeDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireShareChangeDTO where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireShareChangeSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireShareChangeSM.hs deleted file mode 100644 index 6770546ce..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireShareChangeSM.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireShareChangeSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Questionnaire.QuestionnairePermChangeSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireShareChangeDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireShareChangeJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSharingSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireVisibilitySM () -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires - -instance ToSchema QuestionnaireShareChangeDTO where - declareNamedSchema = toSwagger questionnaire1EditedShareChange diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSharingJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSharingJM.hs deleted file mode 100644 index 076ff29b8..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSharingJM.hs +++ /dev/null @@ -1,9 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireSharingJM where - -import Data.Aeson - -import Wizard.Model.Questionnaire.Questionnaire - -instance FromJSON QuestionnaireSharing - -instance ToJSON QuestionnaireSharing diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSharingSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSharingSM.hs deleted file mode 100644 index cba5fb7fc..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSharingSM.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireSharingSM where - -import Data.Swagger - -import Wizard.Model.Questionnaire.Questionnaire - -instance ToSchema QuestionnaireSharing diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSimpleJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSimpleJM.hs deleted file mode 100644 index afd5a96a3..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSimpleJM.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireSimpleJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Model.Questionnaire.QuestionnaireSimple - -instance FromJSON QuestionnaireSimple where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireSimple where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSimpleSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSimpleSM.hs deleted file mode 100644 index 4df3383ff..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSimpleSM.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireSimpleSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Questionnaire.QuestionnaireSimpleJM () -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Model.Questionnaire.QuestionnaireSimple -import Wizard.Service.Questionnaire.QuestionnaireMapper - -instance ToSchema QuestionnaireSimple where - declareNamedSchema = toSwagger (toSimple questionnaire1) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireStateJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireStateJM.hs deleted file mode 100644 index 5eb62bb14..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireStateJM.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireStateJM where - -import Control.Monad -import Data.Aeson - -import Wizard.Model.Questionnaire.QuestionnaireState - -instance FromJSON QuestionnaireState where - parseJSON (String "Default") = return QSDefault - parseJSON (String "Migrating") = return QSMigrating - parseJSON (String "Outdated") = return QSOutdated - parseJSON _ = mzero - -instance ToJSON QuestionnaireState where - toJSON QSDefault = "Default" - toJSON QSMigrating = "Migrating" - toJSON QSOutdated = "Outdated" diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireStateSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireStateSM.hs deleted file mode 100644 index ef184c5bd..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireStateSM.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireStateSM where - -import Data.Swagger - -import Wizard.Model.Questionnaire.QuestionnaireState - -instance ToSchema QuestionnaireState diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSuggestionJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSuggestionJM.hs deleted file mode 100644 index e41315dd8..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSuggestionJM.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireSuggestionJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Model.Questionnaire.QuestionnaireSuggestion - -instance FromJSON QuestionnaireSuggestion where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireSuggestion where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSuggestionSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSuggestionSM.hs deleted file mode 100644 index e59ed6d87..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireSuggestionSM.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireSuggestionSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Questionnaire.QuestionnaireSuggestionJM () -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Model.Questionnaire.QuestionnaireSuggestion -import Wizard.Service.Questionnaire.QuestionnaireMapper - -instance ToSchema QuestionnaireSuggestion where - declareNamedSchema = toSwagger (toSuggestion questionnaire1) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireVisibilityJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireVisibilityJM.hs deleted file mode 100644 index 46447f302..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireVisibilityJM.hs +++ /dev/null @@ -1,9 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireVisibilityJM where - -import Data.Aeson - -import Wizard.Model.Questionnaire.Questionnaire - -instance FromJSON QuestionnaireVisibility - -instance ToJSON QuestionnaireVisibility diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireVisibilitySM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireVisibilitySM.hs deleted file mode 100644 index 0267e8b56..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/QuestionnaireVisibilitySM.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.QuestionnaireVisibilitySM where - -import Data.Swagger - -import Wizard.Model.Questionnaire.Questionnaire - -instance ToSchema QuestionnaireVisibility diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Version/QuestionnaireVersionChangeDTO.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/Version/QuestionnaireVersionChangeDTO.hs deleted file mode 100644 index acc16efba..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Version/QuestionnaireVersionChangeDTO.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionChangeDTO where - -import qualified Data.UUID as U -import GHC.Generics - -data QuestionnaireVersionChangeDTO = QuestionnaireVersionChangeDTO - { name :: String - , description :: Maybe String - , eventUuid :: U.UUID - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Version/QuestionnaireVersionChangeJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/Version/QuestionnaireVersionChangeJM.hs deleted file mode 100644 index e97a680b9..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Version/QuestionnaireVersionChangeJM.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionChangeJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionChangeDTO - -instance FromJSON QuestionnaireVersionChangeDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireVersionChangeDTO where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Version/QuestionnaireVersionChangeSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/Version/QuestionnaireVersionChangeSM.hs deleted file mode 100644 index ab4906b12..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Version/QuestionnaireVersionChangeSM.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionChangeSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionChangeDTO -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionChangeJM () -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireVersions -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires - -instance ToSchema QuestionnaireVersionChangeDTO where - declareNamedSchema = toSwagger (questionnaireVersion2ChangeDto questionnaire1Uuid) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Version/QuestionnaireVersionListJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/Version/QuestionnaireVersionListJM.hs deleted file mode 100644 index 7fac8a599..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Version/QuestionnaireVersionListJM.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionListJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Model.Questionnaire.QuestionnaireVersion -import Wizard.Model.Questionnaire.QuestionnaireVersionList -import WizardLib.Public.Api.Resource.User.UserSuggestionJM () - -instance FromJSON QuestionnaireVersion where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireVersion where - toJSON = genericToJSON jsonOptions - -instance FromJSON QuestionnaireVersionList where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireVersionList where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Version/QuestionnaireVersionListSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/Version/QuestionnaireVersionListSM.hs deleted file mode 100644 index 65a0d5c77..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Version/QuestionnaireVersionListSM.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionListSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionListJM () -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireVersions -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Model.Questionnaire.QuestionnaireVersionList -import WizardLib.Public.Api.Resource.User.UserSuggestionSM () - -instance ToSchema QuestionnaireVersionList where - declareNamedSchema = toSwagger (questionnaireVersion1List questionnaire1Uuid) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Version/QuestionnaireVersionRevertDTO.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/Version/QuestionnaireVersionRevertDTO.hs deleted file mode 100644 index a9617f421..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Version/QuestionnaireVersionRevertDTO.hs +++ /dev/null @@ -1,9 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionRevertDTO where - -import qualified Data.UUID as U -import GHC.Generics - -data QuestionnaireVersionRevertDTO = QuestionnaireVersionRevertDTO - { eventUuid :: U.UUID - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Version/QuestionnaireVersionRevertJM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/Version/QuestionnaireVersionRevertJM.hs deleted file mode 100644 index c4aff2716..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Version/QuestionnaireVersionRevertJM.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionRevertJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionRevertDTO - -instance FromJSON QuestionnaireVersionRevertDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireVersionRevertDTO where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Version/QuestionnaireVersionRevertSM.hs b/wizard-server/src/Wizard/Api/Resource/Questionnaire/Version/QuestionnaireVersionRevertSM.hs deleted file mode 100644 index cc6f66082..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Questionnaire/Version/QuestionnaireVersionRevertSM.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionRevertSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionRevertDTO -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionRevertJM () -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireVersions -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires - -instance ToSchema QuestionnaireVersionRevertDTO where - declareNamedSchema = toSwagger (questionnaireVersion1RevertDto questionnaire1Uuid) diff --git a/wizard-server/src/Wizard/Api/Resource/QuestionnaireAction/QuestionnaireActionChangeDTO.hs b/wizard-server/src/Wizard/Api/Resource/QuestionnaireAction/QuestionnaireActionChangeDTO.hs deleted file mode 100644 index 2f579de51..000000000 --- a/wizard-server/src/Wizard/Api/Resource/QuestionnaireAction/QuestionnaireActionChangeDTO.hs +++ /dev/null @@ -1,8 +0,0 @@ -module Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionChangeDTO where - -import GHC.Generics - -data QuestionnaireActionChangeDTO = QuestionnaireActionChangeDTO - { enabled :: Bool - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/QuestionnaireAction/QuestionnaireActionChangeJM.hs b/wizard-server/src/Wizard/Api/Resource/QuestionnaireAction/QuestionnaireActionChangeJM.hs deleted file mode 100644 index 39999bcc6..000000000 --- a/wizard-server/src/Wizard/Api/Resource/QuestionnaireAction/QuestionnaireActionChangeJM.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionChangeJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionChangeDTO - -instance FromJSON QuestionnaireActionChangeDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireActionChangeDTO where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/QuestionnaireAction/QuestionnaireActionChangeSM.hs b/wizard-server/src/Wizard/Api/Resource/QuestionnaireAction/QuestionnaireActionChangeSM.hs deleted file mode 100644 index 3cd5633be..000000000 --- a/wizard-server/src/Wizard/Api/Resource/QuestionnaireAction/QuestionnaireActionChangeSM.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionChangeSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionChangeDTO -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionChangeJM () -import Wizard.Database.Migration.Development.QuestionnaireAction.Data.QuestionnaireActions -import Wizard.Service.QuestionnaireAction.QuestionnaireActionMapper - -instance ToSchema QuestionnaireActionChangeDTO where - declareNamedSchema = toSwagger (toChangeDTO questionnaireActionFtp1) diff --git a/wizard-server/src/Wizard/Api/Resource/QuestionnaireAction/QuestionnaireActionDTO.hs b/wizard-server/src/Wizard/Api/Resource/QuestionnaireAction/QuestionnaireActionDTO.hs deleted file mode 100644 index 7a656d1a9..000000000 --- a/wizard-server/src/Wizard/Api/Resource/QuestionnaireAction/QuestionnaireActionDTO.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionDTO where - -import Data.Time -import GHC.Generics - -data QuestionnaireActionDTO = QuestionnaireActionDTO - { qaId :: String - , name :: String - , description :: String - , url :: String - , enabled :: Bool - , createdAt :: UTCTime - , updatedAt :: UTCTime - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/QuestionnaireAction/QuestionnaireActionJM.hs b/wizard-server/src/Wizard/Api/Resource/QuestionnaireAction/QuestionnaireActionJM.hs deleted file mode 100644 index 15c65c55b..000000000 --- a/wizard-server/src/Wizard/Api/Resource/QuestionnaireAction/QuestionnaireActionJM.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSimpleJM () -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionDTO -import Wizard.Api.Resource.User.UserJM () - -instance FromJSON QuestionnaireActionDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireActionDTO where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/QuestionnaireAction/QuestionnaireActionSM.hs b/wizard-server/src/Wizard/Api/Resource/QuestionnaireAction/QuestionnaireActionSM.hs deleted file mode 100644 index 366c141de..000000000 --- a/wizard-server/src/Wizard/Api/Resource/QuestionnaireAction/QuestionnaireActionSM.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionDTO -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionJM () -import Wizard.Database.Migration.Development.QuestionnaireAction.Data.QuestionnaireActions -import Wizard.Service.QuestionnaireAction.QuestionnaireActionMapper - -instance ToSchema QuestionnaireActionDTO where - declareNamedSchema = toSwagger (toDTO questionnaireActionFtp1) diff --git a/wizard-server/src/Wizard/Api/Resource/QuestionnaireImporter/QuestionnaireImporterChangeDTO.hs b/wizard-server/src/Wizard/Api/Resource/QuestionnaireImporter/QuestionnaireImporterChangeDTO.hs deleted file mode 100644 index 5df775649..000000000 --- a/wizard-server/src/Wizard/Api/Resource/QuestionnaireImporter/QuestionnaireImporterChangeDTO.hs +++ /dev/null @@ -1,8 +0,0 @@ -module Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterChangeDTO where - -import GHC.Generics - -data QuestionnaireImporterChangeDTO = QuestionnaireImporterChangeDTO - { enabled :: Bool - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/QuestionnaireImporter/QuestionnaireImporterChangeJM.hs b/wizard-server/src/Wizard/Api/Resource/QuestionnaireImporter/QuestionnaireImporterChangeJM.hs deleted file mode 100644 index b2e1e1510..000000000 --- a/wizard-server/src/Wizard/Api/Resource/QuestionnaireImporter/QuestionnaireImporterChangeJM.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterChangeJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterChangeDTO - -instance FromJSON QuestionnaireImporterChangeDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireImporterChangeDTO where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/QuestionnaireImporter/QuestionnaireImporterChangeSM.hs b/wizard-server/src/Wizard/Api/Resource/QuestionnaireImporter/QuestionnaireImporterChangeSM.hs deleted file mode 100644 index 97f3928f0..000000000 --- a/wizard-server/src/Wizard/Api/Resource/QuestionnaireImporter/QuestionnaireImporterChangeSM.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterChangeSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterChangeDTO -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterChangeJM () -import Wizard.Database.Migration.Development.QuestionnaireImporter.Data.QuestionnaireImporters -import Wizard.Service.QuestionnaireImporter.QuestionnaireImporterMapper - -instance ToSchema QuestionnaireImporterChangeDTO where - declareNamedSchema = toSwagger (toChangeDTO questionnaireImporterBio1) diff --git a/wizard-server/src/Wizard/Api/Resource/QuestionnaireImporter/QuestionnaireImporterDTO.hs b/wizard-server/src/Wizard/Api/Resource/QuestionnaireImporter/QuestionnaireImporterDTO.hs deleted file mode 100644 index b1b30d90a..000000000 --- a/wizard-server/src/Wizard/Api/Resource/QuestionnaireImporter/QuestionnaireImporterDTO.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterDTO where - -import Data.Time -import GHC.Generics - -data QuestionnaireImporterDTO = QuestionnaireImporterDTO - { qiId :: String - , name :: String - , description :: String - , url :: String - , enabled :: Bool - , createdAt :: UTCTime - , updatedAt :: UTCTime - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/QuestionnaireImporter/QuestionnaireImporterJM.hs b/wizard-server/src/Wizard/Api/Resource/QuestionnaireImporter/QuestionnaireImporterJM.hs deleted file mode 100644 index 3b892438f..000000000 --- a/wizard-server/src/Wizard/Api/Resource/QuestionnaireImporter/QuestionnaireImporterJM.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSimpleJM () -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterDTO -import Wizard.Api.Resource.User.UserJM () - -instance FromJSON QuestionnaireImporterDTO where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireImporterDTO where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/QuestionnaireImporter/QuestionnaireImporterSM.hs b/wizard-server/src/Wizard/Api/Resource/QuestionnaireImporter/QuestionnaireImporterSM.hs deleted file mode 100644 index dfcbd6cdc..000000000 --- a/wizard-server/src/Wizard/Api/Resource/QuestionnaireImporter/QuestionnaireImporterSM.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterDTO -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterJM () -import Wizard.Database.Migration.Development.QuestionnaireImporter.Data.QuestionnaireImporters -import Wizard.Service.QuestionnaireImporter.QuestionnaireImporterMapper - -instance ToSchema QuestionnaireImporterDTO where - declareNamedSchema = toSwagger (toDTO questionnaireImporterBio1) diff --git a/wizard-server/src/Wizard/Api/Resource/Tenant/Config/TenantConfigChangeDTO.hs b/wizard-server/src/Wizard/Api/Resource/Tenant/Config/TenantConfigChangeDTO.hs index c5c6f7bea..e8cd64667 100644 --- a/wizard-server/src/Wizard/Api/Resource/Tenant/Config/TenantConfigChangeDTO.hs +++ b/wizard-server/src/Wizard/Api/Resource/Tenant/Config/TenantConfigChangeDTO.hs @@ -19,7 +19,7 @@ data TenantConfigChangeDTO = TenantConfigChangeDTO , lookAndFeel :: TenantConfigLookAndFeelChangeDTO , registry :: TenantConfigRegistryChangeDTO , knowledgeModel :: TenantConfigKnowledgeModelChangeDTO - , questionnaire :: TenantConfigQuestionnaireChangeDTO + , project :: TenantConfigProjectChangeDTO , submission :: TenantConfigSubmissionChangeDTO , features :: TenantConfigFeaturesChangeDTO } @@ -91,13 +91,13 @@ data TenantConfigKnowledgeModelPublicChangeDTO = TenantConfigKnowledgeModelPubli } deriving (Generic, Show) -data TenantConfigQuestionnaireChangeDTO = TenantConfigQuestionnaireChangeDTO - { questionnaireVisibility :: TenantConfigQuestionnaireVisibility - , questionnaireSharing :: TenantConfigQuestionnaireSharing - , questionnaireCreation :: QuestionnaireCreation - , projectTagging :: TenantConfigQuestionnaireProjectTagging +data TenantConfigProjectChangeDTO = TenantConfigProjectChangeDTO + { projectVisibility :: TenantConfigProjectVisibility + , projectSharing :: TenantConfigProjectSharing + , projectCreation :: ProjectCreation + , projectTagging :: TenantConfigProjectProjectTagging , summaryReport :: SimpleFeature - , feedback :: TenantConfigQuestionnaireFeedback + , feedback :: TenantConfigProjectFeedback } deriving (Generic, Eq, Show) diff --git a/wizard-server/src/Wizard/Api/Resource/Tenant/Config/TenantConfigChangeJM.hs b/wizard-server/src/Wizard/Api/Resource/Tenant/Config/TenantConfigChangeJM.hs index 586c78063..e79828c68 100644 --- a/wizard-server/src/Wizard/Api/Resource/Tenant/Config/TenantConfigChangeJM.hs +++ b/wizard-server/src/Wizard/Api/Resource/Tenant/Config/TenantConfigChangeJM.hs @@ -68,10 +68,10 @@ instance FromJSON TenantConfigKnowledgeModelPublicChangeDTO where instance ToJSON TenantConfigKnowledgeModelPublicChangeDTO where toJSON = genericToJSON jsonOptions -instance FromJSON TenantConfigQuestionnaireChangeDTO where +instance FromJSON TenantConfigProjectChangeDTO where parseJSON = genericParseJSON jsonOptions -instance ToJSON TenantConfigQuestionnaireChangeDTO where +instance ToJSON TenantConfigProjectChangeDTO where toJSON = genericToJSON jsonOptions instance FromJSON TenantConfigSubmissionChangeDTO where diff --git a/wizard-server/src/Wizard/Api/Resource/Tenant/Config/TenantConfigChangeSM.hs b/wizard-server/src/Wizard/Api/Resource/Tenant/Config/TenantConfigChangeSM.hs index 3e396397f..baa9dd6f3 100644 --- a/wizard-server/src/Wizard/Api/Resource/Tenant/Config/TenantConfigChangeSM.hs +++ b/wizard-server/src/Wizard/Api/Resource/Tenant/Config/TenantConfigChangeSM.hs @@ -40,8 +40,8 @@ instance ToSchema TenantConfigKnowledgeModelChangeDTO where instance ToSchema TenantConfigKnowledgeModelPublicChangeDTO where declareNamedSchema = toSwagger defaultKnowledgeModelPublicChangeDto -instance ToSchema TenantConfigQuestionnaireChangeDTO where - declareNamedSchema = toSwagger defaultQuestionnaireChangeDto +instance ToSchema TenantConfigProjectChangeDTO where + declareNamedSchema = toSwagger defaultProjectChangeDto instance ToSchema TenantConfigSubmissionChangeDTO where declareNamedSchema = toSwagger defaultSubmission diff --git a/wizard-server/src/Wizard/Api/Resource/Tenant/Config/TenantConfigJM.hs b/wizard-server/src/Wizard/Api/Resource/Tenant/Config/TenantConfigJM.hs index c776e570e..787d81fb5 100644 --- a/wizard-server/src/Wizard/Api/Resource/Tenant/Config/TenantConfigJM.hs +++ b/wizard-server/src/Wizard/Api/Resource/Tenant/Config/TenantConfigJM.hs @@ -7,8 +7,8 @@ import Shared.Common.Util.Aeson import Shared.KnowledgeModel.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackagePatternJM () import Shared.OpenId.Api.Resource.OpenId.Client.Definition.OpenIdClientParameterJM () import Shared.OpenId.Api.Resource.OpenId.Client.Definition.OpenIdClientStyleJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSharingJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireVisibilityJM () +import Wizard.Api.Resource.Project.ProjectSharingJM () +import Wizard.Api.Resource.Project.ProjectVisibilityJM () import Wizard.Model.Tenant.Config.TenantConfig import WizardLib.Public.Api.Resource.Tenant.Config.TenantConfigJM () @@ -94,38 +94,38 @@ instance FromJSON TenantConfigKnowledgeModelPublicPackagePattern where instance ToJSON TenantConfigKnowledgeModelPublicPackagePattern where toJSON = genericToJSON jsonOptions -instance FromJSON TenantConfigQuestionnaire where +instance FromJSON TenantConfigProject where parseJSON = genericParseJSON jsonOptions -instance ToJSON TenantConfigQuestionnaire where +instance ToJSON TenantConfigProject where toJSON = genericToJSON jsonOptions -instance FromJSON TenantConfigQuestionnaireVisibility where +instance FromJSON TenantConfigProjectVisibility where parseJSON = genericParseJSON jsonOptions -instance ToJSON TenantConfigQuestionnaireVisibility where +instance ToJSON TenantConfigProjectVisibility where toJSON = genericToJSON jsonOptions -instance FromJSON TenantConfigQuestionnaireSharing where +instance FromJSON TenantConfigProjectSharing where parseJSON = genericParseJSON jsonOptions -instance ToJSON TenantConfigQuestionnaireSharing where +instance ToJSON TenantConfigProjectSharing where toJSON = genericToJSON jsonOptions -instance FromJSON QuestionnaireCreation +instance FromJSON ProjectCreation -instance ToJSON QuestionnaireCreation +instance ToJSON ProjectCreation -instance FromJSON TenantConfigQuestionnaireProjectTagging where +instance FromJSON TenantConfigProjectProjectTagging where parseJSON = genericParseJSON jsonOptions -instance ToJSON TenantConfigQuestionnaireProjectTagging where +instance ToJSON TenantConfigProjectProjectTagging where toJSON = genericToJSON jsonOptions -instance FromJSON TenantConfigQuestionnaireFeedback where +instance FromJSON TenantConfigProjectFeedback where parseJSON = genericParseJSON jsonOptions -instance ToJSON TenantConfigQuestionnaireFeedback where +instance ToJSON TenantConfigProjectFeedback where toJSON = genericToJSON jsonOptions instance FromJSON TenantConfigSubmission where diff --git a/wizard-server/src/Wizard/Api/Resource/Tenant/Config/TenantConfigSM.hs b/wizard-server/src/Wizard/Api/Resource/Tenant/Config/TenantConfigSM.hs index ac597f4d8..d118997f4 100644 --- a/wizard-server/src/Wizard/Api/Resource/Tenant/Config/TenantConfigSM.hs +++ b/wizard-server/src/Wizard/Api/Resource/Tenant/Config/TenantConfigSM.hs @@ -7,8 +7,8 @@ import Shared.Common.Util.Swagger import Shared.KnowledgeModel.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackagePatternSM () import Shared.OpenId.Api.Resource.OpenId.Client.Definition.OpenIdClientParameterSM () import Shared.OpenId.Api.Resource.OpenId.Client.Definition.OpenIdClientStyleSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireSharingSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireVisibilitySM () +import Wizard.Api.Resource.Project.ProjectSharingSM () +import Wizard.Api.Resource.Project.ProjectVisibilitySM () import Wizard.Api.Resource.Tenant.Config.TenantConfigJM () import Wizard.Database.Migration.Development.Tenant.Data.TenantConfigs import Wizard.Model.Tenant.Config.TenantConfig @@ -55,21 +55,21 @@ instance ToSchema TenantConfigKnowledgeModelPublic where instance ToSchema TenantConfigKnowledgeModelPublicPackagePattern where declareNamedSchema = toSwagger defaultKnowledgeModelPublicPackagePattern -instance ToSchema TenantConfigQuestionnaire where - declareNamedSchema = toSwagger defaultQuestionnaire +instance ToSchema TenantConfigProject where + declareNamedSchema = toSwagger defaultProject -instance ToSchema TenantConfigQuestionnaireVisibility where - declareNamedSchema = toSwagger defaultQuestionnaireVisibility +instance ToSchema TenantConfigProjectVisibility where + declareNamedSchema = toSwagger defaultProjectVisibility -instance ToSchema TenantConfigQuestionnaireSharing where - declareNamedSchema = toSwagger defaultQuestionnaireSharing +instance ToSchema TenantConfigProjectSharing where + declareNamedSchema = toSwagger defaultProjectSharing -instance ToSchema QuestionnaireCreation +instance ToSchema ProjectCreation -instance ToSchema TenantConfigQuestionnaireProjectTagging where - declareNamedSchema = toSwagger defaultQuestionnaireProjectTagging +instance ToSchema TenantConfigProjectProjectTagging where + declareNamedSchema = toSwagger defaultProjectProjectTagging -instance ToSchema TenantConfigQuestionnaireFeedback where +instance ToSchema TenantConfigProjectFeedback where declareNamedSchema = toSwagger defaultFeedback instance ToSchema TenantConfigSubmission where diff --git a/wizard-server/src/Wizard/Api/Resource/TypeHint/TypeHintRequestDTO.hs b/wizard-server/src/Wizard/Api/Resource/TypeHint/TypeHintRequestDTO.hs index 35dc8020c..1da75258a 100644 --- a/wizard-server/src/Wizard/Api/Resource/TypeHint/TypeHintRequestDTO.hs +++ b/wizard-server/src/Wizard/Api/Resource/TypeHint/TypeHintRequestDTO.hs @@ -16,7 +16,7 @@ data TypeHintLegacyRequestDTO = TypeHintLegacyRequestDTO data TypeHintRequestDTO = KnowledgeModelEditorIntegrationTypeHintRequest' KnowledgeModelEditorIntegrationTypeHintRequest | KnowledgeModelEditorQuestionTypeHintRequest' KnowledgeModelEditorQuestionTypeHintRequest - | QuestionnaireTypeHintRequest' QuestionnaireTypeHintRequest + | ProjectTypeHintRequest' ProjectTypeHintRequest deriving (Show, Eq, Generic) data KnowledgeModelEditorIntegrationTypeHintRequest = KnowledgeModelEditorIntegrationTypeHintRequest @@ -32,8 +32,8 @@ data KnowledgeModelEditorQuestionTypeHintRequest = KnowledgeModelEditorQuestionT } deriving (Show, Eq, Generic) -data QuestionnaireTypeHintRequest = QuestionnaireTypeHintRequest - { questionnaireUuid :: U.UUID +data ProjectTypeHintRequest = ProjectTypeHintRequest + { projectUuid :: U.UUID , questionUuid :: U.UUID , q :: String } diff --git a/wizard-server/src/Wizard/Api/Resource/TypeHint/TypeHintRequestJM.hs b/wizard-server/src/Wizard/Api/Resource/TypeHint/TypeHintRequestJM.hs index 1caa8762d..78f8ad1c0 100644 --- a/wizard-server/src/Wizard/Api/Resource/TypeHint/TypeHintRequestJM.hs +++ b/wizard-server/src/Wizard/Api/Resource/TypeHint/TypeHintRequestJM.hs @@ -22,7 +22,7 @@ instance FromJSON TypeHintRequestDTO where case requestType of "KnowledgeModelEditorIntegrationTypeHintRequest" -> parseJSON (Object o) >>= \v -> return (KnowledgeModelEditorIntegrationTypeHintRequest' v) "KnowledgeModelEditorQuestionTypeHintRequest" -> parseJSON (Object o) >>= \v -> return (KnowledgeModelEditorQuestionTypeHintRequest' v) - "QuestionnaireTypeHintRequest" -> parseJSON (Object o) >>= \v -> return (QuestionnaireTypeHintRequest' v) + "ProjectTypeHintRequest" -> parseJSON (Object o) >>= \v -> return (ProjectTypeHintRequest' v) _ -> fail "One of the integrations has unsupported requestType" parseJSON _ = mzero @@ -38,8 +38,8 @@ instance FromJSON KnowledgeModelEditorQuestionTypeHintRequest where instance ToJSON KnowledgeModelEditorQuestionTypeHintRequest where toJSON = genericToJSON (jsonOptionsWithTypeField "requestType") -instance FromJSON QuestionnaireTypeHintRequest where +instance FromJSON ProjectTypeHintRequest where parseJSON = genericParseJSON (jsonOptionsWithTypeField "requestType") -instance ToJSON QuestionnaireTypeHintRequest where +instance ToJSON ProjectTypeHintRequest where toJSON = genericToJSON (jsonOptionsWithTypeField "requestType") diff --git a/wizard-server/src/Wizard/Api/Resource/TypeHint/TypeHintRequestSM.hs b/wizard-server/src/Wizard/Api/Resource/TypeHint/TypeHintRequestSM.hs index d139679ec..083e2b84c 100644 --- a/wizard-server/src/Wizard/Api/Resource/TypeHint/TypeHintRequestSM.hs +++ b/wizard-server/src/Wizard/Api/Resource/TypeHint/TypeHintRequestSM.hs @@ -12,7 +12,7 @@ instance ToSchema TypeHintLegacyRequestDTO where declareNamedSchema = toSwagger typeHintLegacyRequest instance ToSchema TypeHintRequestDTO where - declareNamedSchema = toSwaggerWithType "requestType" questionnaireTypeHintRequest + declareNamedSchema = toSwaggerWithType "requestType" projectTypeHintRequest instance ToSchema KnowledgeModelEditorIntegrationTypeHintRequest where declareNamedSchema = toSwaggerWithType "requestType" kmEditorIntegrationTypeHintRequest' @@ -20,5 +20,5 @@ instance ToSchema KnowledgeModelEditorIntegrationTypeHintRequest where instance ToSchema KnowledgeModelEditorQuestionTypeHintRequest where declareNamedSchema = toSwaggerWithType "requestType" kmEditorQuestionTypeHintRequest' -instance ToSchema QuestionnaireTypeHintRequest where - declareNamedSchema = toSwaggerWithType "requestType" questionnaireTypeHintRequest' +instance ToSchema ProjectTypeHintRequest where + declareNamedSchema = toSwaggerWithType "requestType" projectTypeHintRequest' diff --git a/wizard-server/src/Wizard/Api/Resource/Websocket/KnowledgeModelEditorActionDTO.hs b/wizard-server/src/Wizard/Api/Resource/Websocket/KnowledgeModelEditorActionDTO.hs deleted file mode 100644 index 758e3309a..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Websocket/KnowledgeModelEditorActionDTO.hs +++ /dev/null @@ -1,28 +0,0 @@ -module Wizard.Api.Resource.Websocket.KnowledgeModelEditorActionDTO where - -import GHC.Generics - -import Wizard.Api.Resource.KnowledgeModel.Editor.Event.KnowledgeModelEditorWebSocketEventDTO -import Wizard.Api.Resource.KnowledgeModel.Editor.Event.SetRepliesDTO -import Wizard.Model.User.OnlineUserInfo - -data ClientKnowledgeModelEditorActionDTO - = SetContent_ClientKnowledgeModelEditorActionDTO - { scData :: KnowledgeModelEditorWebSocketEventDTO - } - | SetReplies_ClientKnowledgeModelEditorActionDTO - { srData :: SetRepliesDTO - } - deriving (Show, Generic) - -data ServerKnowledgeModelEditorActionDTO - = SetUserList_ServerKnowledgeModelEditorActionDTO - { seData :: [OnlineUserInfo] - } - | SetContent_ServerKnowledgeModelEditorActionDTO - { scData :: KnowledgeModelEditorWebSocketEventDTO - } - | SetReplies_ServerKnowledgeModelEditorActionDTO - { srData :: SetRepliesDTO - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Websocket/KnowledgeModelEditorActionJM.hs b/wizard-server/src/Wizard/Api/Resource/Websocket/KnowledgeModelEditorActionJM.hs deleted file mode 100644 index d41734f14..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Websocket/KnowledgeModelEditorActionJM.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Wizard.Api.Resource.Websocket.KnowledgeModelEditorActionJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.KnowledgeModel.Editor.Event.KnowledgeModelEditorWebSocketEventJM () -import Wizard.Api.Resource.KnowledgeModel.Editor.Event.SetRepliesJM () -import Wizard.Api.Resource.User.OnlineUserInfoJM () -import Wizard.Api.Resource.Websocket.KnowledgeModelEditorActionDTO - -instance FromJSON ClientKnowledgeModelEditorActionDTO where - parseJSON = genericParseJSON (jsonOptionsWithTypeField "type") - -instance ToJSON ClientKnowledgeModelEditorActionDTO where - toJSON = genericToJSON (jsonOptionsWithTypeField "type") - -instance FromJSON ServerKnowledgeModelEditorActionDTO where - parseJSON = genericParseJSON (jsonOptionsWithTypeField "type") - -instance ToJSON ServerKnowledgeModelEditorActionDTO where - toJSON = genericToJSON (jsonOptionsWithTypeField "type") diff --git a/wizard-server/src/Wizard/Api/Resource/Websocket/KnowledgeModelEditorActionSM.hs b/wizard-server/src/Wizard/Api/Resource/Websocket/KnowledgeModelEditorActionSM.hs deleted file mode 100644 index 38082dc55..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Websocket/KnowledgeModelEditorActionSM.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Wizard.Api.Resource.Websocket.KnowledgeModelEditorActionSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.KnowledgeModel.Editor.Event.KnowledgeModelEditorWebSocketEventSM () -import Wizard.Api.Resource.KnowledgeModel.Editor.Event.SetRepliesSM () -import Wizard.Api.Resource.User.OnlineUserInfoSM () -import Wizard.Api.Resource.Websocket.KnowledgeModelEditorActionDTO -import Wizard.Api.Resource.Websocket.KnowledgeModelEditorActionJM () -import Wizard.Database.Migration.Development.KnowledgeModel.Data.Editor.KnowledgeModelEditorActions - -instance ToSchema ClientKnowledgeModelEditorActionDTO where - declareNamedSchema = toSwagger ensureOnlineUserAction - -instance ToSchema ServerKnowledgeModelEditorActionDTO where - declareNamedSchema = toSwagger setUserListAction diff --git a/wizard-server/src/Wizard/Api/Resource/Websocket/KnowledgeModelEditorMessageDTO.hs b/wizard-server/src/Wizard/Api/Resource/Websocket/KnowledgeModelEditorMessageDTO.hs new file mode 100644 index 000000000..45e596a45 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Websocket/KnowledgeModelEditorMessageDTO.hs @@ -0,0 +1,28 @@ +module Wizard.Api.Resource.Websocket.KnowledgeModelEditorMessageDTO where + +import GHC.Generics + +import Wizard.Api.Resource.KnowledgeModel.Editor.Event.KnowledgeModelEditorWebSocketEventDTO +import Wizard.Api.Resource.KnowledgeModel.Editor.Event.SetRepliesDTO +import Wizard.Model.User.OnlineUserInfo + +data ClientKnowledgeModelEditorMessageDTO + = SetContent_ClientKnowledgeModelEditorMessageDTO + { scData :: KnowledgeModelEditorWebSocketEventDTO + } + | SetReplies_ClientKnowledgeModelEditorMessageDTO + { srData :: SetRepliesDTO + } + deriving (Show, Generic) + +data ServerKnowledgeModelEditorMessageDTO + = SetUserList_ServerKnowledgeModelEditorMessageDTO + { seData :: [OnlineUserInfo] + } + | SetContent_ServerKnowledgeModelEditorMessageDTO + { scData :: KnowledgeModelEditorWebSocketEventDTO + } + | SetReplies_ServerKnowledgeModelEditorMessageDTO + { srData :: SetRepliesDTO + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Websocket/KnowledgeModelEditorMessageJM.hs b/wizard-server/src/Wizard/Api/Resource/Websocket/KnowledgeModelEditorMessageJM.hs new file mode 100644 index 000000000..1ee1e41a0 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Websocket/KnowledgeModelEditorMessageJM.hs @@ -0,0 +1,21 @@ +module Wizard.Api.Resource.Websocket.KnowledgeModelEditorMessageJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.KnowledgeModel.Editor.Event.KnowledgeModelEditorWebSocketEventJM () +import Wizard.Api.Resource.KnowledgeModel.Editor.Event.SetRepliesJM () +import Wizard.Api.Resource.User.OnlineUserInfoJM () +import Wizard.Api.Resource.Websocket.KnowledgeModelEditorMessageDTO + +instance FromJSON ClientKnowledgeModelEditorMessageDTO where + parseJSON = genericParseJSON (jsonOptionsWithTypeField "type") + +instance ToJSON ClientKnowledgeModelEditorMessageDTO where + toJSON = genericToJSON (jsonOptionsWithTypeField "type") + +instance FromJSON ServerKnowledgeModelEditorMessageDTO where + parseJSON = genericParseJSON (jsonOptionsWithTypeField "type") + +instance ToJSON ServerKnowledgeModelEditorMessageDTO where + toJSON = genericToJSON (jsonOptionsWithTypeField "type") diff --git a/wizard-server/src/Wizard/Api/Resource/Websocket/KnowledgeModelEditorMessageSM.hs b/wizard-server/src/Wizard/Api/Resource/Websocket/KnowledgeModelEditorMessageSM.hs new file mode 100644 index 000000000..307e7a8b2 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Websocket/KnowledgeModelEditorMessageSM.hs @@ -0,0 +1,17 @@ +module Wizard.Api.Resource.Websocket.KnowledgeModelEditorMessageSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.KnowledgeModel.Editor.Event.KnowledgeModelEditorWebSocketEventSM () +import Wizard.Api.Resource.KnowledgeModel.Editor.Event.SetRepliesSM () +import Wizard.Api.Resource.User.OnlineUserInfoSM () +import Wizard.Api.Resource.Websocket.KnowledgeModelEditorMessageDTO +import Wizard.Api.Resource.Websocket.KnowledgeModelEditorMessageJM () +import Wizard.Database.Migration.Development.KnowledgeModel.Data.Editor.KnowledgeModelEditorMessages + +instance ToSchema ClientKnowledgeModelEditorMessageDTO where + declareNamedSchema = toSwagger ensureOnlineUserAction + +instance ToSchema ServerKnowledgeModelEditorMessageDTO where + declareNamedSchema = toSwagger setUserListAction diff --git a/wizard-server/src/Wizard/Api/Resource/Websocket/ProjectMessageDTO.hs b/wizard-server/src/Wizard/Api/Resource/Websocket/ProjectMessageDTO.hs new file mode 100644 index 000000000..4270a7bcc --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Websocket/ProjectMessageDTO.hs @@ -0,0 +1,29 @@ +module Wizard.Api.Resource.Websocket.ProjectMessageDTO where + +import GHC.Generics + +import Wizard.Api.Resource.Project.Detail.ProjectDetailWsDTO +import Wizard.Api.Resource.Project.Event.ProjectEventChangeDTO +import Wizard.Api.Resource.Project.Event.ProjectEventDTO +import Wizard.Model.Project.File.ProjectFileSimple +import Wizard.Model.User.OnlineUserInfo + +data ClientProjectMessageDTO = SetContent_ClientProjectMessageDTO + { aData :: ProjectEventChangeDTO + } + deriving (Show, Generic) + +data ServerProjectMessageDTO + = SetUserList_ServerProjectMessageDTO + { ouiData :: [OnlineUserInfo] + } + | SetContent_ServerProjectMessageDTO + { qeData :: ProjectEventDTO + } + | SetProject_ServerProjectMessageDTO + { sqData :: ProjectDetailWsDTO + } + | AddFile_ServerProjectMessageDTO + { adData :: ProjectFileSimple + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Websocket/ProjectMessageJM.hs b/wizard-server/src/Wizard/Api/Resource/Websocket/ProjectMessageJM.hs new file mode 100644 index 000000000..b90a28d9a --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Websocket/ProjectMessageJM.hs @@ -0,0 +1,24 @@ +module Wizard.Api.Resource.Websocket.ProjectMessageJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.Project.Detail.ProjectDetailWsJM () +import Wizard.Api.Resource.Project.Event.ProjectEventChangeJM () +import Wizard.Api.Resource.Project.Event.ProjectEventJM () +import Wizard.Api.Resource.Project.File.ProjectFileSimpleJM () +import Wizard.Api.Resource.Project.ProjectReplyJM () +import Wizard.Api.Resource.User.OnlineUserInfoJM () +import Wizard.Api.Resource.Websocket.ProjectMessageDTO + +instance FromJSON ClientProjectMessageDTO where + parseJSON = genericParseJSON (jsonOptionsWithTypeField "type") + +instance ToJSON ClientProjectMessageDTO where + toJSON = genericToJSON (jsonOptionsWithTypeField "type") + +instance FromJSON ServerProjectMessageDTO where + parseJSON = genericParseJSON (jsonOptionsWithTypeField "type") + +instance ToJSON ServerProjectMessageDTO where + toJSON = genericToJSON (jsonOptionsWithTypeField "type") diff --git a/wizard-server/src/Wizard/Api/Resource/Websocket/ProjectMessageSM.hs b/wizard-server/src/Wizard/Api/Resource/Websocket/ProjectMessageSM.hs new file mode 100644 index 000000000..261342acf --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Websocket/ProjectMessageSM.hs @@ -0,0 +1,20 @@ +module Wizard.Api.Resource.Websocket.ProjectMessageSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Project.Detail.ProjectDetailWsSM () +import Wizard.Api.Resource.Project.Event.ProjectEventChangeSM () +import Wizard.Api.Resource.Project.Event.ProjectEventSM () +import Wizard.Api.Resource.Project.File.ProjectFileSimpleSM () +import Wizard.Api.Resource.Project.ProjectReplySM () +import Wizard.Api.Resource.User.OnlineUserInfoSM () +import Wizard.Api.Resource.Websocket.ProjectMessageDTO +import Wizard.Api.Resource.Websocket.ProjectMessageJM () +import Wizard.Database.Migration.Development.Project.Data.ProjectMessages + +instance ToSchema ClientProjectMessageDTO where + declareNamedSchema = toSwagger ensureOnlineUserAction + +instance ToSchema ServerProjectMessageDTO where + declareNamedSchema = toSwagger setUserListAction diff --git a/wizard-server/src/Wizard/Api/Resource/Websocket/QuestionnaireActionDTO.hs b/wizard-server/src/Wizard/Api/Resource/Websocket/QuestionnaireActionDTO.hs deleted file mode 100644 index 3f2e30d87..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Websocket/QuestionnaireActionDTO.hs +++ /dev/null @@ -1,29 +0,0 @@ -module Wizard.Api.Resource.Websocket.QuestionnaireActionDTO where - -import GHC.Generics - -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventChangeDTO -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailWsDTO -import Wizard.Model.Questionnaire.QuestionnaireFileSimple -import Wizard.Model.User.OnlineUserInfo - -data ClientQuestionnaireActionDTO = SetContent_ClientQuestionnaireActionDTO - { aData :: QuestionnaireEventChangeDTO - } - deriving (Show, Generic) - -data ServerQuestionnaireActionDTO - = SetUserList_ServerQuestionnaireActionDTO - { ouiData :: [OnlineUserInfo] - } - | SetContent_ServerQuestionnaireActionDTO - { qeData :: QuestionnaireEventDTO - } - | SetQuestionnaire_ServerQuestionnaireActionDTO - { sqData :: QuestionnaireDetailWsDTO - } - | AddFile_ServerQuestionnaireActionDTO - { adData :: QuestionnaireFileSimple - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Websocket/QuestionnaireActionJM.hs b/wizard-server/src/Wizard/Api/Resource/Websocket/QuestionnaireActionJM.hs deleted file mode 100644 index a84f31dcf..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Websocket/QuestionnaireActionJM.hs +++ /dev/null @@ -1,24 +0,0 @@ -module Wizard.Api.Resource.Websocket.QuestionnaireActionJM where - -import Data.Aeson - -import Shared.Common.Util.Aeson -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventChangeJM () -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventJM () -import Wizard.Api.Resource.Questionnaire.File.QuestionnaireFileSimpleJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailWsJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireReplyJM () -import Wizard.Api.Resource.User.OnlineUserInfoJM () -import Wizard.Api.Resource.Websocket.QuestionnaireActionDTO - -instance FromJSON ClientQuestionnaireActionDTO where - parseJSON = genericParseJSON (jsonOptionsWithTypeField "type") - -instance ToJSON ClientQuestionnaireActionDTO where - toJSON = genericToJSON (jsonOptionsWithTypeField "type") - -instance FromJSON ServerQuestionnaireActionDTO where - parseJSON = genericParseJSON (jsonOptionsWithTypeField "type") - -instance ToJSON ServerQuestionnaireActionDTO where - toJSON = genericToJSON (jsonOptionsWithTypeField "type") diff --git a/wizard-server/src/Wizard/Api/Resource/Websocket/QuestionnaireActionSM.hs b/wizard-server/src/Wizard/Api/Resource/Websocket/QuestionnaireActionSM.hs deleted file mode 100644 index a201f8a2f..000000000 --- a/wizard-server/src/Wizard/Api/Resource/Websocket/QuestionnaireActionSM.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Wizard.Api.Resource.Websocket.QuestionnaireActionSM where - -import Data.Swagger - -import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventChangeSM () -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventSM () -import Wizard.Api.Resource.Questionnaire.File.QuestionnaireFileSimpleSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailWsSM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireReplySM () -import Wizard.Api.Resource.User.OnlineUserInfoSM () -import Wizard.Api.Resource.Websocket.QuestionnaireActionDTO -import Wizard.Api.Resource.Websocket.QuestionnaireActionJM () -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireActions - -instance ToSchema ClientQuestionnaireActionDTO where - declareNamedSchema = toSwagger ensureOnlineUserAction - -instance ToSchema ServerQuestionnaireActionDTO where - declareNamedSchema = toSwagger setUserListAction diff --git a/wizard-server/src/Wizard/Api/Resource/Websocket/WebsocketActionSM.hs b/wizard-server/src/Wizard/Api/Resource/Websocket/WebsocketActionSM.hs index f9c17ed33..2c7a7a72f 100644 --- a/wizard-server/src/Wizard/Api/Resource/Websocket/WebsocketActionSM.hs +++ b/wizard-server/src/Wizard/Api/Resource/Websocket/WebsocketActionSM.hs @@ -3,10 +3,10 @@ module Wizard.Api.Resource.Websocket.WebsocketActionSM where import Data.Swagger import Shared.Common.Util.Swagger -import Wizard.Api.Resource.Websocket.QuestionnaireActionSM () +import Wizard.Api.Resource.Websocket.ProjectMessageSM () import Wizard.Api.Resource.Websocket.WebsocketActionDTO import Wizard.Api.Resource.Websocket.WebsocketActionJM () -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireActions +import Wizard.Database.Migration.Development.Project.Data.ProjectMessages instance ToSchema resDto => ToSchema (Success_ServerActionDTO resDto) where declareNamedSchema = toSwagger (Success_ServerActionDTO ensureOnlineUserAction) diff --git a/wizard-server/src/Wizard/Cache/CacheFactory.hs b/wizard-server/src/Wizard/Cache/CacheFactory.hs index d5ff1d03b..c93ad2606 100644 --- a/wizard-server/src/Wizard/Cache/CacheFactory.hs +++ b/wizard-server/src/Wizard/Cache/CacheFactory.hs @@ -8,7 +8,7 @@ import Wizard.Model.Cache.ServerCache createServerCache serverConfig = do let [dataExp, websocketExp] = fmap (Just . fromHoursToTimeSpec) [serverConfig.cache.dataExpiration, serverConfig.cache.websocketExpiration] knowledgeModelEditorWebsocket <- C.newCache websocketExp - questionnaireWebsocket <- C.newCache websocketExp + projectWebsocket <- C.newCache websocketExp user <- C.newCache dataExp userToken <- C.newCache dataExp return ServerCache {..} diff --git a/wizard-server/src/Wizard/Cache/CacheUtil.hs b/wizard-server/src/Wizard/Cache/CacheUtil.hs index 5f443c9db..81b1239c2 100644 --- a/wizard-server/src/Wizard/Cache/CacheUtil.hs +++ b/wizard-server/src/Wizard/Cache/CacheUtil.hs @@ -16,7 +16,7 @@ purgeCache :: AppContextM () purgeCache = do cache <- asks cache liftIO . C.purge $ cache.knowledgeModelEditorWebsocket - liftIO . C.purge $ cache.questionnaireWebsocket + liftIO . C.purge $ cache.projectWebsocket liftIO . C.purge $ cache.user liftIO . C.purge $ cache.userToken @@ -24,7 +24,7 @@ purgeExpiredCache :: AppContextM () purgeExpiredCache = do cache <- asks cache liftIO . C.purgeExpired $ cache.knowledgeModelEditorWebsocket - liftIO . C.purgeExpired $ cache.questionnaireWebsocket + liftIO . C.purgeExpired $ cache.projectWebsocket liftIO . C.purgeExpired $ cache.user liftIO . C.purgeExpired $ cache.userToken diff --git a/wizard-server/src/Wizard/Cache/ProjectWebsocketCache.hs b/wizard-server/src/Wizard/Cache/ProjectWebsocketCache.hs new file mode 100644 index 000000000..e5b3108e2 --- /dev/null +++ b/wizard-server/src/Wizard/Cache/ProjectWebsocketCache.hs @@ -0,0 +1,83 @@ +module Wizard.Cache.ProjectWebsocketCache where + +import Control.Monad.Except (throwError) +import Control.Monad.Reader (asks, liftIO) +import qualified Data.Cache as C +import qualified Data.Hashable as H +import qualified Data.UUID as U + +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Shared.Common.Util.String +import Wizard.Model.Cache.ServerCache +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.ContextLenses () +import Wizard.Model.Websocket.WebsocketRecord +import WizardLib.Public.Service.Cache.Common + +cacheName = "Project Websocket" + +cacheKey connectionUuid = f' "connection: '%s'" [U.toString connectionUuid] + +addToCache :: WebsocketRecord -> AppContextM () +addToCache record = do + let key = cacheKey record.connectionUuid + logCacheAddBefore cacheName key + projectCache <- getCache + liftIO $ C.insert projectCache (H.hash key) record + logCacheAddAfter cacheName key + return () + +getAllFromCache :: AppContextM [WebsocketRecord] +getAllFromCache = do + projectCache <- getCache + records <- liftIO $ C.toList projectCache + return . fmap (\(_, v, _) -> v) $ records + +getFromCache :: U.UUID -> AppContextM (Maybe WebsocketRecord) +getFromCache connectionUuid = do + let key = cacheKey connectionUuid + logCacheGetBefore cacheName key + projectCache <- getCache + mValue <- liftIO $ C.lookup projectCache (H.hash key) + case mValue of + Just value -> do + logCacheGetFound cacheName key + return . Just $ value + Nothing -> do + logCacheGetMissed cacheName key + return Nothing + +updateCache :: WebsocketRecord -> AppContextM () +updateCache record = do + let key = cacheKey record.connectionUuid + logCacheModifyBefore cacheName key + projectCache <- getCache + liftIO $ C.insert projectCache (H.hash key) record + logCacheModifyAfter cacheName key + return () + +getFromCache' :: U.UUID -> AppContextM WebsocketRecord +getFromCache' connectionUuid = do + mRecord <- getFromCache connectionUuid + case mRecord of + Just record -> return record + Nothing -> throwError . NotExistsError . _ERROR_API__WEBSOCKET_RECORD_NOT_FOUND $ U.toString connectionUuid + +deleteFromCache :: U.UUID -> AppContextM () +deleteFromCache connectionUuid = do + let key = cacheKey connectionUuid + logCacheDeleteBefore cacheName key + projectCache <- getCache + liftIO $ C.delete projectCache (H.hash key) + logCacheDeleteFinished cacheName key + +countCache :: AppContextM Int +countCache = do + iCache <- getCache + liftIO $ C.size iCache + +getCache :: AppContextM (C.Cache Int WebsocketRecord) +getCache = do + cache <- asks cache + return $ cache.projectWebsocket diff --git a/wizard-server/src/Wizard/Cache/QuestionnaireWebsocketCache.hs b/wizard-server/src/Wizard/Cache/QuestionnaireWebsocketCache.hs deleted file mode 100644 index 1787b7652..000000000 --- a/wizard-server/src/Wizard/Cache/QuestionnaireWebsocketCache.hs +++ /dev/null @@ -1,83 +0,0 @@ -module Wizard.Cache.QuestionnaireWebsocketCache where - -import Control.Monad.Except (throwError) -import Control.Monad.Reader (asks, liftIO) -import qualified Data.Cache as C -import qualified Data.Hashable as H -import qualified Data.UUID as U - -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Shared.Common.Util.String -import Wizard.Model.Cache.ServerCache -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.ContextLenses () -import Wizard.Model.Websocket.WebsocketRecord -import WizardLib.Public.Service.Cache.Common - -cacheName = "Questionnaire Websocket" - -cacheKey connectionUuid = f' "connection: '%s'" [U.toString connectionUuid] - -addToCache :: WebsocketRecord -> AppContextM () -addToCache record = do - let key = cacheKey record.connectionUuid - logCacheAddBefore cacheName key - qwCache <- getCache - liftIO $ C.insert qwCache (H.hash key) record - logCacheAddAfter cacheName key - return () - -getAllFromCache :: AppContextM [WebsocketRecord] -getAllFromCache = do - qwCache <- getCache - records <- liftIO $ C.toList qwCache - return . fmap (\(_, v, _) -> v) $ records - -getFromCache :: U.UUID -> AppContextM (Maybe WebsocketRecord) -getFromCache connectionUuid = do - let key = cacheKey connectionUuid - logCacheGetBefore cacheName key - qwCache <- getCache - mValue <- liftIO $ C.lookup qwCache (H.hash key) - case mValue of - Just value -> do - logCacheGetFound cacheName key - return . Just $ value - Nothing -> do - logCacheGetMissed cacheName key - return Nothing - -updateCache :: WebsocketRecord -> AppContextM () -updateCache record = do - let key = cacheKey record.connectionUuid - logCacheModifyBefore cacheName key - qwCache <- getCache - liftIO $ C.insert qwCache (H.hash key) record - logCacheModifyAfter cacheName key - return () - -getFromCache' :: U.UUID -> AppContextM WebsocketRecord -getFromCache' connectionUuid = do - mRecord <- getFromCache connectionUuid - case mRecord of - Just record -> return record - Nothing -> throwError . NotExistsError . _ERROR_API__WEBSOCKET_RECORD_NOT_FOUND $ U.toString connectionUuid - -deleteFromCache :: U.UUID -> AppContextM () -deleteFromCache connectionUuid = do - let key = cacheKey connectionUuid - logCacheDeleteBefore cacheName key - qwCache <- getCache - liftIO $ C.delete qwCache (H.hash key) - logCacheDeleteFinished cacheName key - -countCache :: AppContextM Int -countCache = do - iCache <- getCache - liftIO $ C.size iCache - -getCache :: AppContextM (C.Cache Int WebsocketRecord) -getCache = do - cache <- asks cache - return $ cache.questionnaireWebsocket diff --git a/wizard-server/src/Wizard/Constant/Acl.hs b/wizard-server/src/Wizard/Constant/Acl.hs index 2a120cef4..585e38df8 100644 --- a/wizard-server/src/Wizard/Constant/Acl.hs +++ b/wizard-server/src/Wizard/Constant/Acl.hs @@ -6,11 +6,11 @@ module Wizard.Constant.Acl ( _KM_PUBLISH_PERM, _PM_READ_PERM, _PM_WRITE_PERM, - _QTN_PERM, - _QTN_FILE_PERM, - _QTN_TML_PERM, - _QTN_ACTION_PERM, - _QTN_IMPORTER_PERM, + _PRJ_PERM, + _PRJ_FILE_PERM, + _PRJ_TML_PERM, + _PRJ_ACTION_PERM, + _PRJ_IMPORTER_PERM, _SUBM_PERM, _DOC_TML_READ_PERM, _DOC_TML_WRITE_PERM, @@ -32,15 +32,15 @@ _PM_READ_PERM = "PM_READ_PERM" _PM_WRITE_PERM = "PM_WRITE_PERM" -_QTN_PERM = "QTN_PERM" +_PRJ_PERM = "PRJ_PERM" -_QTN_FILE_PERM = "QTN_FILE_PERM" +_PRJ_FILE_PERM = "PRJ_FILE_PERM" -_QTN_TML_PERM = "QTN_TML_PERM" +_PRJ_TML_PERM = "PRJ_TML_PERM" -_QTN_ACTION_PERM = "QTN_ACTION_PERM" +_PRJ_ACTION_PERM = "PRJ_ACTION_PERM" -_QTN_IMPORTER_PERM = "QTN_IMPORTER_PERM" +_PRJ_IMPORTER_PERM = "PRJ_IMPORTER_PERM" _SUBM_PERM = "SUBM_PERM" diff --git a/wizard-server/src/Wizard/Constant/ProjectAction.hs b/wizard-server/src/Wizard/Constant/ProjectAction.hs new file mode 100644 index 000000000..833b99c2c --- /dev/null +++ b/wizard-server/src/Wizard/Constant/ProjectAction.hs @@ -0,0 +1,4 @@ +module Wizard.Constant.ProjectAction where + +projectActionMetamodelVersion :: Int +projectActionMetamodelVersion = 1 diff --git a/wizard-server/src/Wizard/Constant/ProjectImporter.hs b/wizard-server/src/Wizard/Constant/ProjectImporter.hs new file mode 100644 index 000000000..fc342aab0 --- /dev/null +++ b/wizard-server/src/Wizard/Constant/ProjectImporter.hs @@ -0,0 +1,4 @@ +module Wizard.Constant.ProjectImporter where + +projectImporterMetamodelVersion :: Int +projectImporterMetamodelVersion = 1 diff --git a/wizard-server/src/Wizard/Constant/QuestionnaireAction.hs b/wizard-server/src/Wizard/Constant/QuestionnaireAction.hs deleted file mode 100644 index c193f8a60..000000000 --- a/wizard-server/src/Wizard/Constant/QuestionnaireAction.hs +++ /dev/null @@ -1,4 +0,0 @@ -module Wizard.Constant.QuestionnaireAction where - -questionnaireActionMetamodelVersion :: Int -questionnaireActionMetamodelVersion = 1 diff --git a/wizard-server/src/Wizard/Constant/QuestionnaireImporter.hs b/wizard-server/src/Wizard/Constant/QuestionnaireImporter.hs deleted file mode 100644 index 6ac14ddc8..000000000 --- a/wizard-server/src/Wizard/Constant/QuestionnaireImporter.hs +++ /dev/null @@ -1,4 +0,0 @@ -module Wizard.Constant.QuestionnaireImporter where - -questionnaireImporterMetamodelVersion :: Int -questionnaireImporterMetamodelVersion = 1 diff --git a/wizard-server/src/Wizard/Database/DAO/Document/DocumentDAO.hs b/wizard-server/src/Wizard/Database/DAO/Document/DocumentDAO.hs index efbd61241..01648edc1 100644 --- a/wizard-server/src/Wizard/Database/DAO/Document/DocumentDAO.hs +++ b/wizard-server/src/Wizard/Database/DAO/Document/DocumentDAO.hs @@ -39,23 +39,23 @@ findDocumentsForCurrentTenantFiltered params = do createFindEntitiesByFn entityName (tenantQueryUuid tenantUuid : params) findDocumentsPage :: Maybe U.UUID -> Maybe String -> Maybe String -> Maybe String -> Pageable -> [Sort] -> AppContextM (Page DocumentList) -findDocumentsPage mQtnUuid mQtnName mDocumentTemplateId mQuery pageable sort = do +findDocumentsPage mProjectUuid mProjectName mDocumentTemplateId mQuery pageable sort = do -- 1. Prepare variables do tenantUuid <- asks currentTenantUuid let (sizeI, pageI, skip, limit) = preparePaginationVariables pageable - let (questionnaireSelect, questionnaireSelectParams, questionnaireJoin, questionnaireCondition, questionnaireParam) = - case (mQtnUuid, mQtnName) of - (Just qtnUuid, Just qtnName) -> ("?, ", [qtnName], "", "AND doc.questionnaire_uuid = ?", [U.toString qtnUuid]) - (Just qtnUuid, Nothing) -> ("qtn.name, ", [], "LEFT JOIN questionnaire qtn ON qtn.uuid = doc.questionnaire_uuid", "AND doc.questionnaire_uuid = ?", [U.toString qtnUuid]) - _ -> ("qtn.name, ", [], "LEFT JOIN questionnaire qtn ON qtn.uuid = doc.questionnaire_uuid", "", []) + let (projectSelect, projectSelectParams, projectJoin, projectCondition, projectParam) = + case (mProjectUuid, mProjectName) of + (Just projectUuid, Just projectName) -> ("?, ", [projectName], "", "AND doc.project_uuid = ?", [U.toString projectUuid]) + (Just projectUuid, Nothing) -> ("project.name, ", [], "LEFT JOIN project ON project.uuid = doc.project_uuid", "AND doc.project_uuid = ?", [U.toString projectUuid]) + _ -> ("project.name, ", [], "LEFT JOIN project ON project.uuid = doc.project_uuid", "", []) let (documentTemplateIdCondition, documentTemplateIdParam) = case mDocumentTemplateId of Just documentTemplateId -> (" AND doc.document_template_id = ? ", [documentTemplateId]) Nothing -> ("", []) - let condition = "WHERE doc.tenant_uuid = ? AND doc.name ~* ? AND doc.durability = 'PersistentDocumentDurability' " ++ questionnaireCondition ++ documentTemplateIdCondition - let baseParams = [U.toString tenantUuid, regexM mQuery] ++ questionnaireParam ++ documentTemplateIdParam - let params = questionnaireSelectParams ++ baseParams + let condition = "WHERE doc.tenant_uuid = ? AND doc.name ~* ? AND doc.durability = 'PersistentDocumentDurability' " ++ projectCondition ++ documentTemplateIdCondition + let baseParams = [U.toString tenantUuid, regexM mQuery] ++ projectParam ++ documentTemplateIdParam + let params = projectSelectParams ++ baseParams -- 2. Get total count count <- createCountByFn "document doc" condition baseParams -- 3. Get entities @@ -65,10 +65,10 @@ findDocumentsPage mQtnUuid mQtnName mDocumentTemplateId mQuery pageable sort = d "SELECT doc.uuid, \ \ doc.name, \ \ doc.state, \ - \ doc.questionnaire_uuid, \ - \ ${questionnaireSelect} \ - \ doc.questionnaire_event_uuid, \ - \ qtn_version.name, \ + \ doc.project_uuid, \ + \ ${projectSelect} \ + \ doc.project_event_uuid, \ + \ project_version.name, \ \ doc_tml.id, \ \ doc_tml.name, \ \ ( \ @@ -84,15 +84,15 @@ findDocumentsPage mQtnUuid mQtnName mDocumentTemplateId mQuery pageable sort = d \ doc.created_by, \ \ doc.created_at \ \FROM document doc \ - \${questionnaireJoin} \ + \${projectJoin} \ \LEFT JOIN document_template doc_tml ON doc_tml.id = doc.document_template_id AND doc_tml.tenant_uuid = doc.tenant_uuid \ - \LEFT JOIN questionnaire_version qtn_version ON qtn_version.event_uuid = doc.questionnaire_event_uuid AND qtn_version.tenant_uuid = doc.tenant_uuid \ + \LEFT JOIN project_version ON project_version.event_uuid = doc.project_event_uuid AND project_version.tenant_uuid = doc.tenant_uuid \ \${condition} \ \${sort} \ \OFFSET ${offset} \ \LIMIT ${limit}" - [ ("questionnaireSelect", questionnaireSelect) - , ("questionnaireJoin", questionnaireJoin) + [ ("projectSelect", projectSelect) + , ("projectJoin", projectJoin) , ("condition", condition) , ("sort", mapSortWithPrefix "doc" sort) , ("offset", show skip) @@ -156,11 +156,11 @@ deleteDocumentByUuid uuid = do deleteDocumentByUuidAndTenantUuid :: U.UUID -> U.UUID -> AppContextM Int64 deleteDocumentByUuidAndTenantUuid uuid tenantUuid = createDeleteEntityByFn entityName [tenantQueryUuid tenantUuid, ("uuid", U.toString uuid)] -deleteTemporalDocumentsByQuestionnaireUuid :: U.UUID -> AppContextM Int64 -deleteTemporalDocumentsByQuestionnaireUuid qtnUuid = do +deleteTemporalDocumentsByProjectUuid :: U.UUID -> AppContextM Int64 +deleteTemporalDocumentsByProjectUuid projectUuid = do tenantUuid <- asks currentTenantUuid deleteDocumentsFiltered - [tenantQueryUuid tenantUuid, ("questionnaire_uuid", U.toString qtnUuid), ("durability", "TemporallyDocumentDurability")] + [tenantQueryUuid tenantUuid, ("project_uuid", U.toString projectUuid), ("durability", "TemporallyDocumentDurability")] deleteTemporalDocumentsByDocumentTemplateId :: String -> AppContextM Int64 deleteTemporalDocumentsByDocumentTemplateId documentTemplateId = do diff --git a/wizard-server/src/Wizard/Database/DAO/DocumentTemplate/DocumentTemplateDraftDataDAO.hs b/wizard-server/src/Wizard/Database/DAO/DocumentTemplate/DocumentTemplateDraftDataDAO.hs index 6028e03d2..c47a43310 100644 --- a/wizard-server/src/Wizard/Database/DAO/DocumentTemplate/DocumentTemplateDraftDataDAO.hs +++ b/wizard-server/src/Wizard/Database/DAO/DocumentTemplate/DocumentTemplateDraftDataDAO.hs @@ -28,7 +28,7 @@ updateDraftDataById draftData = do tenantUuid <- asks currentTenantUuid let sql = fromString - "UPDATE document_template_draft_data SET document_template_id = ?, questionnaire_uuid = ?, format_uuid = ?, tenant_uuid = ?, created_at = ?, updated_at = ?, knowledge_model_editor_uuid = ? WHERE tenant_uuid = ? AND document_template_id = ?" + "UPDATE document_template_draft_data SET document_template_id = ?, project_uuid = ?, format_uuid = ?, tenant_uuid = ?, created_at = ?, updated_at = ?, knowledge_model_editor_uuid = ? WHERE tenant_uuid = ? AND document_template_id = ?" let params = toRow draftData ++ [toField draftData.tenantUuid, toField draftData.documentTemplateId] logQuery sql params let action conn = execute conn sql params diff --git a/wizard-server/src/Wizard/Database/DAO/KnowledgeModel/KnowledgeModelMigrationDAO.hs b/wizard-server/src/Wizard/Database/DAO/KnowledgeModel/KnowledgeModelMigrationDAO.hs index 1e8408aaf..6b3f549d9 100644 --- a/wizard-server/src/Wizard/Database/DAO/KnowledgeModel/KnowledgeModelMigrationDAO.hs +++ b/wizard-server/src/Wizard/Database/DAO/KnowledgeModel/KnowledgeModelMigrationDAO.hs @@ -16,26 +16,26 @@ import Wizard.Model.KnowledgeModel.Migration.KnowledgeModelMigration entityName = "knowledge_model_migration" -findMigratorStates :: AppContextM [KnowledgeModelMigration] -findMigratorStates = do +findKnowledgeModelMigrations :: AppContextM [KnowledgeModelMigration] +findKnowledgeModelMigrations = do tenantUuid <- asks currentTenantUuid createFindEntitiesByFn entityName [tenantQueryUuid tenantUuid] -findMigratorStateByEditorUuid :: U.UUID -> AppContextM KnowledgeModelMigration -findMigratorStateByEditorUuid editorUuid = do +findKnowledgeModelMigrationByEditorUuid :: U.UUID -> AppContextM KnowledgeModelMigration +findKnowledgeModelMigrationByEditorUuid editorUuid = do tenantUuid <- asks currentTenantUuid createFindEntityByFn entityName [tenantQueryUuid tenantUuid, ("editor_uuid", U.toString editorUuid)] -findMigratorStateByEditorUuid' :: U.UUID -> AppContextM (Maybe KnowledgeModelMigration) -findMigratorStateByEditorUuid' editorUuid = do +findKnowledgeModelMigrationByEditorUuid' :: U.UUID -> AppContextM (Maybe KnowledgeModelMigration) +findKnowledgeModelMigrationByEditorUuid' editorUuid = do tenantUuid <- asks currentTenantUuid createFindEntityByFn' entityName [tenantQueryUuid tenantUuid, ("editor_uuid", U.toString editorUuid)] -insertMigratorState :: KnowledgeModelMigration -> AppContextM Int64 -insertMigratorState = createInsertFn entityName +insertKnowledgeModelMigration :: KnowledgeModelMigration -> AppContextM Int64 +insertKnowledgeModelMigration = createInsertFn entityName -updateMigratorState :: KnowledgeModelMigration -> AppContextM Int64 -updateMigratorState migration = do +updateKnowledgeModelMigration :: KnowledgeModelMigration -> AppContextM Int64 +updateKnowledgeModelMigration migration = do let sql = fromString "UPDATE knowledge_model_migration SET editor_uuid = ?, metamodel_version = ?, state = ?, editor_previous_package_id = ?, target_package_id = ?, editor_previous_package_events = ?, target_package_events = ?, result_events = ?, current_knowledge_model = ?, tenant_uuid = ?, created_at = ? WHERE tenant_uuid = ? AND editor_uuid = ?" @@ -44,10 +44,10 @@ updateMigratorState migration = do let action conn = execute conn sql params runDB action -deleteMigratorStates :: AppContextM Int64 -deleteMigratorStates = createDeleteEntitiesFn entityName +deleteKnowledgeModelMigrations :: AppContextM Int64 +deleteKnowledgeModelMigrations = createDeleteEntitiesFn entityName -deleteMigratorStateByEditorUuid :: U.UUID -> AppContextM Int64 -deleteMigratorStateByEditorUuid editorUuid = do +deleteKnowledgeModelMigrationByEditorUuid :: U.UUID -> AppContextM Int64 +deleteKnowledgeModelMigrationByEditorUuid editorUuid = do tenantUuid <- asks currentTenantUuid createDeleteEntityByFn entityName [tenantQueryUuid tenantUuid, ("editor_uuid", U.toString editorUuid)] diff --git a/wizard-server/src/Wizard/Database/DAO/Project/ProjectActionDAO.hs b/wizard-server/src/Wizard/Database/DAO/Project/ProjectActionDAO.hs new file mode 100644 index 000000000..2c5b3cb81 --- /dev/null +++ b/wizard-server/src/Wizard/Database/DAO/Project/ProjectActionDAO.hs @@ -0,0 +1,169 @@ +module Wizard.Database.DAO.Project.ProjectActionDAO where + +import Control.Monad.Reader (asks) +import Data.String (fromString) +import Data.Time +import qualified Data.UUID as U +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.ToField +import Database.PostgreSQL.Simple.ToRow +import GHC.Int + +import Shared.Common.Database.DAO.Common hiding (runInTransaction) +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.PageMetadata +import Shared.Common.Model.Common.Pageable +import Shared.Common.Model.Common.Sort +import Shared.Common.Util.Logger +import Wizard.Database.Mapping.Project.Action.ProjectAction () +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.ContextLenses () +import Wizard.Model.Project.Action.ProjectAction + +entityName = "project_action" + +pageLabel = "projectActions" + +findProjectActionsPage + :: Maybe String + -> Maybe String + -> Maybe String + -> Maybe Bool + -> Pageable + -> [Sort] + -> AppContextM (Page ProjectAction) +findProjectActionsPage mOrganizationId mImporterId mQuery mEnabled pageable sort = + createFindEntitiesGroupByCoordinatePageableQuerySortFn + entityName + pageLabel + pageable + sort + "*" + "action_id" + mQuery + mEnabled + mOrganizationId + mImporterId + +findProjectActionById :: String -> AppContextM ProjectAction +findProjectActionById paId = do + tenantUuid <- asks currentTenantUuid + createFindEntityByFn entityName [tenantQueryUuid tenantUuid, ("id", paId)] + +insertProjectAction :: ProjectAction -> AppContextM Int64 +insertProjectAction = createInsertFn entityName + +updateProjectActionById :: ProjectAction -> AppContextM Int64 +updateProjectActionById importer = do + tenantUuid <- asks currentTenantUuid + let sql = + fromString + "UPDATE project_action SET id = ?, name = ?, organization_id = ?, action_id = ?, version = ?, metamodel_version = ?, description = ?, readme = ?, license = ?, allowed_packages = ?, url = ?, config = ?, enabled = ?, tenant_uuid = ?, created_at = ?, updated_at = ? WHERE tenant_uuid = ? AND id = ?" + let params = toRow importer ++ [toField tenantUuid, toField importer.paId] + logQuery sql params + let action conn = execute conn sql params + runDB action + +updateProjectActionPasswordById :: String -> Bool -> UTCTime -> AppContextM Int64 +updateProjectActionPasswordById paId enabled uUpdatedAt = do + tenantUuid <- asks currentTenantUuid + let sql = fromString "UPDATE project_action SET enabled = ?, updated_at = ? WHERE tenant_uuid = ? AND uuid = ?" + let params = [toField enabled, toField uUpdatedAt, toField tenantUuid, toField paId] + logQuery sql params + let action conn = execute conn sql params + runDB action + +deleteProjectActions :: AppContextM Int64 +deleteProjectActions = createDeleteEntitiesFn entityName + +deleteProjectActionById :: String -> AppContextM Int64 +deleteProjectActionById paId = do + tenantUuid <- asks currentTenantUuid + createDeleteEntityByFn entityName [tenantQueryUuid tenantUuid, ("id", paId)] + +-- -------------------------------- +-- PRIVATE +-- -------------------------------- +createFindEntitiesGroupByCoordinatePageableQuerySortFn entityName pageLabel pageable sort fields entityId mQuery mEnabled mOrganizationId mEntityId = + -- 1. Prepare variables + do + tenantUuid <- asks currentTenantUuid + let (sizeI, pageI, skip, limit) = preparePaginationVariables pageable + let enabledCondition = + case mEnabled of + Just True -> "enabled = true AND" + Just False -> "enabled = false AND" + _ -> "" + -- 2. Get total count + count <- createCountGroupByCoordinateFn entityName entityId mQuery enabledCondition mOrganizationId mEntityId + -- 3. Get entities + let sql = + f' + "SELECT %s \ + \FROM %s \ + \WHERE tenant_uuid = ? AND id IN ( \ + \ SELECT CONCAT(organization_id, ':', %s, ':', (max(string_to_array(version, '.')::int[]))[1] || '.' || \ + \ (max(string_to_array(version, '.')::int[]))[2] || '.' || \ + \ (max(string_to_array(version, '.')::int[]))[3]) \ + \ FROM %s \ + \ WHERE %s tenant_uuid = ? AND (name ~* ? OR id ~* ?) %s \ + \ GROUP BY organization_id, %s \ + \) \ + \%s \ + \offset %s \ + \limit %s" + [ fields + , entityName + , entityId + , entityName + , enabledCondition + , mapToDBCoordinatesSql entityName entityId mOrganizationId mEntityId + , entityId + , mapSort sort + , show skip + , show sizeI + ] + logInfo _CMP_DATABASE sql + let action conn = + query + conn + (fromString sql) + ( U.toString tenantUuid + : U.toString tenantUuid + : regexM mQuery + : regexM mQuery + : mapToDBCoordinatesParams mOrganizationId mEntityId + ) + entities <- runDB action + -- 4. Constructor response + let metadata = + PageMetadata + { size = sizeI + , totalElements = count + , totalPages = computeTotalPage count sizeI + , number = pageI + } + return $ Page pageLabel metadata entities + +createCountGroupByCoordinateFn + :: String -> String -> Maybe String -> String -> Maybe String -> Maybe String -> AppContextM Int +createCountGroupByCoordinateFn entityName entityId mQuery enabledCondition mOrganizationId mEntityId = do + tenantUuid <- asks currentTenantUuid + let sql = + f' + "SELECT COUNT(*) \ + \ FROM (SELECT COUNT(*) \ + \ FROM %s \ + \ WHERE %s tenant_uuid = ? AND (name ~* ? OR id ~* ?) %s \ + \ GROUP BY organization_id, %s) p" + [entityName, enabledCondition, mapToDBCoordinatesSql entityName entityId mOrganizationId mEntityId, entityId] + logInfo _CMP_DATABASE sql + let action conn = + query + conn + (fromString sql) + (U.toString tenantUuid : regexM mQuery : regexM mQuery : mapToDBCoordinatesParams mOrganizationId mEntityId) + result <- runDB action + case result of + [count] -> return . fromOnly $ count + _ -> return 0 diff --git a/wizard-server/src/Wizard/Database/DAO/Project/ProjectCommentDAO.hs b/wizard-server/src/Wizard/Database/DAO/Project/ProjectCommentDAO.hs new file mode 100644 index 000000000..7bbacac77 --- /dev/null +++ b/wizard-server/src/Wizard/Database/DAO/Project/ProjectCommentDAO.hs @@ -0,0 +1,87 @@ +module Wizard.Database.DAO.Project.ProjectCommentDAO where + +import Control.Monad.Reader (asks, liftIO) +import Data.String +import Data.Time +import qualified Data.UUID as U +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.ToField +import Database.PostgreSQL.Simple.ToRow +import GHC.Int + +import Shared.Common.Util.String +import Wizard.Database.DAO.Common +import Wizard.Database.Mapping.Project.Comment.ProjectComment () +import Wizard.Database.Mapping.Project.Comment.ProjectCommentThread () +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.ContextLenses () +import Wizard.Model.Project.Comment.ProjectComment + +entityName = "project_comment" + +insertProjectComment :: ProjectComment -> AppContextM Int64 +insertProjectComment = createInsertFn entityName + +insertProjectThreadAndComment :: ProjectCommentThread -> ProjectComment -> AppContextM Int64 +insertProjectThreadAndComment thread comment = do + let sql = + fromString $ + f' + "BEGIN TRANSACTION; \ + \INSERT INTO %s VALUES (%s); \ + \INSERT INTO %s VALUES (%s); \ + \COMMIT;" + ["project_comment_thread", generateQuestionMarks' thread, entityName, generateQuestionMarks' comment] + let params = toRow thread ++ toRow comment + logInsertAndUpdate sql params + let action conn = execute conn sql params + runDB action + +insertProjectThreadAndComment' :: ProjectCommentThread -> ProjectComment -> AppContextM Int64 +insertProjectThreadAndComment' thread comment = do + let sql = + fromString $ + f' + "INSERT INTO %s VALUES (%s); \ + \INSERT INTO %s VALUES (%s); " + ["project_comment_thread", generateQuestionMarks' thread, entityName, generateQuestionMarks' comment] + let params = toRow thread ++ toRow comment + logInsertAndUpdate sql params + let action conn = execute conn sql params + runDB action + +updateProjectCommentById :: ProjectComment -> AppContextM ProjectComment +updateProjectCommentById entity = do + tenantUuid <- asks currentTenantUuid + now <- liftIO getCurrentTime + let updatedEntity = entity {updatedAt = now} :: ProjectComment + let sql = + fromString + "UPDATE project_comment SET uuid = ?, text = ?, created_by = ?, created_at = ?, updated_at = ?, tenant_uuid = ? WHERE uuid = ? AND tenant_uuid = ?" + let params = toRow updatedEntity ++ [toField updatedEntity.uuid, toField tenantUuid] + logQuery sql params + let action conn = execute conn sql params + runDB action + return updatedEntity + +updateProjectCommentTextById :: U.UUID -> String -> AppContextM Int64 +updateProjectCommentTextById uuid text = do + tenantUuid <- asks currentTenantUuid + let sql = fromString "UPDATE project_comment SET text = ?, updated_at = now() WHERE uuid = ? AND tenant_uuid = ?" + let params = [toField text, toField uuid, toField tenantUuid] + logQuery sql params + let action conn = execute conn sql params + runDB action + +deleteProjectComments :: AppContextM Int64 +deleteProjectComments = createDeleteEntitiesFn entityName + +deleteProjectCommentsByThreadUuid :: U.UUID -> AppContextM Int64 +deleteProjectCommentsByThreadUuid threadUuid = do + tenantUuid <- asks currentTenantUuid + createDeleteEntityByFn entityName [("comment_thread_uuid", U.toString threadUuid), ("tenant_uuid", U.toString tenantUuid)] + +deleteProjectCommentById :: U.UUID -> AppContextM Int64 +deleteProjectCommentById uuid = do + tenantUuid <- asks currentTenantUuid + createDeleteEntityByFn entityName [("uuid", U.toString uuid), ("tenant_uuid", U.toString tenantUuid)] diff --git a/wizard-server/src/Wizard/Database/DAO/Project/ProjectCommentThreadDAO.hs b/wizard-server/src/Wizard/Database/DAO/Project/ProjectCommentThreadDAO.hs new file mode 100644 index 000000000..b6e944d75 --- /dev/null +++ b/wizard-server/src/Wizard/Database/DAO/Project/ProjectCommentThreadDAO.hs @@ -0,0 +1,373 @@ +module Wizard.Database.DAO.Project.ProjectCommentThreadDAO where + +import Control.Monad.Except (throwError) +import Control.Monad.Reader (asks, liftIO) +import qualified Data.Map.Strict as M +import Data.String +import Data.Time +import qualified Data.UUID as U +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.ToField +import Database.PostgreSQL.Simple.ToRow +import GHC.Int + +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.PageMetadata +import Shared.Common.Model.Common.Pageable +import Shared.Common.Model.Common.Sort +import Shared.Common.Model.Error.Error +import Shared.Common.Util.Logger +import Shared.Common.Util.Map (doubleGroupBy) +import Shared.Common.Util.String +import Shared.Common.Util.Uuid +import Wizard.Api.Resource.User.UserDTO +import Wizard.Database.DAO.Common +import Wizard.Database.Mapping.Project.Comment.ProjectCommentThread () +import Wizard.Database.Mapping.Project.Comment.ProjectCommentThreadAssigned () +import Wizard.Database.Mapping.Project.Comment.ProjectCommentThreadList () +import Wizard.Database.Mapping.Project.Comment.ProjectCommentThreadNotification () +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.AppContextHelpers +import Wizard.Model.Context.ContextLenses () +import Wizard.Model.Project.Comment.ProjectComment +import Wizard.Model.Project.Comment.ProjectCommentList +import Wizard.Model.Project.Comment.ProjectCommentThreadAssigned +import Wizard.Model.Project.Comment.ProjectCommentThreadNotification + +entityName = "project_comment_thread" + +findAssignedProjectCommentThreadsPage :: Maybe String -> Maybe U.UUID -> Maybe Bool -> Pageable -> [Sort] -> AppContextM (Page ProjectCommentThreadAssigned) +findAssignedProjectCommentThreadsPage mQuery mProjectUuid mResolved pageable sort = do + -- 1. Prepare variables + currentUser <- getCurrentUser + tenantUuid <- asks currentTenantUuid + let (qCondition, qRegex) = + case mQuery of + Just query -> (" AND comment.text ~* ?", [regex query]) + Nothing -> ("", []) + let (projectUuidCondition, projectUuidParam) = + case mProjectUuid of + Just projectUuid -> ("AND project.uuid = ?", [U.toString projectUuid]) + Nothing -> ("", []) + let resolvedCondition = + case mResolved of + Just True -> "AND thread.resolved = true" + Just False -> "AND thread.resolved = false" + Nothing -> "" + let params = + [U.toString tenantUuid, U.toString currentUser.uuid] + ++ qRegex + ++ projectUuidParam + let (sizeI, pageI, skip, limit) = preparePaginationVariables pageable + -- 2. Get total count + let countSql = + fromString $ + f'' + "SELECT COUNT(DISTINCT thread.uuid) \ + \FROM project_comment_thread thread \ + \JOIN project ON project.uuid = thread.project_uuid AND project.tenant_uuid = thread.tenant_uuid \ + \LEFT JOIN project_comment comment ON comment.comment_thread_uuid = thread.uuid AND comment.tenant_uuid = thread.tenant_uuid \ + \WHERE thread.tenant_uuid = ? \ + \ AND thread.assigned_to = ? \ + \ AND comment.uuid = (SELECT comment.uuid \ + \ FROM project_comment comment \ + \ WHERE comment.comment_thread_uuid = thread.uuid AND comment.tenant_uuid = thread.tenant_uuid \ + \ ORDER BY comment.created_at \ + \ LIMIT 1) \ + \ ${qCondition} \ + \ ${projectUuidCondition} \ + \ ${resolvedCondition}" + [ ("qCondition", qCondition) + , ("projectUuidCondition", projectUuidCondition) + , ("resolvedCondition", resolvedCondition) + ] + logQuery countSql params + let action conn = query conn countSql params + result <- runDB action + let count = + case result of + [count] -> fromOnly count + _ -> 0 + -- 3. Get entities + let sql = + fromString $ + f'' + "SELECT project.uuid, \ + \ project.name, \ + \ thread.uuid, \ + \ thread.path, \ + \ thread.resolved, \ + \ thread.private, \ + \ thread.updated_at, \ + \ comment.text AS comment_text, \ + \ u.uuid AS created_by_uuid, \ + \ u.first_name AS created_by_first_name, \ + \ u.last_name AS created_by_last_name, \ + \ u.email AS created_by_email, \ + \ u.image_url AS created_by_image_url \ + \FROM project_comment_thread thread \ + \JOIN project ON project.uuid = thread.project_uuid AND project.tenant_uuid = thread.tenant_uuid \ + \LEFT JOIN user_entity u ON u.uuid = thread.created_by AND u.tenant_uuid = thread.tenant_uuid \ + \LEFT JOIN project_comment comment ON comment.comment_thread_uuid = thread.uuid AND comment.tenant_uuid = thread.tenant_uuid \ + \WHERE thread.tenant_uuid = ? \ + \ AND thread.assigned_to = ? \ + \ AND comment.uuid = (SELECT comment.uuid \ + \ FROM project_comment comment \ + \ WHERE comment.comment_thread_uuid = thread.uuid AND comment.tenant_uuid = thread.tenant_uuid \ + \ ORDER BY comment.created_at \ + \ LIMIT 1) \ + \ ${qCondition} \ + \ ${projectUuidCondition} \ + \ ${resolvedCondition} \ + \${sort} \ + \OFFSET ${offset} \ + \LIMIT ${limit}" + [ ("qCondition", qCondition) + , ("projectUuidCondition", projectUuidCondition) + , ("resolvedCondition", resolvedCondition) + , ("sort", mapSort sort) + , ("offset", show skip) + , ("limit", show sizeI) + ] + logQuery sql params + let action conn = query conn sql params + entities <- runDB action + -- 4. Constructor response + let metadata = + PageMetadata + { size = sizeI + , totalElements = count + , totalPages = computeTotalPage count sizeI + , number = pageI + } + return $ Page "projectCommentThreads" metadata entities + +findProjectCommentThreads :: U.UUID -> AppContextM [ProjectCommentThread] +findProjectCommentThreads projectUuid = do + tenantUuid <- asks currentTenantUuid + let sql = + fromString + "SELECT project_comment_thread.*, \ + \ (SELECT array_agg(concat(uuid, ':::::', text, ':::::', comment_thread_uuid, ':::::', tenant_uuid, ':::::', created_by, ':::::', created_at, ':::::', updated_at)) AS comments \ + \ FROM project_comment \ + \ WHERE project_comment.comment_thread_uuid = project_comment_thread.uuid \ + \ GROUP BY comment_thread_uuid) AS comments \ + \FROM project_comment_thread \ + \WHERE project_uuid = ? AND tenant_uuid = ?" + let params = [toField projectUuid, toField tenantUuid] + logQuery sql params + let action conn = query conn sql params + runDB action + +findProjectCommentThreadsForProject :: U.UUID -> Maybe String -> Maybe Bool -> Bool -> AppContextM [ProjectCommentThreadList] +findProjectCommentThreadsForProject projectUuid mPath mResolved editor = do + tenantUuid <- asks currentTenantUuid + let (pathCondition, pathParam) = + case mPath of + Just path -> ("AND path = ?", [toField path]) + Nothing -> ("", []) + let resolvedCondition = + case mResolved of + Just True -> "AND resolved = true" + Just False -> "AND resolved = false" + Nothing -> "" + let privateCondition = + if editor + then "" + else "AND private = false" + let sql = + fromString $ + f'' + "SELECT thread.uuid, \ + \ thread.path, \ + \ thread.resolved, \ + \ thread.private, \ + \ thread.created_at, \ + \ thread.updated_at, \ + \ assigned_to_user.uuid, \ + \ assigned_to_user.first_name, \ + \ assigned_to_user.last_name, \ + \ assigned_to_user.email, \ + \ assigned_to_user.image_url, \ + \ created_by_user.uuid, \ + \ created_by_user.first_name, \ + \ created_by_user.last_name, \ + \ created_by_user.email, \ + \ created_by_user.image_url, \ + \ (SELECT array_agg(concat(comment.uuid, '<:::::>', \ + \ comment.text, '<:::::>', \ + \ comment.created_at, '<:::::>', \ + \ comment.updated_at, '<:::::>', \ + \ user_entity.uuid, '<:::::>', \ + \ user_entity.first_name, '<:::::>', \ + \ user_entity.last_name, '<:::::>', \ + \ user_entity.email, '<:::::>', \ + \ user_entity.image_url \ + \ )) AS comments \ + \ FROM project_comment comment \ + \ LEFT JOIN user_entity ON user_entity.uuid = comment.created_by \ + \ WHERE comment.comment_thread_uuid = thread.uuid \ + \ GROUP BY comment_thread_uuid) AS comments \ + \FROM project_comment_thread thread \ + \LEFT JOIN user_entity assigned_to_user ON assigned_to_user.uuid = thread.assigned_to \ + \LEFT JOIN user_entity created_by_user ON created_by_user.uuid = thread.created_by \ + \WHERE thread.project_uuid = ? \ + \ AND thread.tenant_uuid = ? \ + \ ${pathCondition} \ + \ ${resolvedCondition} \ + \ ${privateCondition}" + [ ("pathCondition", pathCondition) + , ("resolvedCondition", resolvedCondition) + , ("privateCondition", privateCondition) + ] + let params = toField projectUuid : toField tenantUuid : pathParam + logQuery sql params + let action conn = query conn sql params + runDB action + +findProjectCommentThreadsSimple :: U.UUID -> Bool -> Bool -> AppContextM (M.Map String (M.Map U.UUID Int)) +findProjectCommentThreadsSimple projectUuid resolved editor = do + tenantUuid <- asks currentTenantUuid + let privateCondition = + if editor + then "" + else "AND project_comment_thread.private = false" + let sql = + fromString $ + f'' + "SELECT path, project_comment_thread.uuid::text, count(project_comment.uuid)::text \ + \FROM project_comment_thread \ + \LEFT JOIN project_comment ON project_comment_thread.uuid = project_comment.comment_thread_uuid AND project_comment_thread.tenant_uuid = project_comment.tenant_uuid \ + \WHERE project_comment_thread.project_uuid = ? \ + \ AND project_comment_thread.tenant_uuid = ? \ + \ AND project_comment_thread.resolved = ? \ + \ ${privateCondition} \ + \GROUP BY path, project_comment_thread.uuid" + [("privateCondition", privateCondition)] + let params = [toField projectUuid, toField tenantUuid, toField resolved] + logQuery sql params + let action conn = query conn sql params + results <- runDB action + return $ doubleGroupBy id u' read results + +findProjectCommentThreadsForNotifying :: AppContextM [ProjectCommentThreadNotification] +findProjectCommentThreadsForNotifying = do + let sql = + "SELECT project.uuid, \ + \ project.name, \ + \ project.tenant_uuid, \ + \ thread.uuid, \ + \ thread.path, \ + \ thread.resolved, \ + \ thread.private, \ + \ assigned_to.uuid, \ + \ assigned_to.first_name, \ + \ assigned_to.last_name, \ + \ assigned_to.email, \ + \ assigned_by.uuid, \ + \ assigned_by.first_name, \ + \ assigned_by.last_name, \ + \ assigned_by.email, \ + \ (SELECT comment.text \ + \ FROM project_comment comment \ + \ WHERE comment.comment_thread_uuid = thread.uuid \ + \ AND comment.tenant_uuid = thread.tenant_uuid \ + \ ORDER BY comment.created_at \ + \ LIMIT 1) comment_text, \ + \ tenant.client_url, \ + \ config_look_and_feel.app_title AS app_title, \ + \ config_look_and_feel.logo_url AS logo_url, \ + \ config_look_and_feel.primary_color AS primary_color, \ + \ config_look_and_feel.illustrations_color AS illustrations_color, \ + \ config_privacy_and_support.support_email AS support_email, \ + \ config_mail.config_uuid AS mail_config_uuid \ + \FROM project_comment_thread thread \ + \JOIN project ON project.uuid = thread.project_uuid AND project.tenant_uuid = thread.tenant_uuid \ + \JOIN user_entity assigned_to ON assigned_to.uuid = thread.assigned_to AND assigned_to.tenant_uuid = thread.tenant_uuid \ + \LEFT JOIN user_entity assigned_by ON assigned_by.uuid = thread.assigned_by AND assigned_by.tenant_uuid = thread.tenant_uuid \ + \JOIN tenant ON tenant.uuid = thread.tenant_uuid \ + \JOIN config_look_and_feel ON config_look_and_feel.tenant_uuid = thread.tenant_uuid \ + \JOIN config_privacy_and_support ON config_privacy_and_support.tenant_uuid = thread.tenant_uuid \ + \JOIN config_mail ON config_mail.tenant_uuid = thread.tenant_uuid \ + \WHERE thread.notification_required = true" + logInfoI _CMP_DATABASE (trim sql) + let action conn = query_ conn (fromString sql) + runDB action + +findProjectCommentThreadById :: U.UUID -> AppContextM (Maybe ProjectCommentThread) +findProjectCommentThreadById uuid = do + tenantUuid <- asks currentTenantUuid + let sql = + fromString + "SELECT project_comment_thread.*, \ + \ (SELECT array_agg(concat(uuid, ':::::', text, ':::::', comment_thread_uuid, ':::::', tenant_uuid, ':::::', created_by, ':::::', created_at, ':::::', updated_at)) AS comments \ + \ FROM project_comment \ + \ WHERE project_comment.comment_thread_uuid = project_comment_thread.uuid \ + \ GROUP BY comment_thread_uuid) AS comments \ + \FROM project_comment_thread \ + \WHERE uuid = ? AND tenant_uuid = ?" + let params = [toField uuid, toField tenantUuid] + logQuery sql params + let action conn = query conn sql params + entities <- runDB action + case entities of + [] -> return Nothing + [entity] -> return . Just $ entity + _ -> + throwError $ + GeneralServerError + ( f' + "createFindEntityByFn: find more entities found than one (entity: %s, param: %s)" + [entityName, show [("uuid", uuid)]] + ) + +insertProjectCommentThread :: ProjectCommentThread -> AppContextM Int64 +insertProjectCommentThread = createInsertFn entityName + +updateProjectCommentThreadById :: ProjectCommentThread -> AppContextM ProjectCommentThread +updateProjectCommentThreadById entity = do + tenantUuid <- asks currentTenantUuid + now <- liftIO getCurrentTime + let updatedEntity = entity {updatedAt = now} :: ProjectCommentThread + let sql = + fromString + "UPDATE project_comment_thread SET uuid = ?, text = ?, project_uuid = ?, created_by = ?, created_at = ?, updated_at = ?, tenant_uuid = ? WHERE uuid = ? AND tenant_uuid = ?" + let params = toRow updatedEntity ++ [toField updatedEntity.uuid, toField tenantUuid] + logQuery sql params + let action conn = execute conn sql params + runDB action + return updatedEntity + +updateProjectCommentThreadResolvedById :: U.UUID -> Bool -> AppContextM Int64 +updateProjectCommentThreadResolvedById uuid resolved = do + tenantUuid <- asks currentTenantUuid + let sql = fromString "UPDATE project_comment_thread SET resolved = ?, updated_at = now() WHERE uuid = ? AND tenant_uuid = ?" + let params = [toField resolved, toField uuid, toField tenantUuid] + logQuery sql params + let action conn = execute conn sql params + runDB action + +updateProjectCommentThreadAssignee :: U.UUID -> Maybe U.UUID -> Maybe U.UUID -> AppContextM Int64 +updateProjectCommentThreadAssignee uuid assignedTo assignedBy = do + tenantUuid <- asks currentTenantUuid + let sql = fromString "UPDATE project_comment_thread SET assigned_to = ?, assigned_by = ?, notification_required = true, updated_at = now() WHERE uuid = ? AND tenant_uuid = ?" + let params = [toField assignedTo, toField assignedBy, toField uuid, toField tenantUuid] + logQuery sql params + let action conn = execute conn sql params + runDB action + +unsetProjectCommentThreadNotificationRequired :: AppContextM () +unsetProjectCommentThreadNotificationRequired = do + let sql = "UPDATE project_comment_thread SET notification_required = false WHERE notification_required = true" + logInfoI _CMP_DATABASE (trim sql) + let action conn = execute_ conn (fromString sql) + runDB action + return () + +deleteProjectCommentThreads :: AppContextM Int64 +deleteProjectCommentThreads = createDeleteEntitiesFn entityName + +deleteProjectCommentThreadById :: U.UUID -> AppContextM Int64 +deleteProjectCommentThreadById uuid = do + tenantUuid <- asks currentTenantUuid + createDeleteEntityByFn entityName [("uuid", U.toString uuid), ("tenant_uuid", U.toString tenantUuid)] diff --git a/wizard-server/src/Wizard/Database/DAO/Project/ProjectDAO.hs b/wizard-server/src/Wizard/Database/DAO/Project/ProjectDAO.hs new file mode 100644 index 000000000..1df195dcd --- /dev/null +++ b/wizard-server/src/Wizard/Database/DAO/Project/ProjectDAO.hs @@ -0,0 +1,669 @@ +module Wizard.Database.DAO.Project.ProjectDAO where + +import Control.Monad.Reader (asks) +import Data.Foldable (traverse_) +import qualified Data.List as L +import Data.String (fromString) +import Data.Time +import qualified Data.UUID as U +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.ToField +import Database.PostgreSQL.Simple.ToRow +import GHC.Int + +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.PageMetadata +import Shared.Common.Model.Common.Pageable +import Shared.Common.Model.Common.Sort +import Shared.Common.Util.Logger +import Shared.Common.Util.String (f'', replace, trim) +import Wizard.Api.Resource.User.UserDTO +import Wizard.Database.DAO.Common +import Wizard.Database.DAO.Project.ProjectPermDAO ( + deleteProjectPermsFiltered, + findProjectPermsFiltered, + insertProjectPerm, + ) +import Wizard.Database.Mapping.Project.Project () +import Wizard.Database.Mapping.Project.ProjectDetail () +import Wizard.Database.Mapping.Project.ProjectDetailPreview () +import Wizard.Database.Mapping.Project.ProjectDetailQuestionnaire () +import Wizard.Database.Mapping.Project.ProjectDetailSettings () +import Wizard.Database.Mapping.Project.ProjectList () +import Wizard.Database.Mapping.Project.ProjectSimple () +import Wizard.Database.Mapping.Project.ProjectSimpleWithPerm () +import Wizard.Database.Mapping.Project.ProjectSuggestion () +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.AppContextHelpers +import Wizard.Model.Context.ContextLenses () +import Wizard.Model.Project.Detail.ProjectDetail +import Wizard.Model.Project.Detail.ProjectDetailPreview +import Wizard.Model.Project.Detail.ProjectDetailQuestionnaire +import Wizard.Model.Project.Detail.ProjectDetailSettings +import Wizard.Model.Project.Project +import Wizard.Model.Project.ProjectList +import Wizard.Model.Project.ProjectSimpleWithPerm +import Wizard.Model.Project.ProjectSuggestion +import Wizard.Model.User.User + +entityName = "project" + +pageLabel = "projects" + +findProjects :: AppContextM [Project] +findProjects = do + tenantUuid <- asks currentTenantUuid + currentUser <- getCurrentUser + if currentUser.uRole == _USER_ROLE_ADMIN + then createFindEntitiesBySortedFn entityName [tenantQueryUuid tenantUuid] [Sort "name" Ascending] >>= traverse enhance + else do + let sql = f' (projectSelectSql (U.toString tenantUuid) (U.toString $ currentUser.uuid) "['VIEW']") [""] ++ " ORDER BY project.name ASC" + logInfoI _CMP_DATABASE sql + let action conn = query_ conn (fromString sql) + entities <- runDB action + traverse enhance entities + +findProjectsForCurrentUserPage :: Maybe String -> Maybe Bool -> Maybe Bool -> Maybe [String] -> Maybe String -> Maybe [String] -> Maybe String -> Maybe [String] -> Maybe String -> Pageable -> [Sort] -> AppContextM (Page ProjectList) +findProjectsForCurrentUserPage mQuery mIsTemplate mIsMigrating mProjectTags mProjectTagsOp mUserUuids mUserUuidsOp mKnowledgeModelPackageIds mKnowledgeModelPackageIdsOp pageable sort = + -- 1. Prepare variables + do + tenantUuid <- asks currentTenantUuid + currentUser <- getCurrentUser + let (nameCondition, nameRegex) = + case mQuery of + Just query -> (" AND project.name ~* ?", [regex query]) + Nothing -> ("", []) + let isTemplateCondition = + case mIsTemplate of + Nothing -> "" + Just True -> " AND project.is_template = true" + Just False -> " AND project.is_template = false" + let isMigratingCondition useWhere = + case mIsMigrating of + Nothing -> "" + Just True -> f' " %s project_mig.new_project_uuid IS NOT NULL" [if useWhere then "WHERE" else "AND"] + Just False -> f' " %s project_mig.new_project_uuid IS NULL" [if useWhere then "WHERE" else "AND"] + let projectMigrationJoin = + case mIsMigrating of + Nothing -> "" + Just _ -> "LEFT JOIN project_migration project_mig ON project.uuid = project_mig.new_project_uuid " + let (projectTagsCondition, projectTagsParam) = + case mProjectTags of + Nothing -> ("", []) + Just [] -> ("", []) + Just projectTags -> + let mapFn _ = " project.project_tags @> ARRAY [?]" + in if isAndOperator mProjectTagsOp + then (" AND (" ++ L.intercalate " AND " (fmap mapFn projectTags) ++ ")", projectTags) + else (" AND (" ++ L.intercalate " OR " (fmap mapFn projectTags) ++ ")", projectTags) + let userUuidsJoin = + case mUserUuids of + Nothing -> "" + Just [] -> "" + Just _ -> "LEFT JOIN project_perm_user ON project.uuid = project_perm_user.project_uuid " + let (userUuidsCondition, userUuidsParam) = + case mUserUuids of + Nothing -> ("", []) + Just [] -> ("", []) + Just userUuids -> + if isAndOperator mUserUuidsOp + then + ( f' + " AND %s = ( \ + \SELECT COUNT(DISTINCT user_uuid) \ + \FROM project_perm_user \ + \WHERE project_uuid = project.uuid AND user_uuid in (%s)) " + [show . length $ userUuids, generateQuestionMarks userUuids] + , userUuids + ) + else + let mapFn _ = " project_perm_user.user_uuid = ? " + in (" AND (" ++ L.intercalate " OR " (fmap mapFn userUuids) ++ ")", userUuids) + let (knowledgeModelPackageCondition, knowledgeModelPackageIdsParam) = + case mKnowledgeModelPackageIds of + Nothing -> ("", []) + Just [] -> ("", []) + Just packageIds -> + let operator = if isAndOperator mKnowledgeModelPackageIdsOp then " AND " else " OR " + in ( f' " AND (%s)" [L.intercalate operator . fmap (const " project.knowledge_model_package_id LIKE ?") $ packageIds] + , fmap (replace "all" "%") packageIds + ) + let (aclJoins, aclCondition) = + if currentUser.uRole == _USER_ROLE_ADMIN + then (userUuidsJoin, "") + else + ( f'' + "LEFT JOIN project_perm_user ON project.uuid = project_perm_user.project_uuid AND project_perm_user.tenant_uuid = '${tenantUuid}' \ + \LEFT JOIN project_perm_group ON project.uuid = project_perm_group.project_uuid AND project_perm_group.tenant_uuid = '${tenantUuid}' \ + \LEFT JOIN user_group_membership ugm ON ugm.user_group_uuid = project_perm_group.user_group_uuid AND ugm.user_uuid = '${currentUserUuid}' AND ugm.tenant_uuid = '${tenantUuid}'" + [ ("currentUserUuid", U.toString currentUser.uuid) + , ("tenantUuid", U.toString tenantUuid) + ] + , f' + "AND (visibility = 'VisibleEditProjectVisibility' \ + \ OR visibility = 'VisibleCommentProjectVisibility' \ + \ OR visibility = 'VisibleViewProjectVisibility' \ + \ OR (visibility = 'PrivateProjectVisibility' AND project_perm_user.user_uuid = '%s' AND project_perm_user.perms @> ARRAY %s) \ + \ OR (visibility = 'PrivateProjectVisibility' AND project_perm_group.user_group_uuid = ugm.user_group_uuid AND project_perm_group.perms @> ARRAY %s) \ + \)" + [U.toString currentUser.uuid, "['VIEW']", "['VIEW']"] + ) + let (sizeI, pageI, skip, limit) = preparePaginationVariables pageable + -- 2. Get total count + let countSql = + fromString $ + f'' + "SELECT COUNT(DISTINCT project.uuid) \ + \FROM project \ + \${projectMigrationJoin} \ + \${aclJoins} \ + \WHERE project.tenant_uuid = '${tenantUuid}' ${aclCondition} ${nameCondition} ${isTemplateCondition} ${isMigratingCondition} ${projectTagsCondition} ${userUuidsCondition} ${knowledgeModelPackageCondition}" + [ ("projectMigrationJoin", projectMigrationJoin) + , ("aclJoins", aclJoins) + , ("tenantUuid", U.toString tenantUuid) + , ("aclCondition", aclCondition) + , ("nameCondition", nameCondition) + , ("isTemplateCondition", isTemplateCondition) + , ("isMigratingCondition", isMigratingCondition False) + , ("projectTagsCondition", projectTagsCondition) + , ("userUuidsCondition", userUuidsCondition) + , ("knowledgeModelPackageCondition", knowledgeModelPackageCondition) + ] + let params = nameRegex ++ projectTagsParam ++ userUuidsParam ++ knowledgeModelPackageIdsParam + logQuery countSql params + let action conn = query conn countSql params + result <- runDB action + let count = + case result of + [count] -> fromOnly count + _ -> 0 + -- 3. Get entities + let sql = + fromString $ + f'' + "WITH filtered_project AS (SELECT DISTINCT project.uuid, \ + \ project.name, \ + \ project.description, \ + \ project.visibility, \ + \ project.sharing, \ + \ project.is_template, \ + \ project.created_at, \ + \ project.updated_at, \ + \ project.knowledge_model_package_id \ + \ FROM project \ + \ ${aclJoins} \ + \ WHERE project.tenant_uuid = '${tenantUuid}' ${aclCondition} ${nameCondition} ${isTemplateCondition} ${projectTagsCondition} ${userUuidsCondition} ${knowledgeModelPackageCondition}), \ + \ pkg AS (SELECT knowledge_model_package.id, \ + \ knowledge_model_package.name, \ + \ knowledge_model_package.version, \ + \ knowledge_model_package.organization_id, \ + \ knowledge_model_package.km_id \ + \ FROM knowledge_model_package \ + \ WHERE knowledge_model_package.tenant_uuid = '${tenantUuid}'), \ + \ project_mig AS (SELECT new_project_uuid \ + \ FROM project_migration \ + \ WHERE project_migration.tenant_uuid = '${tenantUuid}') \ + \SELECT filtered_project.uuid, \ + \ filtered_project.name, \ + \ filtered_project.description, \ + \ filtered_project.visibility, \ + \ filtered_project.sharing, \ + \ filtered_project.is_template, \ + \ filtered_project.created_at, \ + \ filtered_project.updated_at, \ + \ CASE \ + \ WHEN project_mig.new_project_uuid IS NOT NULL THEN 'MigratingProjectState' \ + \ WHEN filtered_project.knowledge_model_package_id != get_newest_knowledge_model_package(pkg.organization_id, pkg.km_id, '${tenantUuid}', ARRAY['ReleasedKnowledgeModelPackagePhase']) THEN 'OutdatedProjectState' \ + \ WHEN project_mig.new_project_uuid IS NULL THEN 'DefaultProjectState' END, \ + \ pkg.id, \ + \ pkg.name, \ + \ pkg.version, \ + \ (SELECT array_agg(CONCAT(project_perm_user.user_uuid, '::', project_perm_user.perms, '::', u.uuid, '::', u.first_name, '::', u.last_name, '::', u.email, '::', u.image_url)) \ + \ FROM project_perm_user \ + \ JOIN user_entity u on u.uuid = project_perm_user.user_uuid \ + \ WHERE project_uuid = filtered_project.uuid \ + \ GROUP BY project_uuid) as user_permissions, \ + \ (SELECT array_agg(CONCAT(project_perm_group.user_group_uuid, '::', project_perm_group.perms, '::', ug.uuid, '::', ug.name, '::', ug.private, '::', ug.description)) \ + \ FROM project_perm_group \ + \ JOIN user_group ug on ug.uuid = project_perm_group.user_group_uuid \ + \ WHERE project_uuid = filtered_project.uuid \ + \ GROUP BY project_uuid) as group_permissions \ + \FROM filtered_project \ + \JOIN pkg ON filtered_project.knowledge_model_package_id = pkg.id \ + \LEFT JOIN project_mig ON filtered_project.uuid = project_mig.new_project_uuid \ + \${isMigratingCondition} \ + \${sort} \ + \OFFSET ${offset} LIMIT ${limit}" + [ ("aclJoins", aclJoins) + , ("tenantUuid", U.toString tenantUuid) + , ("aclCondition", aclCondition) + , ("nameCondition", nameCondition) + , ("isTemplateCondition", isTemplateCondition) + , ("isMigratingCondition", isMigratingCondition True) + , ("projectTagsCondition", projectTagsCondition) + , ("userUuidsCondition", userUuidsCondition) + , ("knowledgeModelPackageCondition", knowledgeModelPackageCondition) + , ("sort", mapSortWithPrefix "filtered_project" sort) + , ("offset", show skip) + , ("limit", show sizeI) + ] + logQuery sql params + let action conn = query conn sql params + entities <- runDB action + -- 5. Constructor response + let metadata = + PageMetadata + { size = sizeI + , totalElements = count + , totalPages = computeTotalPage count sizeI + , number = pageI + } + return $ Page pageLabel metadata entities + +findProjectsByKnowledgeModelPackageId :: String -> AppContextM [Project] +findProjectsByKnowledgeModelPackageId packageId = do + tenantUuid <- asks currentTenantUuid + currentUser <- getCurrentUser + if currentUser.uRole == _USER_ROLE_ADMIN + then createFindEntitiesByFn entityName [tenantQueryUuid tenantUuid, ("knowledge_model_package_id", packageId)] >>= traverse enhance + else do + let sql = + fromString $ + f' (projectSelectSql (U.toString tenantUuid) (U.toString $ currentUser.uuid) "['VIEW']") ["AND knowledge_model_package_id = ?"] + let params = [packageId] + logQuery sql params + let action conn = query conn sql params + entities <- runDB action + traverse enhance entities + +findProjectsByDocumentTemplateId :: String -> AppContextM [Project] +findProjectsByDocumentTemplateId documentTemplateId = do + tenantUuid <- asks currentTenantUuid + currentUser <- getCurrentUser + if currentUser.uRole == _USER_ROLE_ADMIN + then createFindEntitiesByFn entityName [tenantQueryUuid tenantUuid, ("document_template_id", documentTemplateId)] >>= traverse enhance + else do + let sql = + fromString $ + f' (projectSelectSql (U.toString tenantUuid) (U.toString $ currentUser.uuid) "['VIEW']") ["AND document_template_id = ?"] + let params = [documentTemplateId] + logQuery sql params + let action conn = query conn sql params + entities <- runDB action + traverse enhance entities + +findProjectsWithZeroAcl :: AppContextM [Project] +findProjectsWithZeroAcl = do + let sql = + f' + "SELECT project.* \ + \FROM %s \ + \LEFT JOIN project_perm_user ON project.uuid = project_perm_user.project_uuid \ + \LEFT JOIN project_perm_group ON project.uuid = project_perm_group.project_uuid \ + \WHERE project_perm_user.user_uuid IS NULL \ + \AND project_perm_group.user_group_uuid IS NULL \ + \AND project.updated_at < now() - INTERVAL '30 days'" + [entityName] + logInfoI _CMP_DATABASE (trim sql) + let action conn = query_ conn (fromString sql) + runDB action + +findProjectsSimpleWithPermByUserGroupUuid :: U.UUID -> AppContextM [ProjectSimpleWithPerm] +findProjectsSimpleWithPermByUserGroupUuid userGroupUuid = do + tenantUuid <- asks currentTenantUuid + let sql = + fromString + "SELECT \ + \ nested_project.*, \ + \ ( \ + \ SELECT array_agg(CONCAT(user_uuid, '::', perms)) \ + \ FROM project_perm_user \ + \ WHERE project_uuid = nested_project.uuid AND tenant_uuid = nested_project.tenant_uuid \ + \ GROUP BY project_uuid \ + \ ) as user_permissions, \ + \ ( \ + \ SELECT array_agg(CONCAT(user_group_uuid, '::', perms)) \ + \ FROM project_perm_group \ + \ WHERE project_uuid = nested_project.uuid AND tenant_uuid = nested_project.tenant_uuid \ + \ GROUP BY project_uuid \ + \ ) as group_permissions \ + \FROM ( \ + \ SELECT project.uuid, project.visibility, project.sharing, project.tenant_uuid \ + \ FROM project \ + \ LEFT JOIN project_perm_group ON project.uuid = project_perm_group.project_uuid AND project.tenant_uuid = project_perm_group.tenant_uuid \ + \ WHERE project_perm_group.user_group_uuid = ? AND project_perm_group.tenant_uuid = ? \ + \) nested_project" + let params = [toField userGroupUuid, toField tenantUuid] + logQuery sql params + let action conn = query conn sql params + runDB action + +findProjectByUuid :: U.UUID -> AppContextM Project +findProjectByUuid projectUuid = do + tenantUuid <- asks currentTenantUuid + entity <- createFindEntityByFn entityName [tenantQueryUuid tenantUuid, ("uuid", U.toString projectUuid)] + enhance entity + +findProjectByUuid' :: U.UUID -> AppContextM (Maybe Project) +findProjectByUuid' projectUuid = do + tenantUuid <- asks currentTenantUuid + mEntity <- createFindEntityByFn' entityName [tenantQueryUuid tenantUuid, ("uuid", U.toString projectUuid)] + case mEntity of + Just entity -> enhance entity >>= return . Just + Nothing -> return Nothing + +findProjectSuggestionByUuid' :: U.UUID -> AppContextM (Maybe ProjectSuggestion) +findProjectSuggestionByUuid' uuid = do + tenantUuid <- asks currentTenantUuid + createFindEntityWithFieldsByFn' "uuid, name, description" entityName [tenantQueryUuid tenantUuid, ("uuid", U.toString uuid)] + +findProjectForSquashing :: AppContextM [U.UUID] +findProjectForSquashing = do + let sql = "SELECT uuid FROM project WHERE squashed = false" + logInfoI _CMP_DATABASE (trim sql) + let action conn = query_ conn (fromString sql) + entities <- runDB action + return . concat $ entities + +findProjectDetail :: U.UUID -> AppContextM ProjectDetail +findProjectDetail uuid = do + tenantUuid <- asks currentTenantUuid + let sql = + fromString $ + f'' + "SELECT project.uuid, \ + \ project.name, \ + \ project.visibility, \ + \ project.sharing, \ + \ project.knowledge_model_package_id, \ + \ project.selected_question_tag_uuids, \ + \ project.is_template, \ + \ project_mig.new_project_uuid AS migration_uuid, \ + \ ${projectDetailPermSql}, \ + \ ( \ + \ SELECT count(*) \ + \ FROM project_action \ + \ WHERE tenant_uuid = '${tenantUuid}' \ + \ ) as project_actions, \ + \ ( \ + \ SELECT count(*) \ + \ FROM project_importer \ + \ WHERE tenant_uuid = '${tenantUuid}' \ + \ ) as project_importers, \ + \ ( \ + \ SELECT count(*) \ + \ FROM project_file \ + \ WHERE tenant_uuid = '${tenantUuid}' AND project_uuid = '${projectUuid}' \ + \ ) as file_count \ + \FROM project \ + \LEFT JOIN project_migration project_mig ON project.uuid = project_mig.old_project_uuid AND project.tenant_uuid = project_mig.tenant_uuid \ + \WHERE project.tenant_uuid = ? AND project.uuid = ?" + [ ("projectDetailPermSql", projectDetailPermSql) + , ("projectUuid", U.toString uuid) + , ("tenantUuid", U.toString tenantUuid) + ] + let queryParams = [("tenant_uuid", U.toString tenantUuid), ("uuid", U.toString uuid)] + let params = fmap snd queryParams + logQuery sql params + let action conn = query conn sql params + runOneEntityDB entityName action queryParams + +findProjectDetailQuestionnaire :: U.UUID -> AppContextM ProjectDetailQuestionnaire +findProjectDetailQuestionnaire uuid = do + tenantUuid <- asks currentTenantUuid + let sql = + fromString $ + f'' + "SELECT project.uuid, \ + \ project.name, \ + \ project.visibility, \ + \ project.sharing, \ + \ project.knowledge_model_package_id, \ + \ project.selected_question_tag_uuids, \ + \ project.is_template, \ + \ project_mig.new_project_uuid AS migration_uuid, \ + \ ${projectDetailPermSql}, \ + \ ( \ + \ SELECT count(*) \ + \ FROM project_action \ + \ WHERE tenant_uuid = '${tenantUuid}' \ + \ ) as project_actions, \ + \ ( \ + \ SELECT count(*) \ + \ FROM project_importer \ + \ WHERE tenant_uuid = '${tenantUuid}' \ + \ ) as project_importers, \ + \ ( \ + \ SELECT array_agg(concat(uuid, '<:::::>', \ + \ file_name, '<:::::>', \ + \ content_type, '<:::::>', \ + \ file_size \ + \ )) \ + \ FROM project_file \ + \ WHERE tenant_uuid = '${tenantUuid}' AND project_uuid = '${projectUuid}' \ + \ ) as files \ + \FROM project \ + \LEFT JOIN project_migration project_mig ON project.uuid = project_mig.old_project_uuid AND project.tenant_uuid = project_mig.tenant_uuid \ + \WHERE project.tenant_uuid = ? AND project.uuid = ?" + [ ("projectUuid", U.toString uuid) + , ("projectDetailPermSql", projectDetailPermSql) + , ("tenantUuid", U.toString tenantUuid) + ] + let queryParams = [("tenant_uuid", U.toString tenantUuid), ("uuid", U.toString uuid)] + let params = fmap snd queryParams + logQuery sql params + let action conn = query conn sql params + runOneEntityDB entityName action queryParams + +findProjectDetailPreview :: U.UUID -> AppContextM ProjectDetailPreview +findProjectDetailPreview uuid = do + tenantUuid <- asks currentTenantUuid + let sql = + fromString $ + f'' + "SELECT project.uuid, \ + \ project.name, \ + \ project.visibility, \ + \ project.sharing, \ + \ project.knowledge_model_package_id, \ + \ project.is_template, \ + \ project.document_template_id, \ + \ project_mig.new_project_uuid AS migration_uuid, \ + \ ${projectDetailPermSql}, \ + \ dt_format.uuid, \ + \ dt_format.name, \ + \ dt_format.icon, \ + \ ( \ + \ SELECT count(*) \ + \ FROM project_file \ + \ WHERE tenant_uuid = '${tenantUuid}' AND project_uuid = '${projectUuid}' \ + \ ) as file_count \ + \FROM project \ + \LEFT JOIN project_migration project_mig ON project.uuid = project_mig.old_project_uuid AND project.tenant_uuid = project_mig.tenant_uuid \ + \LEFT JOIN document_template dt ON project.document_template_id = dt.id AND project.tenant_uuid = dt.tenant_uuid \ + \LEFT JOIN document_template_format dt_format ON project.document_template_id = dt_format.document_template_id AND project.format_uuid = dt_format.uuid AND project.tenant_uuid = dt_format.tenant_uuid \ + \WHERE project.tenant_uuid = ? AND project.uuid = ?" + [ ("projectDetailPermSql", projectDetailPermSql) + , ("projectUuid", U.toString uuid) + , ("tenantUuid", U.toString tenantUuid) + ] + let queryParams = [("tenant_uuid", U.toString tenantUuid), ("uuid", U.toString uuid)] + let params = fmap snd queryParams + logQuery sql params + let action conn = query conn sql params + runOneEntityDB entityName action queryParams + +findProjectDetailSettings :: U.UUID -> AppContextM ProjectDetailSettings +findProjectDetailSettings uuid = do + tenantUuid <- asks currentTenantUuid + let sql = + fromString $ + f'' + "SELECT project.uuid, \ + \ project.name, \ + \ project.description, \ + \ project.visibility, \ + \ project.sharing, \ + \ project.is_template, \ + \ project.project_tags, \ + \ project.selected_question_tag_uuids, \ + \ project.format_uuid, \ + \ project_mig.new_project_uuid AS migration_uuid, \ + \ ${projectDetailPermSql}, \ + \ pkg.id as knowledge_model_package_id, \ + \ pkg.name as knowledge_model_package_name, \ + \ pkg.organization_id as knowledge_model_package_organization_id, \ + \ pkg.km_id as knowledge_model_package_km_id, \ + \ pkg.version as knowledge_model_package_version, \ + \ pkg.phase as knowledge_model_package_phase, \ + \ pkg.description as knowledge_model_package_description, \ + \ pkg.non_editable as knowledge_model_package_non_editable, \ + \ pkg.created_at as knowledge_model_package_created_at, \ + \ dt.id as document_template_id, \ + \ dt.name as document_template_name, \ + \ dt.version as document_template_version, \ + \ dt.phase as document_template_phase, \ + \ dt.description as document_template_description, \ + \ ( \ + \ SELECT jsonb_agg(jsonb_build_object('uuid', uuid, 'name', name, 'icon', icon)) \ + \ FROM (SELECT * \ + \ FROM document_template_format dt_format \ + \ WHERE dt_format.tenant_uuid = project.tenant_uuid AND dt_format.document_template_id = dt.id \ + \ ORDER BY dt_format.name) nested \ + \ ) AS document_template_formats, \ + \ dt.metamodel_version as document_template_metamodel_version, \ + \ ( \ + \ SELECT count(*) \ + \ FROM project_file \ + \ WHERE tenant_uuid = '${tenantUuid}' AND project_uuid = '${projectUuid}' \ + \ ) as file_count \ + \FROM project \ + \LEFT JOIN project_migration project_mig ON project.uuid = project_mig.old_project_uuid AND project.tenant_uuid = project_mig.tenant_uuid \ + \LEFT JOIN knowledge_model_package pkg ON project.knowledge_model_package_id = pkg.id AND project.tenant_uuid = pkg.tenant_uuid \ + \LEFT JOIN document_template dt ON project.document_template_id = dt.id AND project.tenant_uuid = dt.tenant_uuid \ + \WHERE project.tenant_uuid = ? AND project.uuid = ?" + [ ("projectDetailPermSql", projectDetailPermSql) + , ("projectUuid", U.toString uuid) + , ("tenantUuid", U.toString tenantUuid) + ] + let queryParams = [("tenant_uuid", U.toString tenantUuid), ("uuid", U.toString uuid)] + let params = fmap snd queryParams + logQuery sql params + let action conn = query conn sql params + runOneEntityDB entityName action queryParams + +projectDetailPermSql :: String +projectDetailPermSql = + "(SELECT array_agg(CONCAT(project_perm_user.user_uuid, '::', project_perm_user.perms, '::', u.uuid, '::', u.first_name, \ + \ '::', u.last_name, '::', u.email, '::', u.image_url)) \ + \ FROM project_perm_user \ + \ JOIN user_entity u on u.uuid = project_perm_user.user_uuid \ + \ WHERE project_uuid = project.uuid \ + \ GROUP BY project_uuid) as user_permissions, \ + \(SELECT array_agg(CONCAT(project_perm_group.user_group_uuid, '::', project_perm_group.perms, '::', ug.uuid, '::', ug.name, \ + \ '::', ug.private, '::', ug.description)) \ + \ FROM project_perm_group \ + \ JOIN user_group ug on ug.uuid = project_perm_group.user_group_uuid \ + \ WHERE project_uuid = project.uuid \ + \ GROUP BY project_uuid) as group_permissions" + +countProjects :: AppContextM Int +countProjects = do + tenantUuid <- asks currentTenantUuid + countProjectsWithTenant tenantUuid + +countProjectsWithTenant :: U.UUID -> AppContextM Int +countProjectsWithTenant tenantUuid = createCountByFn entityName tenantCondition [U.toString tenantUuid] + +insertProject :: Project -> AppContextM Int64 +insertProject project = do + -- Insert project + let sql = + fromString + "INSERT INTO project VALUES (?, ?, ?, ?, ?, ?::uuid[], ?, ?, ?, ?, ?, ?, ?, ?, ?, ?::text[])" + let params = toRow project + logQuery sql params + let action conn = execute conn sql params + runDB action + -- Insert project permissions + traverse_ insertProjectPerm project.permissions + return 1 + +updateProjectByUuid :: Project -> AppContextM () +updateProjectByUuid project = do + tenantUuid <- asks currentTenantUuid + let sql = + fromString + "UPDATE project SET uuid = ?, name = ?, visibility = ?, sharing = ?, knowledge_model_package_id = ?, selected_question_tag_uuids = ?::uuid[], document_template_id = ?, format_uuid = ?, created_by = ?, created_at = ?, updated_at = ?, description = ?, is_template = ?, squashed = ?, tenant_uuid = ?, project_tags = ?::text[] WHERE tenant_uuid = ? AND uuid = ?" + let params = toRow project ++ [toField tenantUuid, toField . U.toText $ project.uuid] + logInsertAndUpdate sql params + let action conn = execute conn sql params + runDB action + deleteProjectPermsFiltered [("project_uuid", U.toString project.uuid)] + traverse_ insertProjectPerm project.permissions + +updateProjectSquashedByUuid :: U.UUID -> Bool -> AppContextM Int64 +updateProjectSquashedByUuid uuid squashed = do + tenantUuid <- asks currentTenantUuid + let sql = fromString "UPDATE project SET squashed = ? WHERE tenant_uuid = ? AND uuid = ?" + let params = [toField squashed, toField tenantUuid, toField . U.toText $ uuid] + logInsertAndUpdate sql params + let action conn = execute conn sql params + runDB action + +updateProjectSquashedAndUpdatedAtByUuid :: U.UUID -> Bool -> UTCTime -> AppContextM Int64 +updateProjectSquashedAndUpdatedAtByUuid uuid squashed updatedAt = do + tenantUuid <- asks currentTenantUuid + let sql = fromString "UPDATE project SET squashed = ?, updated_at = ? WHERE tenant_uuid = ? AND uuid = ?" + let params = [toField squashed, toField updatedAt, toField tenantUuid, toField . U.toText $ uuid] + logInsertAndUpdate sql params + let action conn = execute conn sql params + runDB action + +updateProjectUpdatedAtByUuid :: U.UUID -> AppContextM Int64 +updateProjectUpdatedAtByUuid uuid = do + tenantUuid <- asks currentTenantUuid + let sql = fromString "UPDATE project SET updated_at = now() WHERE tenant_uuid = ? AND uuid = ?" + let params = [toField tenantUuid, toField . U.toText $ uuid] + logInsertAndUpdate sql params + let action conn = execute conn sql params + runDB action + +deleteProjects :: AppContextM Int64 +deleteProjects = createDeleteEntitiesFn entityName + +deleteProjectsFiltered :: [(String, String)] -> AppContextM Int64 +deleteProjectsFiltered params = do + tenantUuid <- asks currentTenantUuid + createDeleteEntitiesByFn entityName (tenantQueryUuid tenantUuid : params) + +deleteProjectByUuid :: U.UUID -> AppContextM Int64 +deleteProjectByUuid uuid = do + tenantUuid <- asks currentTenantUuid + createDeleteEntityByFn entityName [tenantQueryUuid tenantUuid, ("uuid", U.toString uuid)] + +-- ------------------------------------------------------------------------------------------------------------------------------ +-- PRIVATE +-- ------------------------------------------------------------------------------------------------------------------------------ +projectSelectSql tenantUuid userUuid perm = + f' + "SELECT project.* \ + \FROM project \ + \LEFT JOIN project_perm_user ON project.uuid = project_perm_user.project_uuid \ + \LEFT JOIN project_perm_group ON project.uuid = project_perm_group.project_uuid \ + \WHERE %s %s" + [projectWhereSql tenantUuid userUuid perm] + +projectWhereSql tenantUuid userUuid perm = + f' + "project.tenant_uuid = '%s' \ + \AND (visibility = 'VisibleEditProjectVisibility' \ + \OR visibility = 'VisibleCommentProjectVisibility' \ + \OR visibility = 'VisibleViewProjectVisibility' \ + \OR (visibility = 'PrivateProjectVisibility' AND project_perm_user.user_uuid = '%s' AND project_perm_user.perms @> ARRAY %s))" + [tenantUuid, userUuid, perm] + +enhance :: Project -> AppContextM Project +enhance project = do + ps <- findProjectPermsFiltered [("project_uuid", U.toString project.uuid)] + return $ project {permissions = ps} diff --git a/wizard-server/src/Wizard/Database/DAO/Project/ProjectEventDAO.hs b/wizard-server/src/Wizard/Database/DAO/Project/ProjectEventDAO.hs new file mode 100644 index 000000000..f89323d0c --- /dev/null +++ b/wizard-server/src/Wizard/Database/DAO/Project/ProjectEventDAO.hs @@ -0,0 +1,217 @@ +module Wizard.Database.DAO.Project.ProjectEventDAO where + +import Control.Monad (unless, void) +import Control.Monad.Reader (asks) +import Data.Foldable (traverse_) +import qualified Data.List as L +import Data.String (fromString) +import qualified Data.UUID as U +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.ToField +import Database.PostgreSQL.Simple.ToRow +import GHC.Int + +import Shared.Common.Model.Common.Lens +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.PageMetadata +import Shared.Common.Model.Common.Pageable +import Shared.Common.Model.Common.Sort +import Shared.Common.Util.Logger +import Shared.Common.Util.String +import Wizard.Database.DAO.Common +import Wizard.Database.Mapping.Project.ProjectEvent () +import Wizard.Database.Mapping.Project.ProjectEventList () +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.ContextLenses () +import Wizard.Model.Project.Event.ProjectEvent +import Wizard.Model.Project.Event.ProjectEventLenses () +import Wizard.Model.Project.Event.ProjectEventList + +entityName = "project_event" + +pageLabel = "projectEvents" + +findProjectEventsPage :: U.UUID -> Pageable -> [Sort] -> AppContextM (Page ProjectEventList) +findProjectEventsPage projectUuid pageable sort = do + -- 1. Prepare variables + do + tenantUuid <- asks (.tenantUuid') + let (sizeI, pageI, skip, limit) = preparePaginationVariables pageable + -- 2. Get total count + let countSql = + fromString + "SELECT count(*) \ + \FROM project_event \ + \WHERE tenant_uuid = ? AND project_uuid = ?" + let countParams = [U.toString tenantUuid, U.toString projectUuid] + logQuery countSql countParams + let action conn = query conn countSql countParams + result <- runDB action + let count = + case result of + [count] -> fromOnly count + _ -> 0 + -- 3. Get entities + let sql = + fromString $ + f'' + "SELECT project_event.uuid, \ + \ project_event.event_type, \ + \ project_event.path, \ + \ project_event.created_at, \ + \ project_event.value_type, \ + \ project_event.value, \ + \ project_event.value_id, \ + \ project_event.value_raw, \ + \ project_event.created_by AS created_by_uuid, \ + \ user_entity.first_name AS created_by_first_name, \ + \ user_entity.last_name AS created_by_last_name, \ + \ gravatar_hash(user_entity.email) AS created_by_gravatar_hash, \ + \ user_entity.image_url AS created_by_email \ + \FROM project_event \ + \ LEFT JOIN user_entity ON user_entity.uuid = project_event.created_by \ + \WHERE project_event.tenant_uuid = ? \ + \ AND project_event.project_uuid = ? \ + \${sort} \ + \OFFSET ${offset} \ + \LIMIT ${limit}" + [ ("sort", mapSort sort) + , ("offset", show skip) + , ("limit", show sizeI) + ] + let params = [U.toString tenantUuid, U.toString projectUuid] + logQuery sql params + let action conn = query conn sql params + entities <- runDB action + -- 4. Constructor response + let metadata = + PageMetadata + { size = sizeI + , totalElements = count + , totalPages = computeTotalPage count sizeI + , number = pageI + } + return $ Page pageLabel metadata entities + +findProjectEventsByProjectUuid :: U.UUID -> AppContextM [ProjectEvent] +findProjectEventsByProjectUuid projectUuid = do + tenantUuid <- asks currentTenantUuid + let sql = + "SELECT * \ + \FROM project_event \ + \WHERE tenant_uuid = ? AND project_uuid = ? \ + \ORDER BY created_at" + let params = [U.toString tenantUuid, U.toString projectUuid] + logInfoI _CMP_DATABASE sql + let action conn = query conn (fromString sql) params + runDB action + +findProjectEventListsByProjectUuid :: U.UUID -> AppContextM [ProjectEventList] +findProjectEventListsByProjectUuid projectUuid = do + tenantUuid <- asks currentTenantUuid + let sql = + fromString + "SELECT project_event.uuid, \ + \ project_event.event_type, \ + \ project_event.path, \ + \ project_event.created_at, \ + \ project_event.value_type, \ + \ project_event.value, \ + \ project_event.value_id, \ + \ project_event.value_raw, \ + \ project_event.created_by AS created_by_uuid, \ + \ user_entity.first_name AS created_by_first_name, \ + \ user_entity.last_name AS created_by_last_name, \ + \ gravatar_hash(user_entity.email) AS created_by_gravatar_hash, \ + \ user_entity.image_url AS created_by_email \ + \FROM project_event \ + \ LEFT JOIN user_entity ON user_entity.uuid = project_event.created_by \ + \WHERE project_event.tenant_uuid = ? \ + \ AND project_event.project_uuid = ? \ + \ORDER BY created_at" + let params = [U.toString tenantUuid, U.toString projectUuid] + logInfoI _CMP_DATABASE sql + let action conn = query conn (fromString sql) params + runDB action + +findProjectEventByUuid :: U.UUID -> AppContextM ProjectEvent +findProjectEventByUuid uuid = do + tenantUuid <- asks currentTenantUuid + createFindEntityWithFieldsByFn "*" False entityName [tenantQueryUuid tenantUuid, ("uuid", U.toString uuid)] + +findProjectEventByUuid' :: U.UUID -> AppContextM (Maybe ProjectEvent) +findProjectEventByUuid' uuid = do + tenantUuid <- asks currentTenantUuid + createFindEntityByFn' entityName [tenantQueryUuid tenantUuid, ("uuid", U.toString uuid)] + +insertProjectEvent :: ProjectEvent -> AppContextM Int64 +insertProjectEvent = createInsertFn entityName + +insertProjectEventWithTimestampUpdate :: U.UUID -> ProjectEvent -> AppContextM () +insertProjectEventWithTimestampUpdate projectUuid event = do + tenantUuid <- asks currentTenantUuid + let sql = + fromString $ + f' + "UPDATE project SET squashed = false, updated_at = now() WHERE tenant_uuid = ? AND uuid = ?; \ + \INSERT INTO project_event VALUES (%s)" + [generateQuestionMarks' event] + let params = + [ toField tenantUuid + , toField projectUuid + ] + ++ toRow event + logInsertAndUpdate sql params + let action conn = execute conn sql params + runDB action + return () + +insertProjectEvents :: [ProjectEvent] -> AppContextM Int64 +insertProjectEvents events = do + if null events + then return 0 + else do + tenantUuid <- asks currentTenantUuid + let sql = + fromString $ + f' + "INSERT INTO project_event VALUES %s" + [generateQuestionMarksForEntities events] + let params = concatMap toRow events + logInsertAndUpdate sql params + let action conn = execute conn sql params + runDB action + +updateProjectEventByUuid :: ProjectEvent -> AppContextM Int64 +updateProjectEventByUuid event = do + tenantUuid <- asks currentTenantUuid + let sql = fromString "UPDATE project_event SET uuid = ?, event_type = ?, path = ?, created_at = ?, created_by = ?, project_uuid = ?, tenant_uuid = ?, value_type = ?, value = ?, value_id = ?, value_raw = ? WHERE uuid = ? AND tenant_uuid = ?" + let params = toRow event ++ [toField (getUuid event), toField tenantUuid] + logQuery sql params + let action conn = execute conn sql params + runDB action + +syncProjectEventsWithDb :: [ProjectEvent] -> [ProjectEvent] -> AppContextM () +syncProjectEventsWithDb oldEvents newEvents = do + let dbEventMap = map getUuid oldEvents + let newEventMap = map getUuid newEvents + let toDelete = dbEventMap L.\\ newEventMap + let toInsert = filter (\e -> getUuid e `notElem` dbEventMap) newEvents + let toUpdate = filter (\e -> e `notElem` oldEvents && getUuid e `elem` dbEventMap) newEvents + unless (null toInsert) (void $ insertProjectEvents toInsert) + traverse_ updateProjectEventByUuid toUpdate + void $ deleteProjectEventsByUuids toDelete + +deleteProjectEvents :: AppContextM Int64 +deleteProjectEvents = createDeleteEntitiesFn entityName + +deleteProjectEventsByUuids :: [U.UUID] -> AppContextM () +deleteProjectEventsByUuids eventUuids = + unless + (null eventUuids) + (void $ createDeleteEntityWhereInFn entityName "uuid" (fmap U.toString eventUuids)) + +deleteProjectEventsByProjectUuid :: U.UUID -> AppContextM Int64 +deleteProjectEventsByProjectUuid projectUuid = do + tenantUuid <- asks currentTenantUuid + createDeleteEntitiesByFn entityName [tenantQueryUuid tenantUuid, ("project_uuid", U.toString projectUuid)] diff --git a/wizard-server/src/Wizard/Database/DAO/Project/ProjectFileDAO.hs b/wizard-server/src/Wizard/Database/DAO/Project/ProjectFileDAO.hs new file mode 100644 index 000000000..928b4f82f --- /dev/null +++ b/wizard-server/src/Wizard/Database/DAO/Project/ProjectFileDAO.hs @@ -0,0 +1,142 @@ +module Wizard.Database.DAO.Project.ProjectFileDAO where + +import Control.Monad.Reader (asks) +import Data.String +import Data.Time +import qualified Data.UUID as U +import Database.PostgreSQL.Simple +import GHC.Int + +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.PageMetadata +import Shared.Common.Model.Common.Pageable +import Shared.Common.Model.Common.Sort +import Shared.Common.Util.String +import Wizard.Database.DAO.Common +import Wizard.Database.Mapping.Project.File.ProjectFile () +import Wizard.Database.Mapping.Project.File.ProjectFileList () +import Wizard.Database.Mapping.Project.File.ProjectFileSimple () +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.ContextLenses () +import Wizard.Model.Project.File.ProjectFile +import Wizard.Model.Project.File.ProjectFileList +import Wizard.Model.Project.File.ProjectFileSimple + +entityName = "project_file" + +pageLabel = "projectFiles" + +findProjectFilesPage :: Maybe String -> Maybe U.UUID -> Pageable -> [Sort] -> AppContextM (Page ProjectFileList) +findProjectFilesPage mQuery mProjectUuid pageable sort = do + -- 1. Prepare variables + do + tenantUuid <- asks currentTenantUuid + let (queryCondition, queryParam) = + case mQuery of + Nothing -> ("", []) + Just query -> (" AND file_name ~* ?", [query]) + let (projectUuidCondition, projectUuidParam) = + case mProjectUuid of + Nothing -> ("", []) + Just projectUuid -> (" AND project_uuid = ?", [U.toString projectUuid]) + let condition = + f'' + "WHERE file.tenant_uuid = ? ${queryCondition} ${projectUuidCondition}" + [ ("queryCondition", queryCondition) + , ("projectUuidCondition", projectUuidCondition) + ] + let conditionParams = + [U.toString tenantUuid] + ++ queryParam + ++ projectUuidParam + let (sizeI, pageI, skip, limit) = preparePaginationVariables pageable + -- 2. Get total count + count <- createCountByFn "project_file file" condition conditionParams + -- 3. Get entities + let sql = + fromString $ + f'' + "SELECT file.uuid, \ + \ file.file_name, \ + \ file.content_type, \ + \ file.file_size, \ + \ file.created_at, \ + \ project.uuid, \ + \ project.name, \ + \ created_by.uuid, \ + \ created_by.first_name, \ + \ created_by.last_name, \ + \ created_by.email, \ + \ created_by.image_url \ + \FROM project_file file \ + \LEFT JOIN user_entity created_by ON created_by.uuid = file.created_by AND created_by.tenant_uuid = file.tenant_uuid \ + \LEFT JOIN project ON project.uuid = file.project_uuid AND project.tenant_uuid = file.tenant_uuid \ + \${condition} \ + \${sort} \ + \OFFSET ${offset} \ + \LIMIT ${limit}" + [ ("condition", condition) + , ("sort", mapSort sort) + , ("offset", show skip) + , ("limit", show sizeI) + ] + logQuery sql conditionParams + let action conn = query conn sql conditionParams + entities <- runDB action + -- 4. Constructor response + let metadata = + PageMetadata + { size = sizeI + , totalElements = count + , totalPages = computeTotalPage count sizeI + , number = pageI + } + return $ Page pageLabel metadata entities + +findProjectFilesByProject :: U.UUID -> AppContextM [ProjectFile] +findProjectFilesByProject projectUuid = do + tenantUuid <- asks currentTenantUuid + createFindEntitiesWithFieldsByFn "*" entityName [tenantQueryUuid tenantUuid, ("project_uuid", U.toString projectUuid)] + +findProjectFilesSimpleByProject :: U.UUID -> AppContextM [ProjectFileSimple] +findProjectFilesSimpleByProject projectUuid = do + tenantUuid <- asks currentTenantUuid + createFindEntitiesWithFieldsByFn "uuid, file_name, content_type, file_size" entityName [tenantQueryUuid tenantUuid, ("project_uuid", U.toString projectUuid)] + +findProjectFileByUuid :: U.UUID -> AppContextM ProjectFile +findProjectFileByUuid uuid = do + tenantUuid <- asks currentTenantUuid + createFindEntityByFn entityName [tenantQueryUuid tenantUuid, ("uuid", U.toString uuid)] + +sumProjectFileSize :: AppContextM Int64 +sumProjectFileSize = do + tenantUuid <- asks currentTenantUuid + sumProjectFileSizeWithTenant tenantUuid + +sumProjectFileSizeWithTenant :: U.UUID -> AppContextM Int64 +sumProjectFileSizeWithTenant tenantUuid = createSumByFn entityName "file_size" tenantCondition [U.toString tenantUuid] + +insertProjectFile :: ProjectFile -> AppContextM Int64 +insertProjectFile = createInsertFn entityName + +deleteProjectFiles :: AppContextM Int64 +deleteProjectFiles = createDeleteEntitiesFn entityName + +deleteProjectFilesNewerThen :: U.UUID -> UTCTime -> AppContextM Int64 +deleteProjectFilesNewerThen projectUuid timestamp = do + tenantUuid <- asks currentTenantUuid + let sql = + fromString + "DELETE FROM project_file \ + \WHERE tenant_uuid = ? \ + \ AND project_uuid = ? \ + \ AND created_at > ?" + let params = [U.toString tenantUuid, U.toString projectUuid, show timestamp] + logQuery sql params + let action conn = execute conn sql params + runDB action + +deleteProjectFileByUuid :: U.UUID -> AppContextM Int64 +deleteProjectFileByUuid uuid = do + tenantUuid <- asks currentTenantUuid + createDeleteEntityByFn entityName [tenantQueryUuid tenantUuid, ("uuid", U.toString uuid)] diff --git a/wizard-server/src/Wizard/Database/DAO/Project/ProjectImporterDAO.hs b/wizard-server/src/Wizard/Database/DAO/Project/ProjectImporterDAO.hs new file mode 100644 index 000000000..c1019f534 --- /dev/null +++ b/wizard-server/src/Wizard/Database/DAO/Project/ProjectImporterDAO.hs @@ -0,0 +1,169 @@ +module Wizard.Database.DAO.Project.ProjectImporterDAO where + +import Control.Monad.Reader (asks) +import Data.String (fromString) +import Data.Time +import qualified Data.UUID as U +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.ToField +import Database.PostgreSQL.Simple.ToRow +import GHC.Int + +import Shared.Common.Database.DAO.Common hiding (runInTransaction) +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.PageMetadata +import Shared.Common.Model.Common.Pageable +import Shared.Common.Model.Common.Sort +import Shared.Common.Util.Logger +import Wizard.Database.Mapping.Project.Importer.ProjectImporter () +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.ContextLenses () +import Wizard.Model.Project.Importer.ProjectImporter + +entityName = "project_importer" + +pageLabel = "projectImporters" + +findProjectImportersPage + :: Maybe String + -> Maybe String + -> Maybe String + -> Maybe Bool + -> Pageable + -> [Sort] + -> AppContextM (Page ProjectImporter) +findProjectImportersPage mOrganizationId mImporterId mQuery mEnabled pageable sort = + createFindEntitiesGroupByCoordinatePageableQuerySortFn + entityName + pageLabel + pageable + sort + "*" + "importer_id" + mQuery + mEnabled + mOrganizationId + mImporterId + +findProjectImporterById :: String -> AppContextM ProjectImporter +findProjectImporterById piId = do + tenantUuid <- asks currentTenantUuid + createFindEntityByFn entityName [tenantQueryUuid tenantUuid, ("id", piId)] + +insertProjectImporter :: ProjectImporter -> AppContextM Int64 +insertProjectImporter = createInsertFn entityName + +updateProjectImporterById :: ProjectImporter -> AppContextM Int64 +updateProjectImporterById importer = do + tenantUuid <- asks currentTenantUuid + let sql = + fromString + "UPDATE project_importer SET id = ?, name = ?, organization_id = ?, importer_id = ?, version = ?, metamodel_version = ?, description = ?, readme = ?, license = ?, allowed_packages = ?, url = ?, enabled = ?, tenant_uuid = ?, created_at = ?, updated_at = ? WHERE tenant_uuid = ? AND id = ?" + let params = toRow importer ++ [toField tenantUuid, toField importer.piId] + logQuery sql params + let action conn = execute conn sql params + runDB action + +updateProjectImporterPasswordById :: String -> Bool -> UTCTime -> AppContextM Int64 +updateProjectImporterPasswordById piId enabled uUpdatedAt = do + tenantUuid <- asks currentTenantUuid + let sql = fromString "UPDATE project_importer SET enabled = ?, updated_at = ? WHERE tenant_uuid = ? AND uuid = ?" + let params = [toField enabled, toField uUpdatedAt, toField tenantUuid, toField piId] + logQuery sql params + let action conn = execute conn sql params + runDB action + +deleteProjectImporters :: AppContextM Int64 +deleteProjectImporters = createDeleteEntitiesFn entityName + +deleteProjectImporterById :: String -> AppContextM Int64 +deleteProjectImporterById piId = do + tenantUuid <- asks currentTenantUuid + createDeleteEntityByFn entityName [tenantQueryUuid tenantUuid, ("id", piId)] + +-- -------------------------------- +-- PRIVATE +-- -------------------------------- +createFindEntitiesGroupByCoordinatePageableQuerySortFn entityName pageLabel pageable sort fields entityId mQuery mEnabled mOrganizationId mEntityId = + -- 1. Prepare variables + do + tenantUuid <- asks currentTenantUuid + let (sizeI, pageI, skip, limit) = preparePaginationVariables pageable + let enabledCondition = + case mEnabled of + Just True -> "enabled = true AND" + Just False -> "enabled = false AND" + _ -> "" + -- 2. Get total count + count <- createCountGroupByCoordinateFn entityName entityId mQuery enabledCondition mOrganizationId mEntityId + -- 3. Get entities + let sql = + f' + "SELECT %s \ + \FROM %s \ + \WHERE tenant_uuid = ? AND id IN ( \ + \ SELECT CONCAT(organization_id, ':', %s, ':', (max(string_to_array(version, '.')::int[]))[1] || '.' || \ + \ (max(string_to_array(version, '.')::int[]))[2] || '.' || \ + \ (max(string_to_array(version, '.')::int[]))[3]) \ + \ FROM %s \ + \ WHERE %s tenant_uuid = ? AND (name ~* ? OR id ~* ?) %s \ + \ GROUP BY organization_id, %s \ + \) \ + \%s \ + \offset %s \ + \limit %s" + [ fields + , entityName + , entityId + , entityName + , enabledCondition + , mapToDBCoordinatesSql entityName entityId mOrganizationId mEntityId + , entityId + , mapSort sort + , show skip + , show sizeI + ] + logInfo _CMP_DATABASE sql + let action conn = + query + conn + (fromString sql) + ( U.toString tenantUuid + : U.toString tenantUuid + : regexM mQuery + : regexM mQuery + : mapToDBCoordinatesParams mOrganizationId mEntityId + ) + entities <- runDB action + -- 4. Constructor response + let metadata = + PageMetadata + { size = sizeI + , totalElements = count + , totalPages = computeTotalPage count sizeI + , number = pageI + } + return $ Page pageLabel metadata entities + +createCountGroupByCoordinateFn + :: String -> String -> Maybe String -> String -> Maybe String -> Maybe String -> AppContextM Int +createCountGroupByCoordinateFn entityName entityId mQuery enabledCondition mOrganizationId mEntityId = do + tenantUuid <- asks currentTenantUuid + let sql = + f' + "SELECT COUNT(*) \ + \ FROM (SELECT COUNT(*) \ + \ FROM %s \ + \ WHERE %s tenant_uuid = ? AND (name ~* ? OR id ~* ?) %s \ + \ GROUP BY organization_id, %s) p" + [entityName, enabledCondition, mapToDBCoordinatesSql entityName entityId mOrganizationId mEntityId, entityId] + logInfo _CMP_DATABASE sql + let action conn = + query + conn + (fromString sql) + (U.toString tenantUuid : regexM mQuery : regexM mQuery : mapToDBCoordinatesParams mOrganizationId mEntityId) + result <- runDB action + case result of + [count] -> return . fromOnly $ count + _ -> return 0 diff --git a/wizard-server/src/Wizard/Database/DAO/Project/ProjectMigrationDAO.hs b/wizard-server/src/Wizard/Database/DAO/Project/ProjectMigrationDAO.hs new file mode 100644 index 000000000..e5aa87f8b --- /dev/null +++ b/wizard-server/src/Wizard/Database/DAO/Project/ProjectMigrationDAO.hs @@ -0,0 +1,68 @@ +module Wizard.Database.DAO.Project.ProjectMigrationDAO where + +import Control.Monad.Reader (asks) +import Data.String +import qualified Data.UUID as U +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.ToField +import Database.PostgreSQL.Simple.ToRow +import GHC.Int + +import Wizard.Database.DAO.Common +import Wizard.Database.Mapping.Project.Migration.ProjectMigration () +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.ContextLenses () +import Wizard.Model.Project.Migration.ProjectMigration + +entityName = "project_migration" + +pageLabel = "migrations" + +findProjectMigrations :: AppContextM [ProjectMigration] +findProjectMigrations = do + tenantUuid <- asks currentTenantUuid + createFindEntitiesByFn entityName [tenantQueryUuid tenantUuid] + +findProjectMigrationsByOldProjectUuid :: U.UUID -> AppContextM [ProjectMigration] +findProjectMigrationsByOldProjectUuid oldProjectUuid = do + tenantUuid <- asks currentTenantUuid + createFindEntitiesByFn entityName [tenantQueryUuid tenantUuid, ("old_project_uuid", U.toString oldProjectUuid)] + +findProjectMigrationByNewProjectUuid :: U.UUID -> AppContextM ProjectMigration +findProjectMigrationByNewProjectUuid newProjectUuid = do + tenantUuid <- asks currentTenantUuid + createFindEntityByFn entityName [tenantQueryUuid tenantUuid, ("new_project_uuid", U.toString newProjectUuid)] + +findProjectMigrationByNewProjectUuid' :: U.UUID -> AppContextM (Maybe ProjectMigration) +findProjectMigrationByNewProjectUuid' newProjectUuid = do + tenantUuid <- asks currentTenantUuid + createFindEntityByFn' entityName [tenantQueryUuid tenantUuid, ("new_project_uuid", U.toString newProjectUuid)] + +insertProjectMigration :: ProjectMigration -> AppContextM Int64 +insertProjectMigration ms = do + let sql = + fromString + "INSERT INTO project_migration VALUES (?, ?, ?::uuid[], ?)" + let params = toRow ms + logQuery sql params + let action conn = execute conn sql params + runDB action + +updateProjectMigrationByNewProjectUuid :: ProjectMigration -> AppContextM Int64 +updateProjectMigrationByNewProjectUuid ms = do + tenantUuid <- asks currentTenantUuid + let sql = + fromString + "UPDATE project_migration SET old_project_uuid = ?, new_project_uuid = ?, resolved_question_uuids = ?::uuid[], tenant_uuid = ? WHERE tenant_uuid = ? AND new_project_uuid = ?" + let params = toRow ms ++ [toField tenantUuid, toField ms.newProjectUuid] + logQuery sql params + let action conn = execute conn sql params + runDB action + +deleteProjectMigrations :: AppContextM Int64 +deleteProjectMigrations = createDeleteEntitiesFn entityName + +deleteProjectMigrationByNewProjectUuid :: U.UUID -> AppContextM Int64 +deleteProjectMigrationByNewProjectUuid newProjectUuid = do + tenantUuid <- asks currentTenantUuid + createDeleteEntityByFn entityName [tenantQueryUuid tenantUuid, ("new_project_uuid", U.toString newProjectUuid)] diff --git a/wizard-server/src/Wizard/Database/DAO/Project/ProjectPermDAO.hs b/wizard-server/src/Wizard/Database/DAO/Project/ProjectPermDAO.hs new file mode 100644 index 000000000..a981f5db5 --- /dev/null +++ b/wizard-server/src/Wizard/Database/DAO/Project/ProjectPermDAO.hs @@ -0,0 +1,57 @@ +module Wizard.Database.DAO.Project.ProjectPermDAO where + +import Control.Monad.Reader (asks) +import Data.String +import qualified Data.UUID as U +import Database.PostgreSQL.Simple +import GHC.Int + +import Shared.Common.Util.Logger +import Wizard.Database.DAO.Common +import Wizard.Database.Mapping.Project.ProjectPerm () +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.ContextLenses () +import Wizard.Model.Project.Acl.ProjectPerm + +entityName_user = "project_perm_user" + +entityName_group = "project_perm_group" + +findProjectPermsFiltered :: [(String, String)] -> AppContextM [ProjectPerm] +findProjectPermsFiltered queryParams = do + let sql = + fromString $ + f' + "SELECT project_uuid, 'UserProjectPermType' AS member_type, user_uuid as member_uuid, perms, tenant_uuid \ + \ FROM %s \ + \ WHERE %s \ + \ UNION \ + \ SELECT project_uuid, 'UserGroupProjectPermType' AS member_type, user_group_uuid as member_uuid, perms, tenant_uuid \ + \ FROM %s \ + \ WHERE %s" + [entityName_user, mapToDBQuerySql queryParams, entityName_group, mapToDBQuerySql queryParams] + let params = fmap snd queryParams ++ fmap snd queryParams + logQuery sql params + let action conn = query conn sql params + runDB action + +insertProjectPerm :: ProjectPerm -> AppContextM Int64 +insertProjectPerm perm = + case perm.memberType of + UserProjectPermType -> createInsertFn entityName_user perm + UserGroupProjectPermType -> createInsertFn entityName_group perm + +deleteProjectPerms :: AppContextM Int64 +deleteProjectPerms = do + createDeleteEntitiesFn entityName_user + createDeleteEntitiesFn entityName_group + +deleteProjectPermsFiltered :: [(String, String)] -> AppContextM Int64 +deleteProjectPermsFiltered queryParams = do + createDeleteEntitiesByFn entityName_user queryParams + createDeleteEntitiesByFn entityName_group queryParams + +deleteProjectPermGroupByUserGroupUuid :: U.UUID -> AppContextM Int64 +deleteProjectPermGroupByUserGroupUuid userGroupUuid = do + tenantUuid <- asks currentTenantUuid + createDeleteEntitiesByFn entityName_group [tenantQueryUuid tenantUuid, ("user_group_uuid", U.toString userGroupUuid)] diff --git a/wizard-server/src/Wizard/Database/DAO/Project/ProjectTagDAO.hs b/wizard-server/src/Wizard/Database/DAO/Project/ProjectTagDAO.hs new file mode 100644 index 000000000..012f7c536 --- /dev/null +++ b/wizard-server/src/Wizard/Database/DAO/Project/ProjectTagDAO.hs @@ -0,0 +1,63 @@ +module Wizard.Database.DAO.Project.ProjectTagDAO where + +import Control.Monad.Reader (asks) +import Data.String +import qualified Data.UUID as U + +import Shared.Common.Database.DAO.Common +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.Pageable +import Shared.Common.Model.Common.Sort +import Shared.Common.Util.Logger +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.ContextLenses () + +pageLabel = "projectTags" + +findProjectTagsPage :: Maybe String -> [String] -> Pageable -> [Sort] -> AppContextM (Page String) +findProjectTagsPage mQuery excludeTags pageable sort = + -- 1. Prepare variables + do + tenantUuid <- asks currentTenantUuid + let params = [U.toString tenantUuid, U.toString tenantUuid, regexM mQuery] ++ excludeTags + let (sizeI, pageI, skip, limit) = preparePaginationVariables pageable + -- 2. Get total count + count <- findCount excludeTags params + -- 3. Prepare SQL + let sql = + fromString $ + f' + "SELECT * \ + \FROM (%s) merged \ + \WHERE merged.project_tag ~* ? %s \ + \%s \ + \OFFSET %s LIMIT %s" + [sqlBase, excludeTagsCondition excludeTags, mapSort sort, show skip, show sizeI] + createFindColumnBySqlPageFn pageLabel pageable sql params count + +findCount :: [String] -> [String] -> AppContextM Int +findCount excludeTags params = do + let sql = + fromString $ + f' + "SELECT COUNT(*) \ + \FROM (%s) merged \ + \WHERE merged.project_tag::text ~* ? %s" + [sqlBase, excludeTagsCondition excludeTags] + createCountWithSqlFn sql params + +sqlBase :: String +sqlBase = + "SELECT unnest(project_tagging_tags) as project_tag \ + \FROM config_project \ + \WHERE tenant_uuid = ? \ + \UNION \ + \SELECT nested.project_tag \ + \FROM (SELECT unnest(project_tags) as project_tag, tenant_uuid FROM project) nested \ + \WHERE nested.tenant_uuid = ? " + +excludeTagsCondition :: [String] -> String +excludeTagsCondition excludeTags = + if null excludeTags + then "" + else f' "AND NOT (project_tag IN (%s))" [generateQuestionMarks excludeTags] diff --git a/wizard-server/src/Wizard/Database/DAO/Project/ProjectUserDAO.hs b/wizard-server/src/Wizard/Database/DAO/Project/ProjectUserDAO.hs new file mode 100644 index 000000000..57d11a996 --- /dev/null +++ b/wizard-server/src/Wizard/Database/DAO/Project/ProjectUserDAO.hs @@ -0,0 +1,122 @@ +module Wizard.Database.DAO.Project.ProjectUserDAO where + +import Control.Monad.Reader (asks) +import Data.String (fromString) +import qualified Data.UUID as U +import Database.PostgreSQL.Simple + +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.PageMetadata +import Shared.Common.Model.Common.Pageable +import Shared.Common.Model.Common.Sort +import Shared.Common.Util.String +import Wizard.Database.DAO.Common +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.ContextLenses () +import WizardLib.Public.Database.Mapping.User.UserSimple () +import WizardLib.Public.Model.User.UserSimple + +findProjectUserSuggestionsPage :: U.UUID -> String -> Maybe String -> Pageable -> [Sort] -> AppContextM (Page UserSimple) +findProjectUserSuggestionsPage projectUuid perm mQuery pageable sort = + -- 1. Prepare variables + do + tenantUuid <- asks currentTenantUuid + let (qCondition, qRegex) = + ( "WHERE (concat(first_name, ' ', last_name) ~* ? OR email ~* ?)" + , [regexM mQuery, regexM mQuery] + ) + let params = [U.toString projectUuid, U.toString tenantUuid, U.toString projectUuid, U.toString tenantUuid] ++ qRegex + let (sizeI, pageI, skip, limit) = preparePaginationVariables pageable + -- 2. Get total count + let countSql = + fromString $ + f'' + "SELECT DISTINCT COUNT(uuid) \ + \FROM (SELECT u.uuid, \ + \ u.first_name, \ + \ u.last_name, \ + \ u.email \ + \ FROM project_perm_user \ + \ JOIN user_entity u ON project_perm_user.user_uuid = u.uuid AND project_perm_user.tenant_uuid = u.tenant_uuid \ + \ WHERE project_perm_user.project_uuid = ? \ + \ AND project_perm_user.tenant_uuid = ? \ + \ AND project_perm_user.perms @> ARRAY ['${perm}'] \ + \ AND u.active = true \ + \ AND u.machine = false \ + \ UNION ALL \ + \ SELECT u.uuid, \ + \ u.first_name, \ + \ u.last_name, \ + \ u.email \ + \ FROM project_perm_group \ + \ LEFT JOIN user_group_membership ug_membership ON ug_membership.user_group_uuid = project_perm_group.user_group_uuid AND ug_membership.tenant_uuid = project_perm_group.tenant_uuid \ + \ LEFT JOIN user_entity u ON u.uuid = ug_membership.user_uuid AND u.tenant_uuid = project_perm_group.tenant_uuid \ + \ WHERE project_perm_group.project_uuid = ? \ + \ AND project_perm_group.tenant_uuid = ? \ + \ AND project_perm_group.perms @> ARRAY ['${perm}'] \ + \ AND u.active = true \ + \ AND u.machine = false) u \ + \${qCondition}" + [ ("qCondition", qCondition) + , ("perm", perm) + ] + logQuery countSql params + let action conn = query conn countSql params + result <- runDB action + let count = + case result of + [count] -> fromOnly count + _ -> 0 + -- 3. Get entities + let sql = + fromString $ + f'' + "SELECT DISTINCT * \ + \FROM (SELECT u.uuid, \ + \ u.first_name, \ + \ u.last_name, \ + \ u.email, \ + \ u.image_url \ + \ FROM project_perm_user \ + \ JOIN user_entity u ON project_perm_user.user_uuid = u.uuid AND project_perm_user.tenant_uuid = u.tenant_uuid \ + \ WHERE project_perm_user.project_uuid = ? \ + \ AND project_perm_user.tenant_uuid = ? \ + \ AND project_perm_user.perms @> ARRAY ['${perm}'] \ + \ AND u.active = true \ + \ AND u.machine = false \ + \ UNION ALL \ + \ SELECT u.uuid, \ + \ u.first_name, \ + \ u.last_name, \ + \ u.email, \ + \ u.image_url \ + \ FROM project_perm_group \ + \ LEFT JOIN user_group_membership ug_membership ON ug_membership.user_group_uuid = project_perm_group.user_group_uuid AND ug_membership.tenant_uuid = project_perm_group.tenant_uuid \ + \ LEFT JOIN user_entity u ON u.uuid = ug_membership.user_uuid AND u.tenant_uuid = project_perm_group.tenant_uuid \ + \ WHERE project_perm_group.project_uuid = ? \ + \ AND project_perm_group.tenant_uuid = ? \ + \ AND project_perm_group.perms @> ARRAY ['${perm}'] \ + \ AND u.active = true \ + \ AND u.machine = false) u \ + \${qCondition} \ + \${sort} \ + \OFFSET ${offset} \ + \LIMIT ${limit}" + [ ("qCondition", qCondition) + , ("perm", perm) + , ("sort", mapSort sort) + , ("offset", show skip) + , ("limit", show sizeI) + ] + logQuery sql params + let action conn = query conn sql params + entities <- runDB action + -- 5. Constructor response + let metadata = + PageMetadata + { size = sizeI + , totalElements = count + , totalPages = computeTotalPage count sizeI + , number = pageI + } + return $ Page "users" metadata entities diff --git a/wizard-server/src/Wizard/Database/DAO/Project/ProjectVersionDAO.hs b/wizard-server/src/Wizard/Database/DAO/Project/ProjectVersionDAO.hs new file mode 100644 index 000000000..5c63f53e4 --- /dev/null +++ b/wizard-server/src/Wizard/Database/DAO/Project/ProjectVersionDAO.hs @@ -0,0 +1,97 @@ +module Wizard.Database.DAO.Project.ProjectVersionDAO where + +import Control.Monad (unless, void) +import Control.Monad.Reader (asks) +import Data.String (fromString) +import Data.Time +import qualified Data.UUID as U +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.ToField +import Database.PostgreSQL.Simple.ToRow +import GHC.Int + +import Shared.Common.Util.Logger +import Shared.Common.Util.String +import Wizard.Database.DAO.Common +import Wizard.Database.Mapping.Project.Version.ProjectVersion () +import Wizard.Database.Mapping.Project.Version.ProjectVersionList () +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.ContextLenses () +import Wizard.Model.Project.Version.ProjectVersion +import Wizard.Model.Project.Version.ProjectVersionList + +entityName = "project_version" + +pageLabel = "projectVersions" + +findProjectVersionsByProjectUuid :: U.UUID -> AppContextM [ProjectVersion] +findProjectVersionsByProjectUuid projectUuid = do + tenantUuid <- asks currentTenantUuid + createFindEntitiesWithFieldsByFn "*" entityName [tenantQueryUuid tenantUuid, ("project_uuid", U.toString projectUuid)] + +findProjectVersionListByProjectUuidAndCreatedAt :: U.UUID -> Maybe UTCTime -> AppContextM [ProjectVersionList] +findProjectVersionListByProjectUuidAndCreatedAt projectUuid mCreatedAt = do + tenantUuid <- asks currentTenantUuid + let (createdAtCondition, createdAtParams) = + case mCreatedAt of + Just createdAt -> ("AND v.created_at <= ?", [toField createdAt]) + Nothing -> ("", []) + let sql = + fromString $ + f'' + "SELECT v.uuid, \ + \ v.name, \ + \ v.description, \ + \ v.event_uuid, \ + \ v.created_at, \ + \ v.updated_at, \ + \ u.uuid, \ + \ u.first_name, \ + \ u.last_name, \ + \ u.email, \ + \ u.image_url \ + \FROM project_version v \ + \JOIN user_entity u ON u.uuid = v.created_by AND u.tenant_uuid = v.tenant_uuid ${createdAtCondition} \ + \WHERE v.tenant_uuid = ? AND v.project_uuid = ? \ + \ORDER BY v.created_at" + [("createdAtCondition", createdAtCondition)] + let params = createdAtParams ++ [toField tenantUuid, toField projectUuid] + logInfoI _CMP_DATABASE sql + let action conn = query conn (fromString sql) params + runDB action + +findProjectVersionByUuid :: U.UUID -> AppContextM ProjectVersion +findProjectVersionByUuid uuid = do + tenantUuid <- asks currentTenantUuid + createFindEntityWithFieldsByFn "*" False entityName [tenantQueryUuid tenantUuid, ("uuid", U.toString uuid)] + +findProjectVersionByEventUuid' :: U.UUID -> U.UUID -> AppContextM (Maybe ProjectVersion) +findProjectVersionByEventUuid' projectUuid eventUuid = do + tenantUuid <- asks currentTenantUuid + createFindEntityByFn' entityName [tenantQueryUuid tenantUuid, ("project_uuid", U.toString projectUuid), ("event_uuid", U.toString eventUuid)] + +insertProjectVersion :: ProjectVersion -> AppContextM Int64 +insertProjectVersion = createInsertFn entityName + +updateProjectVersionByUuid :: ProjectVersion -> AppContextM Int64 +updateProjectVersionByUuid version = do + tenantUuid <- asks currentTenantUuid + let sql = fromString "UPDATE project_version SET uuid = ?, name = ?, description = ?, event_uuid = ?, project_uuid = ?, tenant_uuid = ?, created_by = ?, created_at = ?, updated_at = ? WHERE uuid = ? AND tenant_uuid = ?" + let params = toRow version ++ [toField version.uuid, toField tenantUuid] + logQuery sql params + let action conn = execute conn sql params + runDB action + +deleteProjectVersions :: AppContextM Int64 +deleteProjectVersions = createDeleteEntitiesFn entityName + +deleteProjectVersionsByUuids :: [U.UUID] -> AppContextM () +deleteProjectVersionsByUuids versionUuids = + unless + (null versionUuids) + (void $ createDeleteEntityWhereInFn entityName "uuid" (fmap U.toString versionUuids)) + +deleteProjectVersionByUuid :: U.UUID -> AppContextM Int64 +deleteProjectVersionByUuid uuid = do + tenantUuid <- asks currentTenantUuid + createDeleteEntitiesByFn entityName [tenantQueryUuid tenantUuid, ("uuid", U.toString uuid)] diff --git a/wizard-server/src/Wizard/Database/DAO/Questionnaire/MigratorDAO.hs b/wizard-server/src/Wizard/Database/DAO/Questionnaire/MigratorDAO.hs deleted file mode 100644 index 3c7a785e8..000000000 --- a/wizard-server/src/Wizard/Database/DAO/Questionnaire/MigratorDAO.hs +++ /dev/null @@ -1,68 +0,0 @@ -module Wizard.Database.DAO.Questionnaire.MigratorDAO where - -import Control.Monad.Reader (asks) -import Data.String -import qualified Data.UUID as U -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.ToField -import Database.PostgreSQL.Simple.ToRow -import GHC.Int - -import Wizard.Database.DAO.Common -import Wizard.Database.Mapping.Questionnaire.MigratorState () -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.ContextLenses () -import Wizard.Model.Questionnaire.MigratorState - -entityName = "questionnaire_migration" - -pageLabel = "migrations" - -findMigratorStates :: AppContextM [MigratorState] -findMigratorStates = do - tenantUuid <- asks currentTenantUuid - createFindEntitiesByFn entityName [tenantQueryUuid tenantUuid] - -findMigratorStatesByOldQuestionnaireUuid :: U.UUID -> AppContextM [MigratorState] -findMigratorStatesByOldQuestionnaireUuid oldQtnUuid = do - tenantUuid <- asks currentTenantUuid - createFindEntitiesByFn entityName [tenantQueryUuid tenantUuid, ("old_questionnaire_uuid", U.toString oldQtnUuid)] - -findMigratorStateByNewQuestionnaireUuid :: U.UUID -> AppContextM MigratorState -findMigratorStateByNewQuestionnaireUuid newQuestionnaireUuid = do - tenantUuid <- asks currentTenantUuid - createFindEntityByFn entityName [tenantQueryUuid tenantUuid, ("new_questionnaire_uuid", U.toString newQuestionnaireUuid)] - -findMigratorStateByNewQuestionnaireUuid' :: U.UUID -> AppContextM (Maybe MigratorState) -findMigratorStateByNewQuestionnaireUuid' newQuestionnaireUuid = do - tenantUuid <- asks currentTenantUuid - createFindEntityByFn' entityName [tenantQueryUuid tenantUuid, ("new_questionnaire_uuid", U.toString newQuestionnaireUuid)] - -insertMigratorState :: MigratorState -> AppContextM Int64 -insertMigratorState ms = do - let sql = - fromString - "INSERT INTO questionnaire_migration VALUES (?, ?, ?::uuid[], ?)" - let params = toRow ms - logQuery sql params - let action conn = execute conn sql params - runDB action - -updateMigratorStateByNewQuestionnaireUuid :: MigratorState -> AppContextM Int64 -updateMigratorStateByNewQuestionnaireUuid ms = do - tenantUuid <- asks currentTenantUuid - let sql = - fromString - "UPDATE questionnaire_migration SET old_questionnaire_uuid = ?, new_questionnaire_uuid = ?, resolved_question_uuids = ?::uuid[], tenant_uuid = ? WHERE tenant_uuid = ? AND new_questionnaire_uuid = ?" - let params = toRow ms ++ [toField tenantUuid, toField ms.newQuestionnaireUuid] - logQuery sql params - let action conn = execute conn sql params - runDB action - -deleteMigratorStates :: AppContextM Int64 -deleteMigratorStates = createDeleteEntitiesFn entityName - -deleteMigratorStateByNewQuestionnaireUuid :: U.UUID -> AppContextM Int64 -deleteMigratorStateByNewQuestionnaireUuid newQuestionnaireUuid = do - tenantUuid <- asks currentTenantUuid - createDeleteEntityByFn entityName [tenantQueryUuid tenantUuid, ("new_questionnaire_uuid", U.toString newQuestionnaireUuid)] diff --git a/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireCommentDAO.hs b/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireCommentDAO.hs deleted file mode 100644 index ac9d771b0..000000000 --- a/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireCommentDAO.hs +++ /dev/null @@ -1,87 +0,0 @@ -module Wizard.Database.DAO.Questionnaire.QuestionnaireCommentDAO where - -import Control.Monad.Reader (asks, liftIO) -import Data.String -import Data.Time -import qualified Data.UUID as U -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.ToField -import Database.PostgreSQL.Simple.ToRow -import GHC.Int - -import Shared.Common.Util.String -import Wizard.Database.DAO.Common -import Wizard.Database.Mapping.Questionnaire.QuestionnaireComment () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireCommentThread () -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.ContextLenses () -import Wizard.Model.Questionnaire.QuestionnaireComment - -entityName = "questionnaire_comment" - -insertQuestionnaireComment :: QuestionnaireComment -> AppContextM Int64 -insertQuestionnaireComment = createInsertFn entityName - -insertQuestionnaireThreadAndComment :: QuestionnaireCommentThread -> QuestionnaireComment -> AppContextM Int64 -insertQuestionnaireThreadAndComment thread comment = do - let sql = - fromString $ - f' - "BEGIN TRANSACTION; \ - \INSERT INTO %s VALUES (%s); \ - \INSERT INTO %s VALUES (%s); \ - \COMMIT;" - ["questionnaire_comment_thread", generateQuestionMarks' thread, entityName, generateQuestionMarks' comment] - let params = toRow thread ++ toRow comment - logInsertAndUpdate sql params - let action conn = execute conn sql params - runDB action - -insertQuestionnaireThreadAndComment' :: QuestionnaireCommentThread -> QuestionnaireComment -> AppContextM Int64 -insertQuestionnaireThreadAndComment' thread comment = do - let sql = - fromString $ - f' - "INSERT INTO %s VALUES (%s); \ - \INSERT INTO %s VALUES (%s); " - ["questionnaire_comment_thread", generateQuestionMarks' thread, entityName, generateQuestionMarks' comment] - let params = toRow thread ++ toRow comment - logInsertAndUpdate sql params - let action conn = execute conn sql params - runDB action - -updateQuestionnaireCommentById :: QuestionnaireComment -> AppContextM QuestionnaireComment -updateQuestionnaireCommentById entity = do - tenantUuid <- asks currentTenantUuid - now <- liftIO getCurrentTime - let updatedEntity = entity {updatedAt = now} :: QuestionnaireComment - let sql = - fromString - "UPDATE questionnaire_comment SET uuid = ?, text = ?, created_by = ?, created_at = ?, updated_at = ?, tenant_uuid = ? WHERE uuid = ? AND tenant_uuid = ?" - let params = toRow updatedEntity ++ [toField updatedEntity.uuid, toField tenantUuid] - logQuery sql params - let action conn = execute conn sql params - runDB action - return updatedEntity - -updateQuestionnaireCommentTextById :: U.UUID -> String -> AppContextM Int64 -updateQuestionnaireCommentTextById uuid text = do - tenantUuid <- asks currentTenantUuid - let sql = fromString "UPDATE questionnaire_comment SET text = ?, updated_at = now() WHERE uuid = ? AND tenant_uuid = ?" - let params = [toField text, toField uuid, toField tenantUuid] - logQuery sql params - let action conn = execute conn sql params - runDB action - -deleteQuestionnaireComments :: AppContextM Int64 -deleteQuestionnaireComments = createDeleteEntitiesFn entityName - -deleteQuestionnaireCommentsByThreadUuid :: U.UUID -> AppContextM Int64 -deleteQuestionnaireCommentsByThreadUuid threadUuid = do - tenantUuid <- asks currentTenantUuid - createDeleteEntityByFn entityName [("comment_thread_uuid", U.toString threadUuid), ("tenant_uuid", U.toString tenantUuid)] - -deleteQuestionnaireCommentById :: U.UUID -> AppContextM Int64 -deleteQuestionnaireCommentById uuid = do - tenantUuid <- asks currentTenantUuid - createDeleteEntityByFn entityName [("uuid", U.toString uuid), ("tenant_uuid", U.toString tenantUuid)] diff --git a/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireCommentThreadDAO.hs b/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireCommentThreadDAO.hs deleted file mode 100644 index 2e20acc71..000000000 --- a/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireCommentThreadDAO.hs +++ /dev/null @@ -1,373 +0,0 @@ -module Wizard.Database.DAO.Questionnaire.QuestionnaireCommentThreadDAO where - -import Control.Monad.Except (throwError) -import Control.Monad.Reader (asks, liftIO) -import qualified Data.Map.Strict as M -import Data.String -import Data.Time -import qualified Data.UUID as U -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.ToField -import Database.PostgreSQL.Simple.ToRow -import GHC.Int - -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.PageMetadata -import Shared.Common.Model.Common.Pageable -import Shared.Common.Model.Common.Sort -import Shared.Common.Model.Error.Error -import Shared.Common.Util.Logger -import Shared.Common.Util.Map (doubleGroupBy) -import Shared.Common.Util.String -import Shared.Common.Util.Uuid -import Wizard.Api.Resource.User.UserDTO -import Wizard.Database.DAO.Common -import Wizard.Database.Mapping.Questionnaire.QuestionnaireCommentThread () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireCommentThreadAssigned () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireCommentThreadList () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireCommentThreadNotification () -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.AppContextHelpers -import Wizard.Model.Context.ContextLenses () -import Wizard.Model.Questionnaire.QuestionnaireComment -import Wizard.Model.Questionnaire.QuestionnaireCommentList -import Wizard.Model.Questionnaire.QuestionnaireCommentThreadAssigned -import Wizard.Model.Questionnaire.QuestionnaireCommentThreadNotification - -entityName = "questionnaire_comment_thread" - -findAssignedQuestionnaireCommentThreadsPage :: Maybe String -> Maybe U.UUID -> Maybe Bool -> Pageable -> [Sort] -> AppContextM (Page QuestionnaireCommentThreadAssigned) -findAssignedQuestionnaireCommentThreadsPage mQuery mQuestionnaireUuid mResolved pageable sort = do - -- 1. Prepare variables - currentUser <- getCurrentUser - tenantUuid <- asks currentTenantUuid - let (qCondition, qRegex) = - case mQuery of - Just query -> (" AND comment.text ~* ?", [regex query]) - Nothing -> ("", []) - let (questionnaireUuidCondition, questionnaireUuidParam) = - case mQuestionnaireUuid of - Just questionnaireUuid -> ("AND qtn.uuid = ?", [U.toString questionnaireUuid]) - Nothing -> ("", []) - let resolvedCondition = - case mResolved of - Just True -> "AND thread.resolved = true" - Just False -> "AND thread.resolved = false" - Nothing -> "" - let params = - [U.toString tenantUuid, U.toString currentUser.uuid] - ++ qRegex - ++ questionnaireUuidParam - let (sizeI, pageI, skip, limit) = preparePaginationVariables pageable - -- 2. Get total count - let countSql = - fromString $ - f'' - "SELECT COUNT(DISTINCT thread.uuid) \ - \FROM questionnaire_comment_thread thread \ - \JOIN questionnaire qtn ON qtn.uuid = thread.questionnaire_uuid AND qtn.tenant_uuid = thread.tenant_uuid \ - \LEFT JOIN questionnaire_comment comment ON comment.comment_thread_uuid = thread.uuid AND comment.tenant_uuid = thread.tenant_uuid \ - \WHERE thread.tenant_uuid = ? \ - \ AND thread.assigned_to = ? \ - \ AND comment.uuid = (SELECT comment.uuid \ - \ FROM questionnaire_comment comment \ - \ WHERE comment.comment_thread_uuid = thread.uuid AND comment.tenant_uuid = thread.tenant_uuid \ - \ ORDER BY comment.created_at \ - \ LIMIT 1) \ - \ ${qCondition} \ - \ ${questionnaireUuidCondition} \ - \ ${resolvedCondition}" - [ ("qCondition", qCondition) - , ("questionnaireUuidCondition", questionnaireUuidCondition) - , ("resolvedCondition", resolvedCondition) - ] - logQuery countSql params - let action conn = query conn countSql params - result <- runDB action - let count = - case result of - [count] -> fromOnly count - _ -> 0 - -- 3. Get entities - let sql = - fromString $ - f'' - "SELECT qtn.uuid, \ - \ qtn.name, \ - \ thread.uuid, \ - \ thread.path, \ - \ thread.resolved, \ - \ thread.private, \ - \ thread.updated_at, \ - \ comment.text AS comment_text, \ - \ u.uuid AS created_by_uuid, \ - \ u.first_name AS created_by_first_name, \ - \ u.last_name AS created_by_last_name, \ - \ u.email AS created_by_email, \ - \ u.image_url AS created_by_image_url \ - \FROM questionnaire_comment_thread thread \ - \JOIN questionnaire qtn ON qtn.uuid = thread.questionnaire_uuid AND qtn.tenant_uuid = thread.tenant_uuid \ - \LEFT JOIN user_entity u ON u.uuid = thread.created_by AND u.tenant_uuid = thread.tenant_uuid \ - \LEFT JOIN questionnaire_comment comment ON comment.comment_thread_uuid = thread.uuid AND comment.tenant_uuid = thread.tenant_uuid \ - \WHERE thread.tenant_uuid = ? \ - \ AND thread.assigned_to = ? \ - \ AND comment.uuid = (SELECT comment.uuid \ - \ FROM questionnaire_comment comment \ - \ WHERE comment.comment_thread_uuid = thread.uuid AND comment.tenant_uuid = thread.tenant_uuid \ - \ ORDER BY comment.created_at \ - \ LIMIT 1) \ - \ ${qCondition} \ - \ ${questionnaireUuidCondition} \ - \ ${resolvedCondition} \ - \${sort} \ - \OFFSET ${offset} \ - \LIMIT ${limit}" - [ ("qCondition", qCondition) - , ("questionnaireUuidCondition", questionnaireUuidCondition) - , ("resolvedCondition", resolvedCondition) - , ("sort", mapSort sort) - , ("offset", show skip) - , ("limit", show sizeI) - ] - logQuery sql params - let action conn = query conn sql params - entities <- runDB action - -- 4. Constructor response - let metadata = - PageMetadata - { size = sizeI - , totalElements = count - , totalPages = computeTotalPage count sizeI - , number = pageI - } - return $ Page "commentThreads" metadata entities - -findQuestionnaireCommentThreads :: U.UUID -> AppContextM [QuestionnaireCommentThread] -findQuestionnaireCommentThreads qtnUuid = do - tenantUuid <- asks currentTenantUuid - let sql = - fromString - "SELECT questionnaire_comment_thread.*, \ - \ (SELECT array_agg(concat(uuid, ':::::', text, ':::::', comment_thread_uuid, ':::::', tenant_uuid, ':::::', created_by, ':::::', created_at, ':::::', updated_at)) AS comments \ - \ FROM questionnaire_comment \ - \ WHERE questionnaire_comment.comment_thread_uuid = questionnaire_comment_thread.uuid \ - \ GROUP BY comment_thread_uuid) AS comments \ - \FROM questionnaire_comment_thread \ - \WHERE questionnaire_uuid = ? AND tenant_uuid = ?" - let params = [toField qtnUuid, toField tenantUuid] - logQuery sql params - let action conn = query conn sql params - runDB action - -findQuestionnaireCommentThreadsForQuestionnaire :: U.UUID -> Maybe String -> Maybe Bool -> Bool -> AppContextM [QuestionnaireCommentThreadList] -findQuestionnaireCommentThreadsForQuestionnaire qtnUuid mPath mResolved editor = do - tenantUuid <- asks currentTenantUuid - let (pathCondition, pathParam) = - case mPath of - Just path -> ("AND path = ?", [toField path]) - Nothing -> ("", []) - let resolvedCondition = - case mResolved of - Just True -> "AND resolved = true" - Just False -> "AND resolved = false" - Nothing -> "" - let privateCondition = - if editor - then "" - else "AND private = false" - let sql = - fromString $ - f'' - "SELECT thread.uuid, \ - \ thread.path, \ - \ thread.resolved, \ - \ thread.private, \ - \ thread.created_at, \ - \ thread.updated_at, \ - \ assigned_to_user.uuid, \ - \ assigned_to_user.first_name, \ - \ assigned_to_user.last_name, \ - \ assigned_to_user.email, \ - \ assigned_to_user.image_url, \ - \ created_by_user.uuid, \ - \ created_by_user.first_name, \ - \ created_by_user.last_name, \ - \ created_by_user.email, \ - \ created_by_user.image_url, \ - \ (SELECT array_agg(concat(comment.uuid, '<:::::>', \ - \ comment.text, '<:::::>', \ - \ comment.created_at, '<:::::>', \ - \ comment.updated_at, '<:::::>', \ - \ user_entity.uuid, '<:::::>', \ - \ user_entity.first_name, '<:::::>', \ - \ user_entity.last_name, '<:::::>', \ - \ user_entity.email, '<:::::>', \ - \ user_entity.image_url \ - \ )) AS comments \ - \ FROM questionnaire_comment comment \ - \ LEFT JOIN user_entity ON user_entity.uuid = comment.created_by \ - \ WHERE comment.comment_thread_uuid = thread.uuid \ - \ GROUP BY comment_thread_uuid) AS comments \ - \FROM questionnaire_comment_thread thread \ - \LEFT JOIN user_entity assigned_to_user ON assigned_to_user.uuid = thread.assigned_to \ - \LEFT JOIN user_entity created_by_user ON created_by_user.uuid = thread.created_by \ - \WHERE thread.questionnaire_uuid = ? \ - \ AND thread.tenant_uuid = ? \ - \ ${pathCondition} \ - \ ${resolvedCondition} \ - \ ${privateCondition}" - [ ("pathCondition", pathCondition) - , ("resolvedCondition", resolvedCondition) - , ("privateCondition", privateCondition) - ] - let params = toField qtnUuid : toField tenantUuid : pathParam - logQuery sql params - let action conn = query conn sql params - runDB action - -findQuestionnaireCommentThreadsSimple :: U.UUID -> Bool -> Bool -> AppContextM (M.Map String (M.Map U.UUID Int)) -findQuestionnaireCommentThreadsSimple qtnUuid resolved editor = do - tenantUuid <- asks currentTenantUuid - let privateCondition = - if editor - then "" - else "AND qtn_comment_thread.private = false" - let sql = - fromString $ - f'' - "SELECT path, qtn_comment_thread.uuid::text, count(qtn_comment.uuid)::text \ - \FROM questionnaire_comment_thread qtn_comment_thread \ - \LEFT JOIN questionnaire_comment qtn_comment ON qtn_comment_thread.uuid = qtn_comment.comment_thread_uuid AND qtn_comment_thread.tenant_uuid = qtn_comment.tenant_uuid \ - \WHERE qtn_comment_thread.questionnaire_uuid = ? \ - \ AND qtn_comment_thread.tenant_uuid = ? \ - \ AND qtn_comment_thread.resolved = ? \ - \ ${privateCondition} \ - \GROUP BY path, qtn_comment_thread.uuid" - [("privateCondition", privateCondition)] - let params = [toField qtnUuid, toField tenantUuid, toField resolved] - logQuery sql params - let action conn = query conn sql params - results <- runDB action - return $ doubleGroupBy id u' read results - -findQuestionnaireCommentThreadsForNotifying :: AppContextM [QuestionnaireCommentThreadNotification] -findQuestionnaireCommentThreadsForNotifying = do - let sql = - "SELECT qtn.uuid, \ - \ qtn.name, \ - \ qtn.tenant_uuid, \ - \ thread.uuid, \ - \ thread.path, \ - \ thread.resolved, \ - \ thread.private, \ - \ assigned_to.uuid, \ - \ assigned_to.first_name, \ - \ assigned_to.last_name, \ - \ assigned_to.email, \ - \ assigned_by.uuid, \ - \ assigned_by.first_name, \ - \ assigned_by.last_name, \ - \ assigned_by.email, \ - \ (SELECT comment.text \ - \ FROM questionnaire_comment comment \ - \ WHERE comment.comment_thread_uuid = thread.uuid \ - \ AND comment.tenant_uuid = thread.tenant_uuid \ - \ ORDER BY comment.created_at \ - \ LIMIT 1) comment_text, \ - \ tenant.client_url, \ - \ config_look_and_feel.app_title AS app_title, \ - \ config_look_and_feel.logo_url AS logo_url, \ - \ config_look_and_feel.primary_color AS primary_color, \ - \ config_look_and_feel.illustrations_color AS illustrations_color, \ - \ config_privacy_and_support.support_email AS support_email, \ - \ config_mail.config_uuid AS mail_config_uuid \ - \FROM questionnaire_comment_thread thread \ - \JOIN questionnaire qtn ON qtn.uuid = thread.questionnaire_uuid AND qtn.tenant_uuid = thread.tenant_uuid \ - \JOIN user_entity assigned_to ON assigned_to.uuid = thread.assigned_to AND assigned_to.tenant_uuid = thread.tenant_uuid \ - \LEFT JOIN user_entity assigned_by ON assigned_by.uuid = thread.assigned_by AND assigned_by.tenant_uuid = thread.tenant_uuid \ - \JOIN tenant ON tenant.uuid = thread.tenant_uuid \ - \JOIN config_look_and_feel ON config_look_and_feel.tenant_uuid = thread.tenant_uuid \ - \JOIN config_privacy_and_support ON config_privacy_and_support.tenant_uuid = thread.tenant_uuid \ - \JOIN config_mail ON config_mail.tenant_uuid = thread.tenant_uuid \ - \WHERE thread.notification_required = true" - logInfoI _CMP_DATABASE (trim sql) - let action conn = query_ conn (fromString sql) - runDB action - -findQuestionnaireCommentThreadById :: U.UUID -> AppContextM (Maybe QuestionnaireCommentThread) -findQuestionnaireCommentThreadById uuid = do - tenantUuid <- asks currentTenantUuid - let sql = - fromString - "SELECT questionnaire_comment_thread.*, \ - \ (SELECT array_agg(concat(uuid, ':::::', text, ':::::', comment_thread_uuid, ':::::', tenant_uuid, ':::::', created_by, ':::::', created_at, ':::::', updated_at)) AS comments \ - \ FROM questionnaire_comment \ - \ WHERE questionnaire_comment.comment_thread_uuid = questionnaire_comment_thread.uuid \ - \ GROUP BY comment_thread_uuid) AS comments \ - \FROM questionnaire_comment_thread \ - \WHERE uuid = ? AND tenant_uuid = ?" - let params = [toField uuid, toField tenantUuid] - logQuery sql params - let action conn = query conn sql params - entities <- runDB action - case entities of - [] -> return Nothing - [entity] -> return . Just $ entity - _ -> - throwError $ - GeneralServerError - ( f' - "createFindEntityByFn: find more entities found than one (entity: %s, param: %s)" - [entityName, show [("uuid", uuid)]] - ) - -insertQuestionnaireCommentThread :: QuestionnaireCommentThread -> AppContextM Int64 -insertQuestionnaireCommentThread = createInsertFn entityName - -updateQuestionnaireCommentThreadById :: QuestionnaireCommentThread -> AppContextM QuestionnaireCommentThread -updateQuestionnaireCommentThreadById entity = do - tenantUuid <- asks currentTenantUuid - now <- liftIO getCurrentTime - let updatedEntity = entity {updatedAt = now} :: QuestionnaireCommentThread - let sql = - fromString - "UPDATE questionnaire_comment_thread SET uuid = ?, text = ?, questionnaire_uuid = ?, created_by = ?, created_at = ?, updated_at = ?, tenant_uuid = ? WHERE uuid = ? AND tenant_uuid = ?" - let params = toRow updatedEntity ++ [toField updatedEntity.uuid, toField tenantUuid] - logQuery sql params - let action conn = execute conn sql params - runDB action - return updatedEntity - -updateQuestionnaireCommentThreadResolvedById :: U.UUID -> Bool -> AppContextM Int64 -updateQuestionnaireCommentThreadResolvedById uuid resolved = do - tenantUuid <- asks currentTenantUuid - let sql = fromString "UPDATE questionnaire_comment_thread SET resolved = ?, updated_at = now() WHERE uuid = ? AND tenant_uuid = ?" - let params = [toField resolved, toField uuid, toField tenantUuid] - logQuery sql params - let action conn = execute conn sql params - runDB action - -updateQuestionnaireCommentThreadAssignee :: U.UUID -> Maybe U.UUID -> Maybe U.UUID -> AppContextM Int64 -updateQuestionnaireCommentThreadAssignee uuid assignedTo assignedBy = do - tenantUuid <- asks currentTenantUuid - let sql = fromString "UPDATE questionnaire_comment_thread SET assigned_to = ?, assigned_by = ?, notification_required = true, updated_at = now() WHERE uuid = ? AND tenant_uuid = ?" - let params = [toField assignedTo, toField assignedBy, toField uuid, toField tenantUuid] - logQuery sql params - let action conn = execute conn sql params - runDB action - -unsetQuestionnaireCommentThreadNotificationRequired :: AppContextM () -unsetQuestionnaireCommentThreadNotificationRequired = do - let sql = "UPDATE questionnaire_comment_thread SET notification_required = false WHERE notification_required = true" - logInfoI _CMP_DATABASE (trim sql) - let action conn = execute_ conn (fromString sql) - runDB action - return () - -deleteQuestionnaireCommentThreads :: AppContextM Int64 -deleteQuestionnaireCommentThreads = createDeleteEntitiesFn entityName - -deleteQuestionnaireCommentThreadById :: U.UUID -> AppContextM Int64 -deleteQuestionnaireCommentThreadById uuid = do - tenantUuid <- asks currentTenantUuid - createDeleteEntityByFn entityName [("uuid", U.toString uuid), ("tenant_uuid", U.toString tenantUuid)] diff --git a/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireDAO.hs b/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireDAO.hs deleted file mode 100644 index 1950e0f88..000000000 --- a/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireDAO.hs +++ /dev/null @@ -1,687 +0,0 @@ -module Wizard.Database.DAO.Questionnaire.QuestionnaireDAO where - -import Control.Monad.Reader (asks) -import Data.Foldable (traverse_) -import qualified Data.List as L -import Data.String (fromString) -import Data.Time -import qualified Data.UUID as U -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.ToField -import Database.PostgreSQL.Simple.ToRow -import GHC.Int - -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.PageMetadata -import Shared.Common.Model.Common.Pageable -import Shared.Common.Model.Common.Sort -import Shared.Common.Util.Logger -import Shared.Common.Util.String (f'', replace, trim) -import Wizard.Api.Resource.User.UserDTO -import Wizard.Database.DAO.Common -import Wizard.Database.DAO.Questionnaire.QuestionnairePermDAO ( - deleteQuestionnairePermsFiltered, - findQuestionnairePermsFiltered, - insertQuestionnairePerm, - ) -import Wizard.Database.Mapping.Questionnaire.Questionnaire () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireDetail () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireDetailPreview () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireDetailQuestionnaire () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireDetailSettings () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireList () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireSimple () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireSimpleWithPerm () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireSuggestion () -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.AppContextHelpers -import Wizard.Model.Context.ContextLenses () -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireDetail -import Wizard.Model.Questionnaire.QuestionnaireDetailPreview -import Wizard.Model.Questionnaire.QuestionnaireDetailQuestionnaire -import Wizard.Model.Questionnaire.QuestionnaireDetailSettings -import Wizard.Model.Questionnaire.QuestionnaireList -import Wizard.Model.Questionnaire.QuestionnaireSimpleWithPerm -import Wizard.Model.Questionnaire.QuestionnaireSuggestion -import Wizard.Model.User.User - -entityName = "questionnaire" - -pageLabel = "questionnaires" - -findQuestionnaires :: AppContextM [Questionnaire] -findQuestionnaires = do - tenantUuid <- asks currentTenantUuid - currentUser <- getCurrentUser - if currentUser.uRole == _USER_ROLE_ADMIN - then createFindEntitiesBySortedFn entityName [tenantQueryUuid tenantUuid] [Sort "name" Ascending] >>= traverse enhance - else do - let sql = f' (qtnSelectSql (U.toString tenantUuid) (U.toString $ currentUser.uuid) "['VIEW']") [""] ++ " ORDER BY qtn.name ASC" - logInfoI _CMP_DATABASE sql - let action conn = query_ conn (fromString sql) - entities <- runDB action - traverse enhance entities - -findQuestionnairesForCurrentUserPage :: Maybe String -> Maybe Bool -> Maybe Bool -> Maybe [String] -> Maybe String -> Maybe [String] -> Maybe String -> Maybe [String] -> Maybe String -> Pageable -> [Sort] -> AppContextM (Page QuestionnaireList) -findQuestionnairesForCurrentUserPage mQuery mIsTemplate mIsMigrating mProjectTags mProjectTagsOp mUserUuids mUserUuidsOp mKnowledgeModelPackageIds mKnowledgeModelPackageIdsOp pageable sort = - -- 1. Prepare variables - do - tenantUuid <- asks currentTenantUuid - currentUser <- getCurrentUser - let (nameCondition, nameRegex) = - case mQuery of - Just query -> (" AND qtn.name ~* ?", [regex query]) - Nothing -> ("", []) - let isTemplateCondition = - case mIsTemplate of - Nothing -> "" - Just True -> " AND qtn.is_template = true" - Just False -> " AND qtn.is_template = false" - let isMigratingCondition useWhere = - case mIsMigrating of - Nothing -> "" - Just True -> f' " %s qtn_mig.new_questionnaire_uuid IS NOT NULL" [if useWhere then "WHERE" else "AND"] - Just False -> f' " %s qtn_mig.new_questionnaire_uuid IS NULL" [if useWhere then "WHERE" else "AND"] - let qtnMigrationJoin = - case mIsMigrating of - Nothing -> "" - Just _ -> "LEFT JOIN questionnaire_migration qtn_mig ON qtn.uuid = qtn_mig.new_questionnaire_uuid " - let (projectTagsCondition, projectTagsParam) = - case mProjectTags of - Nothing -> ("", []) - Just [] -> ("", []) - Just projectTags -> - let mapFn _ = " qtn.project_tags @> ARRAY [?]" - in if isAndOperator mProjectTagsOp - then (" AND (" ++ L.intercalate " AND " (fmap mapFn projectTags) ++ ")", projectTags) - else (" AND (" ++ L.intercalate " OR " (fmap mapFn projectTags) ++ ")", projectTags) - let userUuidsJoin = - case mUserUuids of - Nothing -> "" - Just [] -> "" - Just _ -> "LEFT JOIN questionnaire_perm_user qtn_acl_user ON qtn.uuid = qtn_acl_user.questionnaire_uuid " - let (userUuidsCondition, userUuidsParam) = - case mUserUuids of - Nothing -> ("", []) - Just [] -> ("", []) - Just userUuids -> - if isAndOperator mUserUuidsOp - then - ( f' - " AND %s = ( \ - \SELECT COUNT(DISTINCT user_uuid) \ - \FROM questionnaire_perm_user \ - \WHERE questionnaire_uuid = qtn.uuid AND user_uuid in (%s)) " - [show . length $ userUuids, generateQuestionMarks userUuids] - , userUuids - ) - else - let mapFn _ = " qtn_acl_user.user_uuid = ? " - in (" AND (" ++ L.intercalate " OR " (fmap mapFn userUuids) ++ ")", userUuids) - let (knowledgeModelPackageCondition, knowledgeModelPackageIdsParam) = - case mKnowledgeModelPackageIds of - Nothing -> ("", []) - Just [] -> ("", []) - Just packageIds -> - let operator = if isAndOperator mKnowledgeModelPackageIdsOp then " AND " else " OR " - in ( f' " AND (%s)" [L.intercalate operator . fmap (const " qtn.knowledge_model_package_id LIKE ?") $ packageIds] - , fmap (replace "all" "%") packageIds - ) - let (aclJoins, aclCondition) = - if currentUser.uRole == _USER_ROLE_ADMIN - then (userUuidsJoin, "") - else - ( f'' - "LEFT JOIN questionnaire_perm_user qtn_acl_user ON qtn.uuid = qtn_acl_user.questionnaire_uuid AND qtn_acl_user.tenant_uuid = '${tenantUuid}' \ - \LEFT JOIN questionnaire_perm_group qtn_acl_group ON qtn.uuid = qtn_acl_group.questionnaire_uuid AND qtn_acl_group.tenant_uuid = '${tenantUuid}' \ - \LEFT JOIN user_group_membership ugm ON ugm.user_group_uuid = qtn_acl_group.user_group_uuid AND ugm.user_uuid = '${currentUserUuid}' AND ugm.tenant_uuid = '${tenantUuid}'" - [ ("currentUserUuid", U.toString currentUser.uuid) - , ("tenantUuid", U.toString tenantUuid) - ] - , f' - "AND (visibility = 'VisibleEditQuestionnaire' \ - \ OR visibility = 'VisibleCommentQuestionnaire' \ - \ OR visibility = 'VisibleViewQuestionnaire' \ - \ OR (visibility = 'PrivateQuestionnaire' AND qtn_acl_user.user_uuid = '%s' AND qtn_acl_user.perms @> ARRAY %s) \ - \ OR (visibility = 'PrivateQuestionnaire' AND qtn_acl_group.user_group_uuid = ugm.user_group_uuid AND qtn_acl_group.perms @> ARRAY %s) \ - \)" - [U.toString currentUser.uuid, "['VIEW']", "['VIEW']"] - ) - let (sizeI, pageI, skip, limit) = preparePaginationVariables pageable - -- 2. Get total count - let countSql = - fromString $ - f'' - "SELECT COUNT(DISTINCT qtn.uuid) \ - \FROM questionnaire qtn \ - \${qtnMigrationJoin} \ - \${aclJoins} \ - \WHERE qtn.tenant_uuid = '${tenantUuid}' ${aclCondition} ${nameCondition} ${isTemplateCondition} ${isMigratingCondition} ${projectTagsCondition} ${userUuidsCondition} ${knowledgeModelPackageCondition}" - [ ("qtnMigrationJoin", qtnMigrationJoin) - , ("aclJoins", aclJoins) - , ("tenantUuid", U.toString tenantUuid) - , ("aclCondition", aclCondition) - , ("nameCondition", nameCondition) - , ("isTemplateCondition", isTemplateCondition) - , ("isMigratingCondition", isMigratingCondition False) - , ("projectTagsCondition", projectTagsCondition) - , ("userUuidsCondition", userUuidsCondition) - , ("knowledgeModelPackageCondition", knowledgeModelPackageCondition) - ] - let params = nameRegex ++ projectTagsParam ++ userUuidsParam ++ knowledgeModelPackageIdsParam - logQuery countSql params - let action conn = query conn countSql params - result <- runDB action - let count = - case result of - [count] -> fromOnly count - _ -> 0 - -- 3. Get entities - let sql = - fromString $ - f'' - "WITH qtn AS (SELECT DISTINCT qtn.uuid, \ - \ qtn.name, \ - \ qtn.description, \ - \ qtn.visibility, \ - \ qtn.sharing, \ - \ qtn.is_template, \ - \ qtn.created_at, \ - \ qtn.updated_at, \ - \ qtn.knowledge_model_package_id \ - \ FROM questionnaire qtn \ - \ ${aclJoins} \ - \ WHERE qtn.tenant_uuid = '${tenantUuid}' ${aclCondition} ${nameCondition} ${isTemplateCondition} ${projectTagsCondition} ${userUuidsCondition} ${knowledgeModelPackageCondition}), \ - \ pkg AS (SELECT knowledge_model_package.id, \ - \ knowledge_model_package.name, \ - \ knowledge_model_package.version, \ - \ knowledge_model_package.organization_id, \ - \ knowledge_model_package.km_id \ - \ FROM knowledge_model_package \ - \ WHERE knowledge_model_package.tenant_uuid = '${tenantUuid}'), \ - \ qtn_mig AS (SELECT new_questionnaire_uuid \ - \ FROM questionnaire_migration \ - \ WHERE questionnaire_migration.tenant_uuid = '${tenantUuid}') \ - \SELECT qtn.uuid, \ - \ qtn.name, \ - \ qtn.description, \ - \ qtn.visibility, \ - \ qtn.sharing, \ - \ qtn.is_template, \ - \ qtn.created_at, \ - \ qtn.updated_at, \ - \ CASE \ - \ WHEN qtn_mig.new_questionnaire_uuid IS NOT NULL THEN 'Migrating' \ - \ WHEN qtn.knowledge_model_package_id != get_newest_knowledge_model_package(pkg.organization_id, pkg.km_id, '${tenantUuid}', ARRAY['ReleasedKnowledgeModelPackagePhase']) THEN 'Outdated' \ - \ WHEN qtn_mig.new_questionnaire_uuid IS NULL THEN 'Default' END, \ - \ pkg.id, \ - \ pkg.name, \ - \ pkg.version, \ - \ (SELECT array_agg(CONCAT(qtn_acl_user.user_uuid, '::', qtn_acl_user.perms, '::', u.uuid, '::', u.first_name, '::', u.last_name, '::', u.email, '::', u.image_url)) \ - \ FROM questionnaire_perm_user qtn_acl_user \ - \ JOIN user_entity u on u.uuid = qtn_acl_user.user_uuid \ - \ WHERE questionnaire_uuid = qtn.uuid \ - \ GROUP BY questionnaire_uuid) as user_permissions, \ - \ (SELECT array_agg(CONCAT(qtn_acl_group.user_group_uuid, '::', qtn_acl_group.perms, '::', ug.uuid, '::', ug.name, '::', ug.private, '::', ug.description)) \ - \ FROM questionnaire_perm_group qtn_acl_group \ - \ JOIN user_group ug on ug.uuid = qtn_acl_group.user_group_uuid \ - \ WHERE questionnaire_uuid = qtn.uuid \ - \ GROUP BY questionnaire_uuid) as group_permissions \ - \FROM qtn \ - \JOIN pkg ON qtn.knowledge_model_package_id = pkg.id \ - \LEFT JOIN qtn_mig ON qtn.uuid = qtn_mig.new_questionnaire_uuid \ - \${isMigratingCondition} \ - \${sort} \ - \OFFSET ${offset} LIMIT ${limit}" - [ ("aclJoins", aclJoins) - , ("tenantUuid", U.toString tenantUuid) - , ("aclCondition", aclCondition) - , ("nameCondition", nameCondition) - , ("isTemplateCondition", isTemplateCondition) - , ("isMigratingCondition", isMigratingCondition True) - , ("projectTagsCondition", projectTagsCondition) - , ("userUuidsCondition", userUuidsCondition) - , ("knowledgeModelPackageCondition", knowledgeModelPackageCondition) - , ("sort", mapSortWithPrefix "qtn" sort) - , ("offset", show skip) - , ("limit", show sizeI) - ] - logQuery sql params - let action conn = query conn sql params - entities <- runDB action - -- 5. Constructor response - let metadata = - PageMetadata - { size = sizeI - , totalElements = count - , totalPages = computeTotalPage count sizeI - , number = pageI - } - return $ Page pageLabel metadata entities - -findQuestionnairesByPackageId :: String -> AppContextM [Questionnaire] -findQuestionnairesByPackageId packageId = do - tenantUuid <- asks currentTenantUuid - currentUser <- getCurrentUser - if currentUser.uRole == _USER_ROLE_ADMIN - then createFindEntitiesByFn entityName [tenantQueryUuid tenantUuid, ("knowledge_model_package_id", packageId)] >>= traverse enhance - else do - let sql = - fromString $ - f' (qtnSelectSql (U.toString tenantUuid) (U.toString $ currentUser.uuid) "['VIEW']") ["AND knowledge_model_package_id = ?"] - let params = [packageId] - logQuery sql params - let action conn = query conn sql params - entities <- runDB action - traverse enhance entities - -findQuestionnairesByDocumentTemplateId :: String -> AppContextM [Questionnaire] -findQuestionnairesByDocumentTemplateId documentTemplateId = do - tenantUuid <- asks currentTenantUuid - currentUser <- getCurrentUser - if currentUser.uRole == _USER_ROLE_ADMIN - then createFindEntitiesByFn entityName [tenantQueryUuid tenantUuid, ("document_template_id", documentTemplateId)] >>= traverse enhance - else do - let sql = - fromString $ - f' (qtnSelectSql (U.toString tenantUuid) (U.toString $ currentUser.uuid) "['VIEW']") ["AND document_template_id = ?"] - let params = [documentTemplateId] - logQuery sql params - let action conn = query conn sql params - entities <- runDB action - traverse enhance entities - -findQuestionnaireWithZeroAcl :: AppContextM [Questionnaire] -findQuestionnaireWithZeroAcl = do - let sql = - f' - "SELECT qtn.* \ - \FROM %s qtn \ - \LEFT JOIN questionnaire_perm_user qtn_acl_user ON qtn.uuid = qtn_acl_user.questionnaire_uuid \ - \LEFT JOIN questionnaire_perm_group qtn_acl_group ON qtn.uuid = qtn_acl_group.questionnaire_uuid \ - \WHERE qtn_acl_user.user_uuid IS NULL \ - \AND qtn_acl_group.user_group_uuid IS NULL \ - \AND qtn.updated_at < now() - INTERVAL '30 days'" - [entityName] - logInfoI _CMP_DATABASE (trim sql) - let action conn = query_ conn (fromString sql) - runDB action - -findQuestionnairesSimpleWithPermByUserGroupUuid :: U.UUID -> AppContextM [QuestionnaireSimpleWithPerm] -findQuestionnairesSimpleWithPermByUserGroupUuid userGroupUuid = do - tenantUuid <- asks currentTenantUuid - let sql = - fromString - "SELECT \ - \ nested_qtn.*, \ - \ ( \ - \ SELECT array_agg(CONCAT(user_uuid, '::', perms)) \ - \ FROM questionnaire_perm_user qtn_acl_user \ - \ WHERE questionnaire_uuid = nested_qtn.uuid AND tenant_uuid = nested_qtn.tenant_uuid \ - \ GROUP BY questionnaire_uuid \ - \ ) as user_permissions, \ - \ ( \ - \ SELECT array_agg(CONCAT(user_group_uuid, '::', perms)) \ - \ FROM questionnaire_perm_group qtn_acl_group \ - \ WHERE questionnaire_uuid = nested_qtn.uuid AND tenant_uuid = nested_qtn.tenant_uuid \ - \ GROUP BY questionnaire_uuid \ - \ ) as group_permissions \ - \FROM ( \ - \ SELECT qtn.uuid, qtn.visibility, qtn.sharing, qtn.tenant_uuid \ - \ FROM questionnaire qtn \ - \ LEFT JOIN questionnaire_perm_group qtn_perm_group ON qtn.uuid = qtn_perm_group.questionnaire_uuid AND qtn.tenant_uuid = qtn_perm_group.tenant_uuid \ - \ WHERE qtn_perm_group.user_group_uuid = ? AND qtn_perm_group.tenant_uuid = ? \ - \) nested_qtn" - let params = [toField userGroupUuid, toField tenantUuid] - logQuery sql params - let action conn = query conn sql params - runDB action - -findQuestionnaireUuids :: AppContextM [U.UUID] -findQuestionnaireUuids = do - tenantUuid <- asks currentTenantUuid - let sql = fromString $ f' "SELECT %s FROM %s WHERE tenant_uuid = ?" ["uuid", entityName] - let params = [toField tenantUuid] - logQuery sql params - let action conn = query conn sql params - entities <- runDB action - return . concat $ entities - -findQuestionnaireUuids' :: AppContextM [U.UUID] -findQuestionnaireUuids' = do - let sql = f' "SELECT %s FROM %s" ["uuid", entityName] - logInfoI _CMP_DATABASE (trim sql) - let action conn = query_ conn (fromString sql) - entities <- runDB action - return . concat $ entities - -findQuestionnaireByUuid :: U.UUID -> AppContextM Questionnaire -findQuestionnaireByUuid qtnUuid = do - tenantUuid <- asks currentTenantUuid - entity <- createFindEntityByFn entityName [tenantQueryUuid tenantUuid, ("uuid", U.toString qtnUuid)] - enhance entity - -findQuestionnaireByUuid' :: U.UUID -> AppContextM (Maybe Questionnaire) -findQuestionnaireByUuid' qtnUuid = do - tenantUuid <- asks currentTenantUuid - mEntity <- createFindEntityByFn' entityName [tenantQueryUuid tenantUuid, ("uuid", U.toString qtnUuid)] - case mEntity of - Just entity -> enhance entity >>= return . Just - Nothing -> return Nothing - -findQuestionnaireSuggestionByUuid' :: U.UUID -> AppContextM (Maybe QuestionnaireSuggestion) -findQuestionnaireSuggestionByUuid' uuid = do - tenantUuid <- asks currentTenantUuid - createFindEntityWithFieldsByFn' "uuid, name, description" entityName [tenantQueryUuid tenantUuid, ("uuid", U.toString uuid)] - -findQuestionnaireForSquashing :: AppContextM [U.UUID] -findQuestionnaireForSquashing = do - let sql = "SELECT uuid FROM questionnaire WHERE squashed = false" - logInfoI _CMP_DATABASE (trim sql) - let action conn = query_ conn (fromString sql) - entities <- runDB action - return . concat $ entities - -findQuestionnaireDetail :: U.UUID -> AppContextM QuestionnaireDetail -findQuestionnaireDetail uuid = do - tenantUuid <- asks currentTenantUuid - let sql = - fromString $ - f'' - "SELECT qtn.uuid, \ - \ qtn.name, \ - \ qtn.visibility, \ - \ qtn.sharing, \ - \ qtn.knowledge_model_package_id, \ - \ qtn.selected_question_tag_uuids, \ - \ qtn.is_template, \ - \ qtn_mig.new_questionnaire_uuid AS migration_uuid, \ - \ ${questionnaireDetailPermSql}, \ - \ ( \ - \ SELECT count(*) \ - \ FROM questionnaire_action \ - \ WHERE tenant_uuid = '${tenantUuid}' \ - \ ) as questionnaire_actions, \ - \ ( \ - \ SELECT count(*) \ - \ FROM questionnaire_importer \ - \ WHERE tenant_uuid = '${tenantUuid}' \ - \ ) as questionnaire_importers, \ - \ ( \ - \ SELECT count(*) \ - \ FROM questionnaire_file \ - \ WHERE tenant_uuid = '${tenantUuid}' AND questionnaire_uuid = '${questionnaireUuid}' \ - \ ) as file_count \ - \FROM questionnaire qtn \ - \LEFT JOIN questionnaire_migration qtn_mig ON qtn.uuid = qtn_mig.old_questionnaire_uuid AND qtn.tenant_uuid = qtn_mig.tenant_uuid \ - \WHERE qtn.tenant_uuid = ? AND qtn.uuid = ?" - [ ("questionnaireDetailPermSql", questionnaireDetailPermSql) - , ("questionnaireUuid", U.toString uuid) - , ("tenantUuid", U.toString tenantUuid) - ] - let queryParams = [("tenant_uuid", U.toString tenantUuid), ("uuid", U.toString uuid)] - let params = fmap snd queryParams - logQuery sql params - let action conn = query conn sql params - runOneEntityDB entityName action queryParams - -findQuestionnaireDetailQuestionnaire :: U.UUID -> AppContextM QuestionnaireDetailQuestionnaire -findQuestionnaireDetailQuestionnaire uuid = do - tenantUuid <- asks currentTenantUuid - let sql = - fromString $ - f'' - "SELECT qtn.uuid, \ - \ qtn.name, \ - \ qtn.visibility, \ - \ qtn.sharing, \ - \ qtn.knowledge_model_package_id, \ - \ qtn.selected_question_tag_uuids, \ - \ qtn.is_template, \ - \ qtn_mig.new_questionnaire_uuid AS migration_uuid, \ - \ ${questionnaireDetailPermSql}, \ - \ ( \ - \ SELECT count(*) \ - \ FROM questionnaire_action \ - \ WHERE tenant_uuid = '${tenantUuid}' \ - \ ) as questionnaire_actions, \ - \ ( \ - \ SELECT count(*) \ - \ FROM questionnaire_importer \ - \ WHERE tenant_uuid = '${tenantUuid}' \ - \ ) as questionnaire_importers, \ - \ ( \ - \ SELECT array_agg(concat(uuid, '<:::::>', \ - \ file_name, '<:::::>', \ - \ content_type, '<:::::>', \ - \ file_size \ - \ )) \ - \ FROM questionnaire_file \ - \ WHERE tenant_uuid = '${tenantUuid}' AND questionnaire_uuid = '${questionnaireUuid}' \ - \ ) as files \ - \FROM questionnaire qtn \ - \LEFT JOIN questionnaire_migration qtn_mig ON qtn.uuid = qtn_mig.old_questionnaire_uuid AND qtn.tenant_uuid = qtn_mig.tenant_uuid \ - \WHERE qtn.tenant_uuid = ? AND qtn.uuid = ?" - [ ("questionnaireUuid", U.toString uuid) - , ("questionnaireDetailPermSql", questionnaireDetailPermSql) - , ("tenantUuid", U.toString tenantUuid) - ] - let queryParams = [("tenant_uuid", U.toString tenantUuid), ("uuid", U.toString uuid)] - let params = fmap snd queryParams - logQuery sql params - let action conn = query conn sql params - runOneEntityDB entityName action queryParams - -findQuestionnaireDetailPreview :: U.UUID -> AppContextM QuestionnaireDetailPreview -findQuestionnaireDetailPreview uuid = do - tenantUuid <- asks currentTenantUuid - let sql = - fromString $ - f'' - "SELECT qtn.uuid, \ - \ qtn.name, \ - \ qtn.visibility, \ - \ qtn.sharing, \ - \ qtn.knowledge_model_package_id, \ - \ qtn.is_template, \ - \ qtn.document_template_id, \ - \ qtn_mig.new_questionnaire_uuid AS migration_uuid, \ - \ ${questionnaireDetailPermSql}, \ - \ dt_format.uuid, \ - \ dt_format.name, \ - \ dt_format.icon, \ - \ ( \ - \ SELECT count(*) \ - \ FROM questionnaire_file \ - \ WHERE tenant_uuid = '${tenantUuid}' AND questionnaire_uuid = '${questionnaireUuid}' \ - \ ) as file_count \ - \FROM questionnaire qtn \ - \LEFT JOIN questionnaire_migration qtn_mig ON qtn.uuid = qtn_mig.old_questionnaire_uuid AND qtn.tenant_uuid = qtn_mig.tenant_uuid \ - \LEFT JOIN document_template dt ON qtn.document_template_id = dt.id AND qtn.tenant_uuid = dt.tenant_uuid \ - \LEFT JOIN document_template_format dt_format ON qtn.document_template_id = dt_format.document_template_id AND qtn.format_uuid = dt_format.uuid AND qtn.tenant_uuid = dt_format.tenant_uuid \ - \WHERE qtn.tenant_uuid = ? AND qtn.uuid = ?" - [ ("questionnaireDetailPermSql", questionnaireDetailPermSql) - , ("questionnaireUuid", U.toString uuid) - , ("tenantUuid", U.toString tenantUuid) - ] - let queryParams = [("tenant_uuid", U.toString tenantUuid), ("uuid", U.toString uuid)] - let params = fmap snd queryParams - logQuery sql params - let action conn = query conn sql params - runOneEntityDB entityName action queryParams - -findQuestionnaireDetailSettings :: U.UUID -> AppContextM QuestionnaireDetailSettings -findQuestionnaireDetailSettings uuid = do - tenantUuid <- asks currentTenantUuid - let sql = - fromString $ - f'' - "SELECT qtn.uuid, \ - \ qtn.name, \ - \ qtn.description, \ - \ qtn.visibility, \ - \ qtn.sharing, \ - \ qtn.is_template, \ - \ qtn.project_tags, \ - \ qtn.selected_question_tag_uuids, \ - \ qtn.format_uuid, \ - \ qtn_mig.new_questionnaire_uuid AS migration_uuid, \ - \ ${questionnaireDetailPermSql}, \ - \ pkg.id as knowledge_model_package_id, \ - \ pkg.name as knowledge_model_package_name, \ - \ pkg.organization_id as knowledge_model_package_organization_id, \ - \ pkg.km_id as knowledge_model_package_km_id, \ - \ pkg.version as knowledge_model_package_version, \ - \ pkg.phase as knowledge_model_package_phase, \ - \ pkg.description as knowledge_model_package_description, \ - \ pkg.non_editable as knowledge_model_package_non_editable, \ - \ pkg.created_at as knowledge_model_package_created_at, \ - \ dt.id as document_template_id, \ - \ dt.name as document_template_name, \ - \ dt.version as document_template_version, \ - \ dt.phase as document_template_phase, \ - \ dt.description as document_template_description, \ - \ ( \ - \ SELECT jsonb_agg(jsonb_build_object('uuid', uuid, 'name', name, 'icon', icon)) \ - \ FROM (SELECT * \ - \ FROM document_template_format dt_format \ - \ WHERE dt_format.tenant_uuid = qtn.tenant_uuid AND dt_format.document_template_id = dt.id \ - \ ORDER BY dt_format.name) nested \ - \ ) AS document_template_formats, \ - \ dt.metamodel_version as document_template_metamodel_version, \ - \ ( \ - \ SELECT count(*) \ - \ FROM questionnaire_file \ - \ WHERE tenant_uuid = '${tenantUuid}' AND questionnaire_uuid = '${questionnaireUuid}' \ - \ ) as file_count \ - \FROM questionnaire qtn \ - \LEFT JOIN questionnaire_migration qtn_mig ON qtn.uuid = qtn_mig.old_questionnaire_uuid AND qtn.tenant_uuid = qtn_mig.tenant_uuid \ - \LEFT JOIN knowledge_model_package pkg ON qtn.knowledge_model_package_id = pkg.id AND qtn.tenant_uuid = pkg.tenant_uuid \ - \LEFT JOIN document_template dt ON qtn.document_template_id = dt.id AND qtn.tenant_uuid = dt.tenant_uuid \ - \WHERE qtn.tenant_uuid = ? AND qtn.uuid = ?" - [ ("questionnaireDetailPermSql", questionnaireDetailPermSql) - , ("questionnaireUuid", U.toString uuid) - , ("tenantUuid", U.toString tenantUuid) - ] - let queryParams = [("tenant_uuid", U.toString tenantUuid), ("uuid", U.toString uuid)] - let params = fmap snd queryParams - logQuery sql params - let action conn = query conn sql params - runOneEntityDB entityName action queryParams - -questionnaireDetailPermSql :: String -questionnaireDetailPermSql = - "(SELECT array_agg(CONCAT(qtn_acl_user.user_uuid, '::', qtn_acl_user.perms, '::', u.uuid, '::', u.first_name, \ - \ '::', u.last_name, '::', u.email, '::', u.image_url)) \ - \ FROM questionnaire_perm_user qtn_acl_user \ - \ JOIN user_entity u on u.uuid = qtn_acl_user.user_uuid \ - \ WHERE questionnaire_uuid = qtn.uuid \ - \ GROUP BY questionnaire_uuid) as user_permissions, \ - \(SELECT array_agg(CONCAT(qtn_acl_group.user_group_uuid, '::', qtn_acl_group.perms, '::', ug.uuid, '::', ug.name, \ - \ '::', ug.private, '::', ug.description)) \ - \ FROM questionnaire_perm_group qtn_acl_group \ - \ JOIN user_group ug on ug.uuid = qtn_acl_group.user_group_uuid \ - \ WHERE questionnaire_uuid = qtn.uuid \ - \ GROUP BY questionnaire_uuid) as group_permissions" - -countQuestionnaires :: AppContextM Int -countQuestionnaires = do - tenantUuid <- asks currentTenantUuid - countQuestionnairesWithTenant tenantUuid - -countQuestionnairesWithTenant :: U.UUID -> AppContextM Int -countQuestionnairesWithTenant tenantUuid = createCountByFn entityName tenantCondition [U.toString tenantUuid] - -insertQuestionnaire :: Questionnaire -> AppContextM Int64 -insertQuestionnaire qtn = do - -- Insert questionnaire - let sql = - fromString - "INSERT INTO questionnaire VALUES (?, ?, ?, ?, ?, ?::uuid[], ?, ?, ?, ?, ?, ?, ?, ?, ?, ?::text[])" - let params = toRow qtn - logQuery sql params - let action conn = execute conn sql params - runDB action - -- Insert questionnaire permissions - traverse_ insertQuestionnairePerm qtn.permissions - return 1 - -updateQuestionnaireByUuid :: Questionnaire -> AppContextM () -updateQuestionnaireByUuid qtn = do - tenantUuid <- asks currentTenantUuid - let sql = - fromString - "UPDATE questionnaire SET uuid = ?, name = ?, visibility = ?, sharing = ?, knowledge_model_package_id = ?, selected_question_tag_uuids = ?::uuid[], document_template_id = ?, format_uuid = ?, created_by = ?, created_at = ?, updated_at = ?, description = ?, is_template = ?, squashed = ?, tenant_uuid = ?, project_tags = ?::text[] WHERE tenant_uuid = ? AND uuid = ?" - let params = toRow qtn ++ [toField tenantUuid, toField . U.toText $ qtn.uuid] - logInsertAndUpdate sql params - let action conn = execute conn sql params - runDB action - deleteQuestionnairePermsFiltered [("questionnaire_uuid", U.toString qtn.uuid)] - traverse_ insertQuestionnairePerm qtn.permissions - -updateQuestionnaireSquashedByUuid :: U.UUID -> Bool -> AppContextM Int64 -updateQuestionnaireSquashedByUuid uuid squashed = do - tenantUuid <- asks currentTenantUuid - let sql = fromString "UPDATE questionnaire SET squashed = ? WHERE tenant_uuid = ? AND uuid = ?" - let params = [toField squashed, toField tenantUuid, toField . U.toText $ uuid] - logInsertAndUpdate sql params - let action conn = execute conn sql params - runDB action - -updateQuestionnaireSquashedAndUpdatedAtByUuid :: U.UUID -> Bool -> UTCTime -> AppContextM Int64 -updateQuestionnaireSquashedAndUpdatedAtByUuid uuid squashed updatedAt = do - tenantUuid <- asks currentTenantUuid - let sql = fromString "UPDATE questionnaire SET squashed = ?, updated_at = ? WHERE tenant_uuid = ? AND uuid = ?" - let params = [toField squashed, toField updatedAt, toField tenantUuid, toField . U.toText $ uuid] - logInsertAndUpdate sql params - let action conn = execute conn sql params - runDB action - -updateQuestionnaireUpdatedAtByUuid :: U.UUID -> AppContextM Int64 -updateQuestionnaireUpdatedAtByUuid uuid = do - tenantUuid <- asks currentTenantUuid - let sql = fromString "UPDATE questionnaire SET updated_at = now() WHERE tenant_uuid = ? AND uuid = ?" - let params = [toField tenantUuid, toField . U.toText $ uuid] - logInsertAndUpdate sql params - let action conn = execute conn sql params - runDB action - -deleteQuestionnaires :: AppContextM Int64 -deleteQuestionnaires = createDeleteEntitiesFn entityName - -deleteQuestionnairesFiltered :: [(String, String)] -> AppContextM Int64 -deleteQuestionnairesFiltered params = do - tenantUuid <- asks currentTenantUuid - createDeleteEntitiesByFn entityName (tenantQueryUuid tenantUuid : params) - -deleteQuestionnaireByUuid :: U.UUID -> AppContextM Int64 -deleteQuestionnaireByUuid uuid = do - tenantUuid <- asks currentTenantUuid - createDeleteEntityByFn entityName [tenantQueryUuid tenantUuid, ("uuid", U.toString uuid)] - --- ------------------------------------------------------------------------------------------------------------------------------ --- PRIVATE --- ------------------------------------------------------------------------------------------------------------------------------ -qtnSelectSql tenantUuid userUuid perm = - f' - "SELECT qtn.* \ - \FROM questionnaire qtn \ - \LEFT JOIN questionnaire_perm_user qtn_acl_user ON qtn.uuid = qtn_acl_user.questionnaire_uuid \ - \LEFT JOIN questionnaire_perm_group qtn_acl_group ON qtn.uuid = qtn_acl_group.questionnaire_uuid \ - \WHERE %s %s" - [qtnWhereSql tenantUuid userUuid perm] - -qtnWhereSql tenantUuid userUuid perm = - f' - "qtn.tenant_uuid = '%s' \ - \AND (visibility = 'VisibleEditQuestionnaire' \ - \OR visibility = 'VisibleCommentQuestionnaire' \ - \OR visibility = 'VisibleViewQuestionnaire' \ - \OR (visibility = 'PrivateQuestionnaire' AND qtn_acl_user.user_uuid = '%s' AND qtn_acl_user.perms @> ARRAY %s))" - [tenantUuid, userUuid, perm] - -enhance :: Questionnaire -> AppContextM Questionnaire -enhance qtn = do - ps <- findQuestionnairePermsFiltered [("questionnaire_uuid", U.toString qtn.uuid)] - return $ qtn {permissions = ps} diff --git a/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireEventDAO.hs b/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireEventDAO.hs deleted file mode 100644 index f0d398a04..000000000 --- a/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireEventDAO.hs +++ /dev/null @@ -1,217 +0,0 @@ -module Wizard.Database.DAO.Questionnaire.QuestionnaireEventDAO where - -import Control.Monad (unless, void) -import Control.Monad.Reader (asks) -import Data.Foldable (traverse_) -import qualified Data.List as L -import Data.String (fromString) -import qualified Data.UUID as U -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.ToField -import Database.PostgreSQL.Simple.ToRow -import GHC.Int - -import Shared.Common.Model.Common.Lens -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.PageMetadata -import Shared.Common.Model.Common.Pageable -import Shared.Common.Model.Common.Sort -import Shared.Common.Util.Logger -import Shared.Common.Util.String -import Wizard.Database.DAO.Common -import Wizard.Database.Mapping.Questionnaire.QuestionnaireEvent () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireEventList () -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.ContextLenses () -import Wizard.Model.Questionnaire.QuestionnaireEvent -import Wizard.Model.Questionnaire.QuestionnaireEventLenses () -import Wizard.Model.Questionnaire.QuestionnaireEventList - -entityName = "questionnaire_event" - -pageLabel = "questionnaireEvents" - -findQuestionnaireEventsPage :: U.UUID -> Pageable -> [Sort] -> AppContextM (Page QuestionnaireEventList) -findQuestionnaireEventsPage questionnaireUuid pageable sort = do - -- 1. Prepare variables - do - tenantUuid <- asks (.tenantUuid') - let (sizeI, pageI, skip, limit) = preparePaginationVariables pageable - -- 2. Get total count - let countSql = - fromString - "SELECT count(*) \ - \FROM questionnaire_event \ - \WHERE tenant_uuid = ? AND questionnaire_uuid = ?" - let countParams = [U.toString tenantUuid, U.toString questionnaireUuid] - logQuery countSql countParams - let action conn = query conn countSql countParams - result <- runDB action - let count = - case result of - [count] -> fromOnly count - _ -> 0 - -- 3. Get entities - let sql = - fromString $ - f'' - "SELECT questionnaire_event.uuid, \ - \ questionnaire_event.event_type, \ - \ questionnaire_event.path, \ - \ questionnaire_event.created_at, \ - \ questionnaire_event.value_type, \ - \ questionnaire_event.value, \ - \ questionnaire_event.value_id, \ - \ questionnaire_event.value_raw, \ - \ questionnaire_event.created_by AS created_by_uuid, \ - \ user_entity.first_name AS created_by_first_name, \ - \ user_entity.last_name AS created_by_last_name, \ - \ gravatar_hash(user_entity.email) AS created_by_gravatar_hash, \ - \ user_entity.image_url AS created_by_email \ - \FROM questionnaire_event \ - \ LEFT JOIN user_entity ON user_entity.uuid = questionnaire_event.created_by \ - \WHERE questionnaire_event.tenant_uuid = ? \ - \ AND questionnaire_event.questionnaire_uuid = ? \ - \${sort} \ - \OFFSET ${offset} \ - \LIMIT ${limit}" - [ ("sort", mapSort sort) - , ("offset", show skip) - , ("limit", show sizeI) - ] - let params = [U.toString tenantUuid, U.toString questionnaireUuid] - logQuery sql params - let action conn = query conn sql params - entities <- runDB action - -- 4. Constructor response - let metadata = - PageMetadata - { size = sizeI - , totalElements = count - , totalPages = computeTotalPage count sizeI - , number = pageI - } - return $ Page pageLabel metadata entities - -findQuestionnaireEventsByQuestionnaireUuid :: U.UUID -> AppContextM [QuestionnaireEvent] -findQuestionnaireEventsByQuestionnaireUuid questionnaireUuid = do - tenantUuid <- asks currentTenantUuid - let sql = - "SELECT * \ - \FROM questionnaire_event \ - \WHERE tenant_uuid = ? AND questionnaire_uuid = ? \ - \ORDER BY created_at" - let params = [U.toString tenantUuid, U.toString questionnaireUuid] - logInfoI _CMP_DATABASE sql - let action conn = query conn (fromString sql) params - runDB action - -findQuestionnaireEventListsByQuestionnaireUuid :: U.UUID -> AppContextM [QuestionnaireEventList] -findQuestionnaireEventListsByQuestionnaireUuid questionnaireUuid = do - tenantUuid <- asks currentTenantUuid - let sql = - fromString - "SELECT questionnaire_event.uuid, \ - \ questionnaire_event.event_type, \ - \ questionnaire_event.path, \ - \ questionnaire_event.created_at, \ - \ questionnaire_event.value_type, \ - \ questionnaire_event.value, \ - \ questionnaire_event.value_id, \ - \ questionnaire_event.value_raw, \ - \ questionnaire_event.created_by AS created_by_uuid, \ - \ user_entity.first_name AS created_by_first_name, \ - \ user_entity.last_name AS created_by_last_name, \ - \ gravatar_hash(user_entity.email) AS created_by_gravatar_hash, \ - \ user_entity.image_url AS created_by_email \ - \FROM questionnaire_event \ - \ LEFT JOIN user_entity ON user_entity.uuid = questionnaire_event.created_by \ - \WHERE questionnaire_event.tenant_uuid = ? \ - \ AND questionnaire_event.questionnaire_uuid = ? \ - \ORDER BY created_at" - let params = [U.toString tenantUuid, U.toString questionnaireUuid] - logInfoI _CMP_DATABASE sql - let action conn = query conn (fromString sql) params - runDB action - -findQuestionnaireEventByUuid :: U.UUID -> AppContextM QuestionnaireEvent -findQuestionnaireEventByUuid uuid = do - tenantUuid <- asks currentTenantUuid - createFindEntityWithFieldsByFn "*" False entityName [tenantQueryUuid tenantUuid, ("uuid", U.toString uuid)] - -findQuestionnaireEventByUuid' :: U.UUID -> AppContextM (Maybe QuestionnaireEvent) -findQuestionnaireEventByUuid' uuid = do - tenantUuid <- asks currentTenantUuid - createFindEntityByFn' entityName [tenantQueryUuid tenantUuid, ("uuid", U.toString uuid)] - -insertQuestionnaireEvent :: QuestionnaireEvent -> AppContextM Int64 -insertQuestionnaireEvent = createInsertFn entityName - -insertQuestionnaireEventWithTimestampUpdate :: U.UUID -> QuestionnaireEvent -> AppContextM () -insertQuestionnaireEventWithTimestampUpdate qtnUuid event = do - tenantUuid <- asks currentTenantUuid - let sql = - fromString $ - f' - "UPDATE questionnaire SET squashed = false, updated_at = now() WHERE tenant_uuid = ? AND uuid = ?; \ - \INSERT INTO questionnaire_event VALUES (%s)" - [generateQuestionMarks' event] - let params = - [ toField tenantUuid - , toField qtnUuid - ] - ++ toRow event - logInsertAndUpdate sql params - let action conn = execute conn sql params - runDB action - return () - -insertQuestionnaireEvents :: [QuestionnaireEvent] -> AppContextM Int64 -insertQuestionnaireEvents events = do - if null events - then return 0 - else do - tenantUuid <- asks currentTenantUuid - let sql = - fromString $ - f' - "INSERT INTO questionnaire_event VALUES %s" - [generateQuestionMarksForEntities events] - let params = concatMap toRow events - logInsertAndUpdate sql params - let action conn = execute conn sql params - runDB action - -updateQuestionnaireEventByUuid :: QuestionnaireEvent -> AppContextM Int64 -updateQuestionnaireEventByUuid event = do - tenantUuid <- asks currentTenantUuid - let sql = fromString "UPDATE questionnaire_event SET uuid = ?, event_type = ?, path = ?, created_at = ?, created_by = ?, questionnaire_uuid = ?, tenant_uuid = ?, value_type = ?, value = ?, value_id = ?, value_raw = ? WHERE uuid = ? AND tenant_uuid = ?" - let params = toRow event ++ [toField (getUuid event), toField tenantUuid] - logQuery sql params - let action conn = execute conn sql params - runDB action - -syncQuestionnaireEventsWithDb :: [QuestionnaireEvent] -> [QuestionnaireEvent] -> AppContextM () -syncQuestionnaireEventsWithDb oldEvents newEvents = do - let dbEventMap = map getUuid oldEvents - let newEventMap = map getUuid newEvents - let toDelete = dbEventMap L.\\ newEventMap - let toInsert = filter (\e -> getUuid e `notElem` dbEventMap) newEvents - let toUpdate = filter (\e -> e `notElem` oldEvents && getUuid e `elem` dbEventMap) newEvents - unless (null toInsert) (void $ insertQuestionnaireEvents toInsert) - traverse_ updateQuestionnaireEventByUuid toUpdate - void $ deleteQuestionnaireEventsByUuids toDelete - -deleteQuestionnaireEvents :: AppContextM Int64 -deleteQuestionnaireEvents = createDeleteEntitiesFn entityName - -deleteQuestionnaireEventsByUuids :: [U.UUID] -> AppContextM () -deleteQuestionnaireEventsByUuids eventUuids = - unless - (null eventUuids) - (void $ createDeleteEntityWhereInFn entityName "uuid" (fmap U.toString eventUuids)) - -deleteQuestionnaireEventsByQuestionnaireUuid :: U.UUID -> AppContextM Int64 -deleteQuestionnaireEventsByQuestionnaireUuid questionnaireUuid = do - tenantUuid <- asks currentTenantUuid - createDeleteEntitiesByFn entityName [tenantQueryUuid tenantUuid, ("questionnaire_uuid", U.toString questionnaireUuid)] diff --git a/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireFileDAO.hs b/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireFileDAO.hs deleted file mode 100644 index af1528272..000000000 --- a/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireFileDAO.hs +++ /dev/null @@ -1,142 +0,0 @@ -module Wizard.Database.DAO.Questionnaire.QuestionnaireFileDAO where - -import Control.Monad.Reader (asks) -import Data.String -import Data.Time -import qualified Data.UUID as U -import Database.PostgreSQL.Simple -import GHC.Int - -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.PageMetadata -import Shared.Common.Model.Common.Pageable -import Shared.Common.Model.Common.Sort -import Shared.Common.Util.String -import Wizard.Database.DAO.Common -import Wizard.Database.Mapping.Questionnaire.QuestionnaireFile () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireFileList () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireFileSimple () -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.ContextLenses () -import Wizard.Model.Questionnaire.QuestionnaireFile -import Wizard.Model.Questionnaire.QuestionnaireFileList -import Wizard.Model.Questionnaire.QuestionnaireFileSimple - -entityName = "questionnaire_file" - -pageLabel = "questionnaireFiles" - -findQuestionnaireFilesPage :: Maybe String -> Maybe U.UUID -> Pageable -> [Sort] -> AppContextM (Page QuestionnaireFileList) -findQuestionnaireFilesPage mQuery mQtnUuid pageable sort = do - -- 1. Prepare variables - do - tenantUuid <- asks currentTenantUuid - let (queryCondition, queryParam) = - case mQuery of - Nothing -> ("", []) - Just query -> (" AND file_name ~* ?", [query]) - let (qtnUuidCondition, qtnUuidParam) = - case mQtnUuid of - Nothing -> ("", []) - Just qtnUuid -> (" AND questionnaire_uuid = ?", [U.toString qtnUuid]) - let condition = - f'' - "WHERE file.tenant_uuid = ? ${queryCondition} ${qtnUuidCondition}" - [ ("queryCondition", queryCondition) - , ("qtnUuidCondition", qtnUuidCondition) - ] - let conditionParams = - [U.toString tenantUuid] - ++ queryParam - ++ qtnUuidParam - let (sizeI, pageI, skip, limit) = preparePaginationVariables pageable - -- 2. Get total count - count <- createCountByFn "questionnaire_file file" condition conditionParams - -- 3. Get entities - let sql = - fromString $ - f'' - "SELECT file.uuid, \ - \ file.file_name, \ - \ file.content_type, \ - \ file.file_size, \ - \ file.created_at, \ - \ questionnaire.uuid, \ - \ questionnaire.name, \ - \ created_by.uuid, \ - \ created_by.first_name, \ - \ created_by.last_name, \ - \ created_by.email, \ - \ created_by.image_url \ - \FROM questionnaire_file file \ - \LEFT JOIN user_entity created_by ON created_by.uuid = file.created_by AND created_by.tenant_uuid = file.tenant_uuid \ - \LEFT JOIN questionnaire ON questionnaire.uuid = file.questionnaire_uuid AND questionnaire.tenant_uuid = file.tenant_uuid \ - \${condition} \ - \${sort} \ - \OFFSET ${offset} \ - \LIMIT ${limit}" - [ ("condition", condition) - , ("sort", mapSort sort) - , ("offset", show skip) - , ("limit", show sizeI) - ] - logQuery sql conditionParams - let action conn = query conn sql conditionParams - entities <- runDB action - -- 4. Constructor response - let metadata = - PageMetadata - { size = sizeI - , totalElements = count - , totalPages = computeTotalPage count sizeI - , number = pageI - } - return $ Page pageLabel metadata entities - -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)] - -findQuestionnaireFileByUuid :: U.UUID -> AppContextM QuestionnaireFile -findQuestionnaireFileByUuid uuid = do - tenantUuid <- asks currentTenantUuid - createFindEntityByFn entityName [tenantQueryUuid tenantUuid, ("uuid", U.toString uuid)] - -sumQuestionnaireFileSize :: AppContextM Int64 -sumQuestionnaireFileSize = do - tenantUuid <- asks currentTenantUuid - sumQuestionnaireFileSizeWithTenant tenantUuid - -sumQuestionnaireFileSizeWithTenant :: U.UUID -> AppContextM Int64 -sumQuestionnaireFileSizeWithTenant tenantUuid = createSumByFn entityName "file_size" tenantCondition [U.toString tenantUuid] - -insertQuestionnaireFile :: QuestionnaireFile -> AppContextM Int64 -insertQuestionnaireFile = createInsertFn entityName - -deleteQuestionnaireFiles :: AppContextM Int64 -deleteQuestionnaireFiles = createDeleteEntitiesFn entityName - -deleteQuestionnaireFilesNewerThen :: U.UUID -> UTCTime -> AppContextM Int64 -deleteQuestionnaireFilesNewerThen qtnUuid timestamp = do - tenantUuid <- asks currentTenantUuid - let sql = - fromString - "DELETE FROM questionnaire_file \ - \WHERE tenant_uuid = ? \ - \ AND questionnaire_uuid = ? \ - \ AND created_at > ?" - let params = [U.toString tenantUuid, U.toString qtnUuid, show timestamp] - logQuery sql params - let action conn = execute conn sql params - runDB action - -deleteQuestionnaireFileByUuid :: U.UUID -> AppContextM Int64 -deleteQuestionnaireFileByUuid uuid = do - tenantUuid <- asks currentTenantUuid - createDeleteEntityByFn entityName [tenantQueryUuid tenantUuid, ("uuid", U.toString uuid)] diff --git a/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnairePermDAO.hs b/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnairePermDAO.hs deleted file mode 100644 index 4efa45e1f..000000000 --- a/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnairePermDAO.hs +++ /dev/null @@ -1,57 +0,0 @@ -module Wizard.Database.DAO.Questionnaire.QuestionnairePermDAO where - -import Control.Monad.Reader (asks) -import Data.String -import qualified Data.UUID as U -import Database.PostgreSQL.Simple -import GHC.Int - -import Shared.Common.Util.Logger -import Wizard.Database.DAO.Common -import Wizard.Database.Mapping.Questionnaire.QuestionnairePerm () -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.ContextLenses () -import Wizard.Model.Questionnaire.QuestionnairePerm - -entityName_user = "questionnaire_perm_user" - -entityName_group = "questionnaire_perm_group" - -findQuestionnairePermsFiltered :: [(String, String)] -> AppContextM [QuestionnairePerm] -findQuestionnairePermsFiltered queryParams = do - let sql = - fromString $ - f' - "SELECT questionnaire_uuid, 'UserQuestionnairePermType' AS member_type, user_uuid as member_uuid, perms, tenant_uuid \ - \ FROM %s \ - \ WHERE %s \ - \ UNION \ - \ SELECT questionnaire_uuid, 'UserGroupQuestionnairePermType' AS member_type, user_group_uuid as member_uuid, perms, tenant_uuid \ - \ FROM %s \ - \ WHERE %s" - [entityName_user, mapToDBQuerySql queryParams, entityName_group, mapToDBQuerySql queryParams] - let params = fmap snd queryParams ++ fmap snd queryParams - logQuery sql params - let action conn = query conn sql params - runDB action - -insertQuestionnairePerm :: QuestionnairePerm -> AppContextM Int64 -insertQuestionnairePerm perm = - case perm.memberType of - UserQuestionnairePermType -> createInsertFn entityName_user perm - UserGroupQuestionnairePermType -> createInsertFn entityName_group perm - -deleteQuestionnairePerms :: AppContextM Int64 -deleteQuestionnairePerms = do - createDeleteEntitiesFn entityName_user - createDeleteEntitiesFn entityName_group - -deleteQuestionnairePermsFiltered :: [(String, String)] -> AppContextM Int64 -deleteQuestionnairePermsFiltered queryParams = do - createDeleteEntitiesByFn entityName_user queryParams - createDeleteEntitiesByFn entityName_group queryParams - -deleteQuestionnairePermGroupByUserGroupUuid :: U.UUID -> AppContextM Int64 -deleteQuestionnairePermGroupByUserGroupUuid userGroupUuid = do - tenantUuid <- asks currentTenantUuid - createDeleteEntitiesByFn entityName_group [tenantQueryUuid tenantUuid, ("user_group_uuid", U.toString userGroupUuid)] diff --git a/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireProjectTagDAO.hs b/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireProjectTagDAO.hs deleted file mode 100644 index 72669f68b..000000000 --- a/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireProjectTagDAO.hs +++ /dev/null @@ -1,65 +0,0 @@ -module Wizard.Database.DAO.Questionnaire.QuestionnaireProjectTagDAO where - -import Control.Monad.Reader (asks) -import Data.String -import qualified Data.UUID as U - -import Shared.Common.Database.DAO.Common -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.Pageable -import Shared.Common.Model.Common.Sort -import Shared.Common.Util.Logger -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.ContextLenses () - -entityName = "questionnaire" - -pageLabel = "projectTags" - -findQuestionnaireProjectTagsPage :: Maybe String -> [String] -> Pageable -> [Sort] -> AppContextM (Page String) -findQuestionnaireProjectTagsPage mQuery excludeTags pageable sort = - -- 1. Prepare variables - do - tenantUuid <- asks currentTenantUuid - let params = [U.toString tenantUuid, U.toString tenantUuid, regexM mQuery] ++ excludeTags - let (sizeI, pageI, skip, limit) = preparePaginationVariables pageable - -- 2. Get total count - count <- findCount excludeTags params - -- 3. Prepare SQL - let sql = - fromString $ - f' - "SELECT * \ - \FROM (%s) merged \ - \WHERE merged.project_tag ~* ? %s \ - \%s \ - \OFFSET %s LIMIT %s" - [sqlBase, excludeTagsCondition excludeTags, mapSort sort, show skip, show sizeI] - createFindColumnBySqlPageFn pageLabel pageable sql params count - -findCount :: [String] -> [String] -> AppContextM Int -findCount excludeTags params = do - let sql = - fromString $ - f' - "SELECT COUNT(*) \ - \FROM (%s) merged \ - \WHERE merged.project_tag::text ~* ? %s" - [sqlBase, excludeTagsCondition excludeTags] - createCountWithSqlFn sql params - -sqlBase :: String -sqlBase = - "SELECT unnest(project_tagging_tags) as project_tag \ - \FROM config_questionnaire \ - \WHERE tenant_uuid = ? \ - \UNION \ - \SELECT nested.project_tag \ - \FROM (SELECT unnest(project_tags) as project_tag, tenant_uuid FROM questionnaire) nested \ - \WHERE nested.tenant_uuid = ? " - -excludeTagsCondition :: [String] -> String -excludeTagsCondition excludeTags = - if null excludeTags - then "" - else f' "AND NOT (project_tag IN (%s))" [generateQuestionMarks excludeTags] diff --git a/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireUserDAO.hs b/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireUserDAO.hs deleted file mode 100644 index e02639966..000000000 --- a/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireUserDAO.hs +++ /dev/null @@ -1,122 +0,0 @@ -module Wizard.Database.DAO.Questionnaire.QuestionnaireUserDAO where - -import Control.Monad.Reader (asks) -import Data.String (fromString) -import qualified Data.UUID as U -import Database.PostgreSQL.Simple - -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.PageMetadata -import Shared.Common.Model.Common.Pageable -import Shared.Common.Model.Common.Sort -import Shared.Common.Util.String -import Wizard.Database.DAO.Common -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.ContextLenses () -import WizardLib.Public.Database.Mapping.User.UserSimple () -import WizardLib.Public.Model.User.UserSimple - -findQuestionnaireUserSuggestionsPage :: U.UUID -> String -> Maybe String -> Pageable -> [Sort] -> AppContextM (Page UserSimple) -findQuestionnaireUserSuggestionsPage qtnUuid perm mQuery pageable sort = - -- 1. Prepare variables - do - tenantUuid <- asks currentTenantUuid - let (qCondition, qRegex) = - ( "WHERE (concat(first_name, ' ', last_name) ~* ? OR email ~* ?)" - , [regexM mQuery, regexM mQuery] - ) - let params = [U.toString qtnUuid, U.toString tenantUuid, U.toString qtnUuid, U.toString tenantUuid] ++ qRegex - let (sizeI, pageI, skip, limit) = preparePaginationVariables pageable - -- 2. Get total count - let countSql = - fromString $ - f'' - "SELECT DISTINCT COUNT(uuid) \ - \FROM (SELECT u.uuid, \ - \ u.first_name, \ - \ u.last_name, \ - \ u.email \ - \ FROM questionnaire_perm_user qtn_perm_user \ - \ JOIN user_entity u ON qtn_perm_user.user_uuid = u.uuid AND qtn_perm_user.tenant_uuid = u.tenant_uuid \ - \ WHERE qtn_perm_user.questionnaire_uuid = ? \ - \ AND qtn_perm_user.tenant_uuid = ? \ - \ AND qtn_perm_user.perms @> ARRAY ['${perm}'] \ - \ AND u.active = true \ - \ AND u.machine = false \ - \ UNION ALL \ - \ SELECT u.uuid, \ - \ u.first_name, \ - \ u.last_name, \ - \ u.email \ - \ FROM questionnaire_perm_group qtn_perm_group \ - \ LEFT JOIN user_group_membership ug_membership ON ug_membership.user_group_uuid = qtn_perm_group.user_group_uuid AND ug_membership.tenant_uuid = qtn_perm_group.tenant_uuid \ - \ LEFT JOIN user_entity u ON u.uuid = ug_membership.user_uuid AND u.tenant_uuid = qtn_perm_group.tenant_uuid \ - \ WHERE qtn_perm_group.questionnaire_uuid = ? \ - \ AND qtn_perm_group.tenant_uuid = ? \ - \ AND qtn_perm_group.perms @> ARRAY ['${perm}'] \ - \ AND u.active = true \ - \ AND u.machine = false) u \ - \${qCondition}" - [ ("qCondition", qCondition) - , ("perm", perm) - ] - logQuery countSql params - let action conn = query conn countSql params - result <- runDB action - let count = - case result of - [count] -> fromOnly count - _ -> 0 - -- 3. Get entities - let sql = - fromString $ - f'' - "SELECT DISTINCT * \ - \FROM (SELECT u.uuid, \ - \ u.first_name, \ - \ u.last_name, \ - \ u.email, \ - \ u.image_url \ - \ FROM questionnaire_perm_user qtn_perm_user \ - \ JOIN user_entity u ON qtn_perm_user.user_uuid = u.uuid AND qtn_perm_user.tenant_uuid = u.tenant_uuid \ - \ WHERE qtn_perm_user.questionnaire_uuid = ? \ - \ AND qtn_perm_user.tenant_uuid = ? \ - \ AND qtn_perm_user.perms @> ARRAY ['${perm}'] \ - \ AND u.active = true \ - \ AND u.machine = false \ - \ UNION ALL \ - \ SELECT u.uuid, \ - \ u.first_name, \ - \ u.last_name, \ - \ u.email, \ - \ u.image_url \ - \ FROM questionnaire_perm_group qtn_perm_group \ - \ LEFT JOIN user_group_membership ug_membership ON ug_membership.user_group_uuid = qtn_perm_group.user_group_uuid AND ug_membership.tenant_uuid = qtn_perm_group.tenant_uuid \ - \ LEFT JOIN user_entity u ON u.uuid = ug_membership.user_uuid AND u.tenant_uuid = qtn_perm_group.tenant_uuid \ - \ WHERE qtn_perm_group.questionnaire_uuid = ? \ - \ AND qtn_perm_group.tenant_uuid = ? \ - \ AND qtn_perm_group.perms @> ARRAY ['${perm}'] \ - \ AND u.active = true \ - \ AND u.machine = false) u \ - \${qCondition} \ - \${sort} \ - \OFFSET ${offset} \ - \LIMIT ${limit}" - [ ("qCondition", qCondition) - , ("perm", perm) - , ("sort", mapSort sort) - , ("offset", show skip) - , ("limit", show sizeI) - ] - logQuery sql params - let action conn = query conn sql params - entities <- runDB action - -- 5. Constructor response - let metadata = - PageMetadata - { size = sizeI - , totalElements = count - , totalPages = computeTotalPage count sizeI - , number = pageI - } - return $ Page "users" metadata entities diff --git a/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireVersionDAO.hs b/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireVersionDAO.hs deleted file mode 100644 index 1190a8225..000000000 --- a/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireVersionDAO.hs +++ /dev/null @@ -1,97 +0,0 @@ -module Wizard.Database.DAO.Questionnaire.QuestionnaireVersionDAO where - -import Control.Monad (unless, void) -import Control.Monad.Reader (asks) -import Data.String (fromString) -import Data.Time -import qualified Data.UUID as U -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.ToField -import Database.PostgreSQL.Simple.ToRow -import GHC.Int - -import Shared.Common.Util.Logger -import Shared.Common.Util.String -import Wizard.Database.DAO.Common -import Wizard.Database.Mapping.Questionnaire.QuestionnaireVersion () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireVersionList () -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.ContextLenses () -import Wizard.Model.Questionnaire.QuestionnaireVersion -import Wizard.Model.Questionnaire.QuestionnaireVersionList - -entityName = "questionnaire_version" - -pageLabel = "questionnaireVersions" - -findQuestionnaireVersionsByQuestionnaireUuid :: U.UUID -> AppContextM [QuestionnaireVersion] -findQuestionnaireVersionsByQuestionnaireUuid qtnUuid = do - tenantUuid <- asks currentTenantUuid - createFindEntitiesWithFieldsByFn "*" entityName [tenantQueryUuid tenantUuid, ("questionnaire_uuid", U.toString qtnUuid)] - -findQuestionnaireVersionListByQuestionnaireUuidAndCreatedAt :: U.UUID -> Maybe UTCTime -> AppContextM [QuestionnaireVersionList] -findQuestionnaireVersionListByQuestionnaireUuidAndCreatedAt questionnaireUuid mCreatedAt = do - tenantUuid <- asks currentTenantUuid - let (createdAtCondition, createdAtParams) = - case mCreatedAt of - Just createdAt -> ("AND v.created_at <= ?", [toField createdAt]) - Nothing -> ("", []) - let sql = - fromString $ - f'' - "SELECT v.uuid, \ - \ v.name, \ - \ v.description, \ - \ v.event_uuid, \ - \ v.created_at, \ - \ v.updated_at, \ - \ u.uuid, \ - \ u.first_name, \ - \ u.last_name, \ - \ u.email, \ - \ u.image_url \ - \FROM questionnaire_version v \ - \JOIN user_entity u ON u.uuid = v.created_by AND u.tenant_uuid = v.tenant_uuid ${createdAtCondition} \ - \WHERE v.tenant_uuid = ? AND v.questionnaire_uuid = ? \ - \ORDER BY v.created_at" - [("createdAtCondition", createdAtCondition)] - let params = createdAtParams ++ [toField tenantUuid, toField questionnaireUuid] - logInfoI _CMP_DATABASE sql - let action conn = query conn (fromString sql) params - runDB action - -findQuestionnaireVersionByUuid :: U.UUID -> AppContextM QuestionnaireVersion -findQuestionnaireVersionByUuid uuid = do - tenantUuid <- asks currentTenantUuid - createFindEntityWithFieldsByFn "*" False entityName [tenantQueryUuid tenantUuid, ("uuid", U.toString uuid)] - -findQuestionnaireVersionByEventUuid' :: U.UUID -> U.UUID -> AppContextM (Maybe QuestionnaireVersion) -findQuestionnaireVersionByEventUuid' questionnaireUuid eventUuid = do - tenantUuid <- asks currentTenantUuid - createFindEntityByFn' entityName [tenantQueryUuid tenantUuid, ("questionnaire_uuid", U.toString questionnaireUuid), ("event_uuid", U.toString eventUuid)] - -insertQuestionnaireVersion :: QuestionnaireVersion -> AppContextM Int64 -insertQuestionnaireVersion = createInsertFn entityName - -updateQuestionnaireVersionByUuid :: QuestionnaireVersion -> AppContextM Int64 -updateQuestionnaireVersionByUuid version = do - tenantUuid <- asks currentTenantUuid - let sql = fromString "UPDATE questionnaire_version SET uuid = ?, name = ?, description = ?, event_uuid = ?, questionnaire_uuid = ?, tenant_uuid = ?, created_by = ?, created_at = ?, updated_at = ? WHERE uuid = ? AND tenant_uuid = ?" - let params = toRow version ++ [toField version.uuid, toField tenantUuid] - logQuery sql params - let action conn = execute conn sql params - runDB action - -deleteQuestionnaireVersions :: AppContextM Int64 -deleteQuestionnaireVersions = createDeleteEntitiesFn entityName - -deleteQuestionnaireVersionsByUuids :: [U.UUID] -> AppContextM () -deleteQuestionnaireVersionsByUuids versionUuids = - unless - (null versionUuids) - (void $ createDeleteEntityWhereInFn entityName "uuid" (fmap U.toString versionUuids)) - -deleteQuestionnaireVersionByUuid :: U.UUID -> AppContextM Int64 -deleteQuestionnaireVersionByUuid uuid = do - tenantUuid <- asks currentTenantUuid - createDeleteEntitiesByFn entityName [tenantQueryUuid tenantUuid, ("uuid", U.toString uuid)] diff --git a/wizard-server/src/Wizard/Database/DAO/QuestionnaireAction/QuestionnaireActionDAO.hs b/wizard-server/src/Wizard/Database/DAO/QuestionnaireAction/QuestionnaireActionDAO.hs deleted file mode 100644 index 723ee604f..000000000 --- a/wizard-server/src/Wizard/Database/DAO/QuestionnaireAction/QuestionnaireActionDAO.hs +++ /dev/null @@ -1,169 +0,0 @@ -module Wizard.Database.DAO.QuestionnaireAction.QuestionnaireActionDAO where - -import Control.Monad.Reader (asks) -import Data.String (fromString) -import Data.Time -import qualified Data.UUID as U -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.ToField -import Database.PostgreSQL.Simple.ToRow -import GHC.Int - -import Shared.Common.Database.DAO.Common hiding (runInTransaction) -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.PageMetadata -import Shared.Common.Model.Common.Pageable -import Shared.Common.Model.Common.Sort -import Shared.Common.Util.Logger -import Wizard.Database.Mapping.QuestionnaireAction.QuestionnaireAction () -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.ContextLenses () -import Wizard.Model.QuestionnaireAction.QuestionnaireAction - -entityName = "questionnaire_action" - -pageLabel = "questionnaireActions" - -findQuestionnaireActionsPage - :: Maybe String - -> Maybe String - -> Maybe String - -> Maybe Bool - -> Pageable - -> [Sort] - -> AppContextM (Page QuestionnaireAction) -findQuestionnaireActionsPage mOrganizationId mImporterId mQuery mEnabled pageable sort = - createFindEntitiesGroupByCoordinatePageableQuerySortFn - entityName - pageLabel - pageable - sort - "*" - "action_id" - mQuery - mEnabled - mOrganizationId - mImporterId - -findQuestionnaireActionById :: String -> AppContextM QuestionnaireAction -findQuestionnaireActionById qaId = do - tenantUuid <- asks currentTenantUuid - createFindEntityByFn entityName [tenantQueryUuid tenantUuid, ("id", qaId)] - -insertQuestionnaireAction :: QuestionnaireAction -> AppContextM Int64 -insertQuestionnaireAction = createInsertFn entityName - -updateQuestionnaireActionById :: QuestionnaireAction -> AppContextM Int64 -updateQuestionnaireActionById importer = do - tenantUuid <- asks currentTenantUuid - let sql = - fromString - "UPDATE questionnaire_action SET id = ?, name = ?, organization_id = ?, action_id = ?, version = ?, metamodel_version = ?, description = ?, readme = ?, license = ?, allowed_packages = ?, url = ?, config = ?, enabled = ?, tenant_uuid = ?, created_at = ?, updated_at = ? WHERE tenant_uuid = ? AND id = ?" - let params = toRow importer ++ [toField tenantUuid, toField importer.qaId] - logQuery sql params - let action conn = execute conn sql params - runDB action - -updateQuestionnaireActionPasswordById :: String -> Bool -> UTCTime -> AppContextM Int64 -updateQuestionnaireActionPasswordById qaId enabled uUpdatedAt = do - tenantUuid <- asks currentTenantUuid - let sql = fromString "UPDATE questionnaire_action SET enabled = ?, updated_at = ? WHERE tenant_uuid = ? AND uuid = ?" - let params = [toField enabled, toField uUpdatedAt, toField tenantUuid, toField qaId] - logQuery sql params - let action conn = execute conn sql params - runDB action - -deleteQuestionnaireActions :: AppContextM Int64 -deleteQuestionnaireActions = createDeleteEntitiesFn entityName - -deleteQuestionnaireActionById :: String -> AppContextM Int64 -deleteQuestionnaireActionById qaId = do - tenantUuid <- asks currentTenantUuid - createDeleteEntityByFn entityName [tenantQueryUuid tenantUuid, ("id", qaId)] - --- -------------------------------- --- PRIVATE --- -------------------------------- -createFindEntitiesGroupByCoordinatePageableQuerySortFn entityName pageLabel pageable sort fields entityId mQuery mEnabled mOrganizationId mEntityId = - -- 1. Prepare variables - do - tenantUuid <- asks currentTenantUuid - let (sizeI, pageI, skip, limit) = preparePaginationVariables pageable - let enabledCondition = - case mEnabled of - Just True -> "enabled = true AND" - Just False -> "enabled = false AND" - _ -> "" - -- 2. Get total count - count <- createCountGroupByCoordinateFn entityName entityId mQuery enabledCondition mOrganizationId mEntityId - -- 3. Get entities - let sql = - f' - "SELECT %s \ - \FROM %s \ - \WHERE tenant_uuid = ? AND id IN ( \ - \ SELECT CONCAT(organization_id, ':', %s, ':', (max(string_to_array(version, '.')::int[]))[1] || '.' || \ - \ (max(string_to_array(version, '.')::int[]))[2] || '.' || \ - \ (max(string_to_array(version, '.')::int[]))[3]) \ - \ FROM %s \ - \ WHERE %s tenant_uuid = ? AND (name ~* ? OR id ~* ?) %s \ - \ GROUP BY organization_id, %s \ - \) \ - \%s \ - \offset %s \ - \limit %s" - [ fields - , entityName - , entityId - , entityName - , enabledCondition - , mapToDBCoordinatesSql entityName entityId mOrganizationId mEntityId - , entityId - , mapSort sort - , show skip - , show sizeI - ] - logInfo _CMP_DATABASE sql - let action conn = - query - conn - (fromString sql) - ( U.toString tenantUuid - : U.toString tenantUuid - : regexM mQuery - : regexM mQuery - : mapToDBCoordinatesParams mOrganizationId mEntityId - ) - entities <- runDB action - -- 4. Constructor response - let metadata = - PageMetadata - { size = sizeI - , totalElements = count - , totalPages = computeTotalPage count sizeI - , number = pageI - } - return $ Page pageLabel metadata entities - -createCountGroupByCoordinateFn - :: String -> String -> Maybe String -> String -> Maybe String -> Maybe String -> AppContextM Int -createCountGroupByCoordinateFn entityName entityId mQuery enabledCondition mOrganizationId mEntityId = do - tenantUuid <- asks currentTenantUuid - let sql = - f' - "SELECT COUNT(*) \ - \ FROM (SELECT COUNT(*) \ - \ FROM %s \ - \ WHERE %s tenant_uuid = ? AND (name ~* ? OR id ~* ?) %s \ - \ GROUP BY organization_id, %s) p" - [entityName, enabledCondition, mapToDBCoordinatesSql entityName entityId mOrganizationId mEntityId, entityId] - logInfo _CMP_DATABASE sql - let action conn = - query - conn - (fromString sql) - (U.toString tenantUuid : regexM mQuery : regexM mQuery : mapToDBCoordinatesParams mOrganizationId mEntityId) - result <- runDB action - case result of - [count] -> return . fromOnly $ count - _ -> return 0 diff --git a/wizard-server/src/Wizard/Database/DAO/QuestionnaireImporter/QuestionnaireImporterDAO.hs b/wizard-server/src/Wizard/Database/DAO/QuestionnaireImporter/QuestionnaireImporterDAO.hs deleted file mode 100644 index 7aa38cd9c..000000000 --- a/wizard-server/src/Wizard/Database/DAO/QuestionnaireImporter/QuestionnaireImporterDAO.hs +++ /dev/null @@ -1,169 +0,0 @@ -module Wizard.Database.DAO.QuestionnaireImporter.QuestionnaireImporterDAO where - -import Control.Monad.Reader (asks) -import Data.String (fromString) -import Data.Time -import qualified Data.UUID as U -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.ToField -import Database.PostgreSQL.Simple.ToRow -import GHC.Int - -import Shared.Common.Database.DAO.Common hiding (runInTransaction) -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.PageMetadata -import Shared.Common.Model.Common.Pageable -import Shared.Common.Model.Common.Sort -import Shared.Common.Util.Logger -import Wizard.Database.Mapping.QuestionnaireImporter.QuestionnaireImporter () -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.ContextLenses () -import Wizard.Model.QuestionnaireImporter.QuestionnaireImporter - -entityName = "questionnaire_importer" - -pageLabel = "questionnaireImporters" - -findQuestionnaireImportersPage - :: Maybe String - -> Maybe String - -> Maybe String - -> Maybe Bool - -> Pageable - -> [Sort] - -> AppContextM (Page QuestionnaireImporter) -findQuestionnaireImportersPage mOrganizationId mImporterId mQuery mEnabled pageable sort = - createFindEntitiesGroupByCoordinatePageableQuerySortFn - entityName - pageLabel - pageable - sort - "*" - "importer_id" - mQuery - mEnabled - mOrganizationId - mImporterId - -findQuestionnaireImporterById :: String -> AppContextM QuestionnaireImporter -findQuestionnaireImporterById qiId = do - tenantUuid <- asks currentTenantUuid - createFindEntityByFn entityName [tenantQueryUuid tenantUuid, ("id", qiId)] - -insertQuestionnaireImporter :: QuestionnaireImporter -> AppContextM Int64 -insertQuestionnaireImporter = createInsertFn entityName - -updateQuestionnaireImporterById :: QuestionnaireImporter -> AppContextM Int64 -updateQuestionnaireImporterById importer = do - tenantUuid <- asks currentTenantUuid - let sql = - fromString - "UPDATE questionnaire_importer SET id = ?, name = ?, organization_id = ?, importer_id = ?, version = ?, metamodel_version = ?, description = ?, readme = ?, license = ?, allowed_packages = ?, url = ?, enabled = ?, tenant_uuid = ?, created_at = ?, updated_at = ? WHERE tenant_uuid = ? AND id = ?" - let params = toRow importer ++ [toField tenantUuid, toField importer.qiId] - logQuery sql params - let action conn = execute conn sql params - runDB action - -updateQuestionnaireImporterPasswordById :: String -> Bool -> UTCTime -> AppContextM Int64 -updateQuestionnaireImporterPasswordById qiId enabled uUpdatedAt = do - tenantUuid <- asks currentTenantUuid - let sql = fromString "UPDATE questionnaire_importer SET enabled = ?, updated_at = ? WHERE tenant_uuid = ? AND uuid = ?" - let params = [toField enabled, toField uUpdatedAt, toField tenantUuid, toField qiId] - logQuery sql params - let action conn = execute conn sql params - runDB action - -deleteQuestionnaireImporters :: AppContextM Int64 -deleteQuestionnaireImporters = createDeleteEntitiesFn entityName - -deleteQuestionnaireImporterById :: String -> AppContextM Int64 -deleteQuestionnaireImporterById qiId = do - tenantUuid <- asks currentTenantUuid - createDeleteEntityByFn entityName [tenantQueryUuid tenantUuid, ("id", qiId)] - --- -------------------------------- --- PRIVATE --- -------------------------------- -createFindEntitiesGroupByCoordinatePageableQuerySortFn entityName pageLabel pageable sort fields entityId mQuery mEnabled mOrganizationId mEntityId = - -- 1. Prepare variables - do - tenantUuid <- asks currentTenantUuid - let (sizeI, pageI, skip, limit) = preparePaginationVariables pageable - let enabledCondition = - case mEnabled of - Just True -> "enabled = true AND" - Just False -> "enabled = false AND" - _ -> "" - -- 2. Get total count - count <- createCountGroupByCoordinateFn entityName entityId mQuery enabledCondition mOrganizationId mEntityId - -- 3. Get entities - let sql = - f' - "SELECT %s \ - \FROM %s \ - \WHERE tenant_uuid = ? AND id IN ( \ - \ SELECT CONCAT(organization_id, ':', %s, ':', (max(string_to_array(version, '.')::int[]))[1] || '.' || \ - \ (max(string_to_array(version, '.')::int[]))[2] || '.' || \ - \ (max(string_to_array(version, '.')::int[]))[3]) \ - \ FROM %s \ - \ WHERE %s tenant_uuid = ? AND (name ~* ? OR id ~* ?) %s \ - \ GROUP BY organization_id, %s \ - \) \ - \%s \ - \offset %s \ - \limit %s" - [ fields - , entityName - , entityId - , entityName - , enabledCondition - , mapToDBCoordinatesSql entityName entityId mOrganizationId mEntityId - , entityId - , mapSort sort - , show skip - , show sizeI - ] - logInfo _CMP_DATABASE sql - let action conn = - query - conn - (fromString sql) - ( U.toString tenantUuid - : U.toString tenantUuid - : regexM mQuery - : regexM mQuery - : mapToDBCoordinatesParams mOrganizationId mEntityId - ) - entities <- runDB action - -- 4. Constructor response - let metadata = - PageMetadata - { size = sizeI - , totalElements = count - , totalPages = computeTotalPage count sizeI - , number = pageI - } - return $ Page pageLabel metadata entities - -createCountGroupByCoordinateFn - :: String -> String -> Maybe String -> String -> Maybe String -> Maybe String -> AppContextM Int -createCountGroupByCoordinateFn entityName entityId mQuery enabledCondition mOrganizationId mEntityId = do - tenantUuid <- asks currentTenantUuid - let sql = - f' - "SELECT COUNT(*) \ - \ FROM (SELECT COUNT(*) \ - \ FROM %s \ - \ WHERE %s tenant_uuid = ? AND (name ~* ? OR id ~* ?) %s \ - \ GROUP BY organization_id, %s) p" - [entityName, enabledCondition, mapToDBCoordinatesSql entityName entityId mOrganizationId mEntityId, entityId] - logInfo _CMP_DATABASE sql - let action conn = - query - conn - (fromString sql) - (U.toString tenantUuid : regexM mQuery : regexM mQuery : mapToDBCoordinatesParams mOrganizationId mEntityId) - result <- runDB action - case result of - [count] -> return . fromOnly $ count - _ -> return 0 diff --git a/wizard-server/src/Wizard/Database/DAO/Tenant/Config/TenantConfigProjectDAO.hs b/wizard-server/src/Wizard/Database/DAO/Tenant/Config/TenantConfigProjectDAO.hs new file mode 100644 index 000000000..16aaffcd2 --- /dev/null +++ b/wizard-server/src/Wizard/Database/DAO/Tenant/Config/TenantConfigProjectDAO.hs @@ -0,0 +1,58 @@ +module Wizard.Database.DAO.Tenant.Config.TenantConfigProjectDAO where + +import Control.Monad.Reader (asks) +import Data.String +import qualified Data.UUID as U +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.ToField +import Database.PostgreSQL.Simple.ToRow +import GHC.Int + +import Wizard.Database.DAO.Common +import Wizard.Database.Mapping.Tenant.Config.TenantConfigProject () +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.ContextLenses () +import Wizard.Model.Tenant.Config.TenantConfig + +entityName = "config_project" + +findTenantConfigProject :: AppContextM TenantConfigProject +findTenantConfigProject = do + tenantUuid <- asks currentTenantUuid + findTenantConfigProjectByUuid tenantUuid + +findTenantConfigProjectByUuid :: U.UUID -> AppContextM TenantConfigProject +findTenantConfigProjectByUuid uuid = createFindEntityByFn entityName [("tenant_uuid", U.toString uuid)] + +insertTenantConfigProject :: TenantConfigProject -> AppContextM Int64 +insertTenantConfigProject = createInsertFn entityName + +updateTenantConfigProject :: TenantConfigProject -> AppContextM Int64 +updateTenantConfigProject config = do + let sql = + fromString + "UPDATE config_project \ + \SET tenant_uuid = ?, \ + \ visibility_enabled = ?, \ + \ visibility_default_value = ?, \ + \ sharing_enabled = ?, \ + \ sharing_default_value = ?, \ + \ sharing_anonymous_enabled = ?, \ + \ creation = ?, \ + \ project_tagging_enabled = ?, \ + \ project_tagging_tags = ?, \ + \ summary_report = ?, \ + \ feedback_enabled = ?, \ + \ feedback_token = ?, \ + \ feedback_owner = ?, \ + \ feedback_repo = ?, \ + \ created_at = ?, \ + \ updated_at = ? \ + \WHERE tenant_uuid = ?;" + let params = toRow config ++ [toField config.tenantUuid] + logQuery sql params + let action conn = execute conn sql params + runDB action + +deleteTenantConfigProjects :: AppContextM Int64 +deleteTenantConfigProjects = createDeleteEntitiesFn entityName diff --git a/wizard-server/src/Wizard/Database/DAO/Tenant/Config/TenantConfigQuestionnaireDAO.hs b/wizard-server/src/Wizard/Database/DAO/Tenant/Config/TenantConfigQuestionnaireDAO.hs deleted file mode 100644 index 34b0f7a05..000000000 --- a/wizard-server/src/Wizard/Database/DAO/Tenant/Config/TenantConfigQuestionnaireDAO.hs +++ /dev/null @@ -1,58 +0,0 @@ -module Wizard.Database.DAO.Tenant.Config.TenantConfigQuestionnaireDAO where - -import Control.Monad.Reader (asks) -import Data.String -import qualified Data.UUID as U -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.ToField -import Database.PostgreSQL.Simple.ToRow -import GHC.Int - -import Wizard.Database.DAO.Common -import Wizard.Database.Mapping.Tenant.Config.TenantConfigQuestionnaire () -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.ContextLenses () -import Wizard.Model.Tenant.Config.TenantConfig - -entityName = "config_questionnaire" - -findTenantConfigQuestionnaire :: AppContextM TenantConfigQuestionnaire -findTenantConfigQuestionnaire = do - tenantUuid <- asks currentTenantUuid - findTenantConfigQuestionnaireByUuid tenantUuid - -findTenantConfigQuestionnaireByUuid :: U.UUID -> AppContextM TenantConfigQuestionnaire -findTenantConfigQuestionnaireByUuid uuid = createFindEntityByFn entityName [("tenant_uuid", U.toString uuid)] - -insertTenantConfigQuestionnaire :: TenantConfigQuestionnaire -> AppContextM Int64 -insertTenantConfigQuestionnaire = createInsertFn entityName - -updateTenantConfigQuestionnaire :: TenantConfigQuestionnaire -> AppContextM Int64 -updateTenantConfigQuestionnaire config = do - let sql = - fromString - "UPDATE config_questionnaire \ - \SET tenant_uuid = ?, \ - \ visibility_enabled = ?, \ - \ visibility_default_value = ?, \ - \ sharing_enabled = ?, \ - \ sharing_default_value = ?, \ - \ sharing_anonymous_enabled = ?, \ - \ creation = ?, \ - \ project_tagging_enabled = ?, \ - \ project_tagging_tags = ?, \ - \ summary_report = ?, \ - \ feedback_enabled = ?, \ - \ feedback_token = ?, \ - \ feedback_owner = ?, \ - \ feedback_repo = ?, \ - \ created_at = ?, \ - \ updated_at = ? \ - \WHERE tenant_uuid = ?;" - let params = toRow config ++ [toField config.tenantUuid] - logQuery sql params - let action conn = execute conn sql params - runDB action - -deleteTenantConfigQuestionnaires :: AppContextM Int64 -deleteTenantConfigQuestionnaires = createDeleteEntitiesFn entityName diff --git a/wizard-server/src/Wizard/Database/DAO/Tenant/TenantLimitBundleDAO.hs b/wizard-server/src/Wizard/Database/DAO/Tenant/TenantLimitBundleDAO.hs index d75a43695..90373c6a1 100644 --- a/wizard-server/src/Wizard/Database/DAO/Tenant/TenantLimitBundleDAO.hs +++ b/wizard-server/src/Wizard/Database/DAO/Tenant/TenantLimitBundleDAO.hs @@ -34,7 +34,7 @@ updateLimitBundleByUuid limitBundle = do let updatedTenantLimitBundle = limitBundle {updatedAt = now} let sql = fromString - "UPDATE tenant_limit_bundle SET uuid = ?, users = ?, active_users = ?, knowledge_models = ?, knowledge_model_editors = ?, document_templates = ?, questionnaires = ?, documents =?, storage = ?, created_at = ?, updated_at = ?, document_template_drafts = ?, locales = ? WHERE uuid = ?" + "UPDATE tenant_limit_bundle SET uuid = ?, users = ?, active_users = ?, knowledge_models = ?, knowledge_model_editors = ?, document_templates = ?, projects = ?, documents =?, storage = ?, created_at = ?, updated_at = ?, document_template_drafts = ?, locales = ? WHERE uuid = ?" let params = toRow updatedTenantLimitBundle ++ [toField updatedTenantLimitBundle.uuid] logQuery sql params let action conn = execute conn sql params diff --git a/wizard-server/src/Wizard/Database/Mapping/Document/Document.hs b/wizard-server/src/Wizard/Database/Mapping/Document/Document.hs index e20b5cb20..e9a7cfbd7 100644 --- a/wizard-server/src/Wizard/Database/Mapping/Document/Document.hs +++ b/wizard-server/src/Wizard/Database/Mapping/Document/Document.hs @@ -27,9 +27,9 @@ instance ToRow Document where , toField name , toField state , toField durability - , toField questionnaireUuid - , toField questionnaireEventUuid - , toField questionnaireRepliesHash + , toField projectUuid + , toField projectEventUuid + , toField projectRepliesHash , toField documentTemplateId , toField formatUuid , toField createdBy @@ -49,9 +49,9 @@ instance FromRow Document where name <- field state <- field durability <- field - questionnaireUuid <- field - questionnaireEventUuid <- field - questionnaireRepliesHash <- field + projectUuid <- field + projectEventUuid <- field + projectRepliesHash <- field documentTemplateId <- field formatUuid <- field createdBy <- field diff --git a/wizard-server/src/Wizard/Database/Mapping/Document/DocumentList.hs b/wizard-server/src/Wizard/Database/Mapping/Document/DocumentList.hs index 3d6a843af..8a1c1fbf5 100644 --- a/wizard-server/src/Wizard/Database/Mapping/Document/DocumentList.hs +++ b/wizard-server/src/Wizard/Database/Mapping/Document/DocumentList.hs @@ -13,10 +13,10 @@ instance FromRow DocumentList where uuid <- field name <- field state <- field - questionnaireUuid <- field - questionnaireName <- field - questionnaireEventUuid <- field - questionnaireVersion <- field + projectUuid <- field + projectName <- field + projectEventUuid <- field + projectVersion <- field documentTemplateId <- field documentTemplateName <- field documentTemplateFormats <- fieldWith fromJSONField diff --git a/wizard-server/src/Wizard/Database/Mapping/KnowledgeModel/Editor/KnowledgeModelEditorReply.hs b/wizard-server/src/Wizard/Database/Mapping/KnowledgeModel/Editor/KnowledgeModelEditorReply.hs index 33f7bb355..34a168039 100644 --- a/wizard-server/src/Wizard/Database/Mapping/KnowledgeModel/Editor/KnowledgeModelEditorReply.hs +++ b/wizard-server/src/Wizard/Database/Mapping/KnowledgeModel/Editor/KnowledgeModelEditorReply.hs @@ -9,9 +9,9 @@ import Database.PostgreSQL.Simple.ToRow import Database.PostgreSQL.Simple.Types import Shared.Common.Util.Uuid -import Wizard.Database.Mapping.Questionnaire.QuestionnaireEvent +import Wizard.Database.Mapping.Project.ProjectEvent import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditorReply -import Wizard.Model.Questionnaire.QuestionnaireReply +import Wizard.Model.Project.ProjectReply instance ToRow KnowledgeModelEditorReply where toRow KnowledgeModelEditorReply {..} = diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/Action/ProjectAction.hs b/wizard-server/src/Wizard/Database/Mapping/Project/Action/ProjectAction.hs new file mode 100644 index 000000000..1570eb3a6 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/Action/ProjectAction.hs @@ -0,0 +1,50 @@ +module Wizard.Database.Mapping.Project.Action.ProjectAction where + +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.FromField +import Database.PostgreSQL.Simple.FromRow +import Database.PostgreSQL.Simple.ToField +import Database.PostgreSQL.Simple.ToRow + +import Shared.KnowledgeModel.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackagePatternJM () +import Wizard.Model.Project.Action.ProjectAction + +instance ToRow ProjectAction where + toRow ProjectAction {..} = + [ toField paId + , toField name + , toField organizationId + , toField actionId + , toField version + , toField metamodelVersion + , toField description + , toField readme + , toField license + , toJSONField allowedPackages + , toField url + , toJSONField config + , toField enabled + , toField tenantUuid + , toField createdAt + , toField updatedAt + ] + +instance FromRow ProjectAction where + fromRow = do + paId <- field + name <- field + organizationId <- field + actionId <- field + version <- field + metamodelVersion <- field + description <- field + readme <- field + license <- field + allowedPackages <- fieldWith fromJSONField + url <- field + config <- fieldWith fromJSONField + enabled <- field + tenantUuid <- field + createdAt <- field + updatedAt <- field + return $ ProjectAction {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/Comment/ProjectComment.hs b/wizard-server/src/Wizard/Database/Mapping/Project/Comment/ProjectComment.hs new file mode 100644 index 000000000..e9485fa25 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/Comment/ProjectComment.hs @@ -0,0 +1,30 @@ +module Wizard.Database.Mapping.Project.Comment.ProjectComment where + +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.FromRow +import Database.PostgreSQL.Simple.ToField +import Database.PostgreSQL.Simple.ToRow + +import Wizard.Model.Project.Comment.ProjectComment + +instance ToRow ProjectComment where + toRow ProjectComment {..} = + [ toField uuid + , toField text + , toField threadUuid + , toField createdBy + , toField createdAt + , toField updatedAt + , toField tenantUuid + ] + +instance FromRow ProjectComment where + fromRow = do + uuid <- field + text <- field + threadUuid <- field + createdBy <- field + createdAt <- field + updatedAt <- field + tenantUuid <- field + return ProjectComment {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/Comment/ProjectCommentThread.hs b/wizard-server/src/Wizard/Database/Mapping/Project/Comment/ProjectCommentThread.hs new file mode 100644 index 000000000..1b3673afa --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/Comment/ProjectCommentThread.hs @@ -0,0 +1,62 @@ +module Wizard.Database.Mapping.Project.Comment.ProjectCommentThread where + +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.FromRow +import Database.PostgreSQL.Simple.ToField +import Database.PostgreSQL.Simple.ToRow +import Database.PostgreSQL.Simple.Types + +import Shared.Common.Util.Date +import Shared.Common.Util.String (splitOn) +import Shared.Common.Util.Uuid +import Wizard.Model.Project.Comment.ProjectComment + +instance ToRow ProjectCommentThread where + toRow ProjectCommentThread {..} = + [ toField uuid + , toField path + , toField resolved + , toField private + , toField projectUuid + , toField createdBy + , toField createdAt + , toField updatedAt + , toField tenantUuid + , toField assignedTo + , toField assignedBy + , toField notificationRequired + ] + +instance FromRow ProjectCommentThread where + fromRow = do + uuid <- field + path <- field + resolved <- field + private <- field + projectUuid <- field + createdBy <- field + createdAt <- field + updatedAt <- field + tenantUuid <- field + assignedTo <- field + assignedBy <- field + notificationRequired <- field + commentsArray <- fromPGArray <$> field + let comments = fmap parseComment commentsArray + return $ ProjectCommentThread {..} + +parseComment :: String -> ProjectComment +parseComment commentS = + let parts = splitOn ":::::" commentS + in ProjectComment + { uuid = u' (head parts) + , text = parts !! 1 + , threadUuid = u' (parts !! 2) + , tenantUuid = u' (parts !! 3) + , createdBy = + case parts !! 4 of + "" -> Nothing + u -> Just . u' $ u + , createdAt = parsePostgresDateTime' $ parts !! 5 + , updatedAt = parsePostgresDateTime' $ parts !! 6 + } diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/Comment/ProjectCommentThreadAssigned.hs b/wizard-server/src/Wizard/Database/Mapping/Project/Comment/ProjectCommentThreadAssigned.hs new file mode 100644 index 000000000..370f50480 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/Comment/ProjectCommentThreadAssigned.hs @@ -0,0 +1,38 @@ +module Wizard.Database.Mapping.Project.Comment.ProjectCommentThreadAssigned where + +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.FromField +import Database.PostgreSQL.Simple.FromRow + +import Shared.Common.Util.Gravatar +import Wizard.Model.Project.Comment.ProjectCommentThreadAssigned +import WizardLib.Public.Model.User.UserSuggestion + +instance FromRow ProjectCommentThreadAssigned where + fromRow = do + projectUuid <- field + projectName <- field + commentThreadUuid <- field + path <- field + resolved <- field + private <- field + updatedAt <- field + text <- field + mCreatedByUuid <- fieldWith (optionalField fromField) + mCreatedByFirstName <- fieldWith (optionalField fromField) + mCreatedByLastName <- fieldWith (optionalField fromField) + mCreatedByEmail <- fieldWith (optionalField fromField) + mCreatedByImageUrl <- fieldWith (optionalField fromField) + let createdBy = + case (mCreatedByUuid, mCreatedByFirstName, mCreatedByLastName, mCreatedByEmail) of + (Just createdByUuid, Just createdByFirstName, Just createdByLastName, Just createdByEmail) -> + Just $ + UserSuggestion + { uuid = createdByUuid + , firstName = createdByFirstName + , lastName = createdByLastName + , imageUrl = mCreatedByImageUrl + , gravatarHash = createGravatarHash createdByEmail + } + _ -> Nothing + return ProjectCommentThreadAssigned {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/Comment/ProjectCommentThreadList.hs b/wizard-server/src/Wizard/Database/Mapping/Project/Comment/ProjectCommentThreadList.hs new file mode 100644 index 000000000..bd345503a --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/Comment/ProjectCommentThreadList.hs @@ -0,0 +1,85 @@ +module Wizard.Database.Mapping.Project.Comment.ProjectCommentThreadList where + +import qualified Data.List as L +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.FromField +import Database.PostgreSQL.Simple.FromRow +import Database.PostgreSQL.Simple.Types + +import Shared.Common.Util.Date +import Shared.Common.Util.Gravatar +import Shared.Common.Util.String (splitOn) +import Shared.Common.Util.Uuid +import Wizard.Model.Project.Comment.ProjectCommentList +import WizardLib.Public.Model.User.UserSuggestion + +instance FromRow ProjectCommentThreadList where + fromRow = do + uuid <- field + path <- field + resolved <- field + private <- field + createdAt <- field + updatedAt <- field + mAssignedToUuid <- fieldWith (optionalField fromField) + mAssignedToFirstName <- fieldWith (optionalField fromField) + mAssignedToLastName <- fieldWith (optionalField fromField) + mAssignedToEmail <- fieldWith (optionalField fromField) + mAssignedToImageUrl <- fieldWith (optionalField fromField) + let assignedTo = + case (mAssignedToUuid, mAssignedToFirstName, mAssignedToLastName, mAssignedToEmail) of + (Just assignedToUuid, Just assignedToFirstName, Just assignedToLastName, Just assignedToEmail) -> + Just $ + UserSuggestion + { uuid = assignedToUuid + , firstName = assignedToFirstName + , lastName = assignedToLastName + , imageUrl = mAssignedToImageUrl + , gravatarHash = createGravatarHash assignedToEmail + } + _ -> Nothing + mCreatedByUuid <- fieldWith (optionalField fromField) + mCreatedByFirstName <- fieldWith (optionalField fromField) + mCreatedByLastName <- fieldWith (optionalField fromField) + mCreatedByEmail <- fieldWith (optionalField fromField) + mCreatedByImageUrl <- fieldWith (optionalField fromField) + let createdBy = + case (mCreatedByUuid, mCreatedByFirstName, mCreatedByLastName, mCreatedByEmail) of + (Just createdByUuid, Just createdByFirstName, Just createdByLastName, Just createdByEmail) -> + Just $ + UserSuggestion + { uuid = createdByUuid + , firstName = createdByFirstName + , lastName = createdByLastName + , imageUrl = mCreatedByImageUrl + , gravatarHash = createGravatarHash createdByEmail + } + _ -> Nothing + commentsArray <- fromPGArray <$> field + let comments = L.sort . fmap parseComment $ commentsArray + return ProjectCommentThreadList {..} + +parseComment :: String -> ProjectCommentList +parseComment commentS = + let parts = splitOn "<:::::>" commentS + in ProjectCommentList + { uuid = u' (head parts) + , text = parts !! 1 + , createdAt = parsePostgresDateTime' $ parts !! 2 + , updatedAt = parsePostgresDateTime' $ parts !! 3 + , createdBy = + case parts !! 4 of + "" -> Nothing + _ -> + Just $ + UserSuggestion + { uuid = u' $ parts !! 4 + , firstName = parts !! 5 + , lastName = parts !! 6 + , imageUrl = + case parts !! 8 of + "" -> Nothing + value -> Just value + , gravatarHash = createGravatarHash $ parts !! 7 + } + } diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/Comment/ProjectCommentThreadNotification.hs b/wizard-server/src/Wizard/Database/Mapping/Project/Comment/ProjectCommentThreadNotification.hs new file mode 100644 index 000000000..a19ccf9a3 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/Comment/ProjectCommentThreadNotification.hs @@ -0,0 +1,55 @@ +module Wizard.Database.Mapping.Project.Comment.ProjectCommentThreadNotification where + +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.FromField +import Database.PostgreSQL.Simple.FromRow + +import Wizard.Model.Project.Comment.ProjectCommentThreadNotification +import WizardLib.Public.Model.User.UserSimple + +instance FromRow ProjectCommentThreadNotification where + fromRow = do + projectUuid <- field + projectName <- field + tenantUuid <- field + commentThreadUuid <- field + path <- field + resolved <- field + private <- field + assignedToUuid <- field + assignedToFirstName <- field + assignedToLastName <- field + assignedToEmail <- field + let assignedTo = + UserSimple + { uuid = assignedToUuid + , firstName = assignedToFirstName + , lastName = assignedToLastName + , imageUrl = Nothing + , email = assignedToEmail + } + mAssignedByUuid <- fieldWith (optionalField fromField) + mAssignedByFirstName <- fieldWith (optionalField fromField) + mAssignedByLastName <- fieldWith (optionalField fromField) + mAssignedByEmail <- fieldWith (optionalField fromField) + let assignedBy = + case (mAssignedByUuid, mAssignedByFirstName, mAssignedByLastName, mAssignedByEmail) of + (Just assignedByUuid, Just assignedByFirstName, Just assignedByLastName, Just assignedByEmail) -> + Just $ + UserSimple + { uuid = assignedByUuid + , firstName = assignedByFirstName + , lastName = assignedByLastName + , imageUrl = Nothing + , email = assignedByEmail + } + _ -> Nothing + text <- field + clientUrl <- field + appTitle <- field + logoUrl <- field + primaryColor <- field + illustrationsColor <- field + supportEmail <- field + mailConfigUuid <- field + return ProjectCommentThreadNotification {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/File/ProjectFile.hs b/wizard-server/src/Wizard/Database/Mapping/Project/File/ProjectFile.hs new file mode 100644 index 000000000..17a33f63c --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/File/ProjectFile.hs @@ -0,0 +1,9 @@ +module Wizard.Database.Mapping.Project.File.ProjectFile where + +import Database.PostgreSQL.Simple + +import Wizard.Model.Project.File.ProjectFile + +instance ToRow ProjectFile + +instance FromRow ProjectFile diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/File/ProjectFileList.hs b/wizard-server/src/Wizard/Database/Mapping/Project/File/ProjectFileList.hs new file mode 100644 index 000000000..d186dd56c --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/File/ProjectFileList.hs @@ -0,0 +1,30 @@ +module Wizard.Database.Mapping.Project.File.ProjectFileList where + +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.FromRow + +import Shared.Common.Util.Gravatar +import Wizard.Database.Mapping.Project.ProjectSimple +import Wizard.Model.Project.File.ProjectFileList +import WizardLib.Public.Model.User.UserSuggestion + +instance FromRow ProjectFileList where + fromRow = do + uuid <- field + fileName <- field + contentType <- field + fileSize <- field + createdAt <- field + project <- fieldProjectSimple + createdByUuid <- field + createdByFirstName <- field + createdByLastName <- field + createdByEmail <- field + createdByImageUrl <- field + let createdBy = + case (createdByUuid, createdByFirstName, createdByLastName, createdByEmail, createdByImageUrl) of + (Just uuid, Just firstName, Just lastName, Just email, imageUrl) -> + let gravatarHash = createGravatarHash email + in Just UserSuggestion {..} + _ -> Nothing + return $ ProjectFileList {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/File/ProjectFileSimple.hs b/wizard-server/src/Wizard/Database/Mapping/Project/File/ProjectFileSimple.hs new file mode 100644 index 000000000..29d29eba0 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/File/ProjectFileSimple.hs @@ -0,0 +1,7 @@ +module Wizard.Database.Mapping.Project.File.ProjectFileSimple where + +import Database.PostgreSQL.Simple + +import Wizard.Model.Project.File.ProjectFileSimple + +instance FromRow ProjectFileSimple diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/Importer/ProjectImporter.hs b/wizard-server/src/Wizard/Database/Mapping/Project/Importer/ProjectImporter.hs new file mode 100644 index 000000000..cd0864ceb --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/Importer/ProjectImporter.hs @@ -0,0 +1,48 @@ +module Wizard.Database.Mapping.Project.Importer.ProjectImporter where + +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.FromField +import Database.PostgreSQL.Simple.FromRow +import Database.PostgreSQL.Simple.ToField +import Database.PostgreSQL.Simple.ToRow + +import Shared.KnowledgeModel.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackagePatternJM () +import Wizard.Model.Project.Importer.ProjectImporter + +instance ToRow ProjectImporter where + toRow ProjectImporter {..} = + [ toField piId + , toField name + , toField organizationId + , toField importerId + , toField version + , toField metamodelVersion + , toField description + , toField readme + , toField license + , toJSONField allowedPackages + , toField url + , toField enabled + , toField tenantUuid + , toField createdAt + , toField updatedAt + ] + +instance FromRow ProjectImporter where + fromRow = do + piId <- field + name <- field + organizationId <- field + importerId <- field + version <- field + metamodelVersion <- field + description <- field + readme <- field + license <- field + allowedPackages <- fieldWith fromJSONField + url <- field + enabled <- field + tenantUuid <- field + createdAt <- field + updatedAt <- field + return $ ProjectImporter {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/Migration/ProjectMigration.hs b/wizard-server/src/Wizard/Database/Mapping/Project/Migration/ProjectMigration.hs new file mode 100644 index 000000000..150c7990b --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/Migration/ProjectMigration.hs @@ -0,0 +1,25 @@ +module Wizard.Database.Mapping.Project.Migration.ProjectMigration where + +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.FromRow +import Database.PostgreSQL.Simple.ToField +import Database.PostgreSQL.Simple.ToRow +import Database.PostgreSQL.Simple.Types + +import Wizard.Model.Project.Migration.ProjectMigration + +instance ToRow ProjectMigration where + toRow ProjectMigration {..} = + [ toField oldProjectUuid + , toField newProjectUuid + , toField . PGArray $ resolvedQuestionUuids + , toField tenantUuid + ] + +instance FromRow ProjectMigration where + fromRow = do + oldProjectUuid <- field + newProjectUuid <- field + resolvedQuestionUuids <- fromPGArray <$> field + tenantUuid <- field + return $ ProjectMigration {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/Project.hs b/wizard-server/src/Wizard/Database/Mapping/Project/Project.hs new file mode 100644 index 000000000..c62cbc041 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/Project.hs @@ -0,0 +1,54 @@ +module Wizard.Database.Mapping.Project.Project where + +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.FromRow +import Database.PostgreSQL.Simple.ToField +import Database.PostgreSQL.Simple.ToRow +import Database.PostgreSQL.Simple.Types + +import Wizard.Api.Resource.Project.Acl.ProjectPermJM () +import Wizard.Api.Resource.Project.Event.ProjectEventJM () +import Wizard.Database.Mapping.Project.ProjectSharing () +import Wizard.Database.Mapping.Project.ProjectVisibility () +import Wizard.Model.Project.Project + +instance ToRow Project where + toRow Project {..} = + [ toField uuid + , toField name + , toField visibility + , toField sharing + , toField knowledgeModelPackageId + , toField . PGArray $ selectedQuestionTagUuids + , toField documentTemplateId + , toField formatUuid + , toField creatorUuid + , toField createdAt + , toField updatedAt + , toField description + , toField isTemplate + , toField squashed + , toField tenantUuid + , toField . PGArray $ projectTags + ] + +instance FromRow Project where + fromRow = do + uuid <- field + name <- field + visibility <- field + sharing <- field + knowledgeModelPackageId <- field + selectedQuestionTagUuids <- fromPGArray <$> field + documentTemplateId <- field + formatUuid <- field + creatorUuid <- field + let permissions = [] + createdAt <- field + updatedAt <- field + description <- field + isTemplate <- field + squashed <- field + tenantUuid <- field + projectTags <- fromPGArray <$> field + return $ Project {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/ProjectAcl.hs b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectAcl.hs new file mode 100644 index 000000000..291f22c56 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectAcl.hs @@ -0,0 +1,64 @@ +module Wizard.Database.Mapping.Project.ProjectAcl where + +import qualified Data.List as L +import qualified Data.UUID as U +import Database.PostgreSQL.Simple.FromField +import Database.PostgreSQL.Simple.FromRow +import Database.PostgreSQL.Simple.Types + +import Shared.Common.Util.Gravatar +import Shared.Common.Util.String +import Shared.Common.Util.Uuid +import Wizard.Api.Resource.Acl.MemberDTO +import Wizard.Api.Resource.Project.Acl.ProjectPermDTO +import Wizard.Api.Resource.Project.Acl.ProjectPermJM () + +loadPermissions :: U.UUID -> RowParser [ProjectPermDTO] +loadPermissions projectUuid = do + mUserPermissions <- fieldWith (optionalField fromField) + let userPermissions = + case mUserPermissions of + Just userPermissions -> L.sort . fmap (parseUserPermission projectUuid) . fromPGArray $ userPermissions + Nothing -> [] + mGroupPermissions <- fieldWith (optionalField fromField) + let groupPermissions = + case mGroupPermissions of + Just groupPermissions -> L.sort . fmap (parseGroupPermission projectUuid) . fromPGArray $ groupPermissions + Nothing -> [] + return $ userPermissions ++ groupPermissions + +parseUserPermission :: U.UUID -> String -> ProjectPermDTO +parseUserPermission projectUuid permission = + let parts = splitOn "::" permission + in ProjectPermDTO + { projectUuid = projectUuid + , perms = splitOn "," . replace "}" "" . replace "{" "" $ parts !! 1 + , member = + UserMemberDTO + { uuid = u' (parts !! 2) + , firstName = parts !! 3 + , lastName = parts !! 4 + , gravatarHash = createGravatarHash $ parts !! 5 + , imageUrl = + case parts !! 6 of + "" -> Nothing + imageUrl -> Just imageUrl + } + } +parseGroupPermission :: U.UUID -> String -> ProjectPermDTO +parseGroupPermission projectUuid permission = + let parts = splitOn "::" permission + in ProjectPermDTO + { projectUuid = projectUuid + , perms = splitOn "," . replace "}" "" . replace "{" "" $ parts !! 1 + , member = + UserGroupMemberDTO + { uuid = u' (parts !! 2) + , name = parts !! 3 + , description = if length parts == 6 then Just $ parts !! 5 else Nothing + , private = + case parts !! 4 of + "t" -> True + _ -> False + } + } diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/ProjectCreation.hs b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectCreation.hs new file mode 100644 index 000000000..61bcbe122 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectCreation.hs @@ -0,0 +1,13 @@ +module Wizard.Database.Mapping.Project.ProjectCreation where + +import Database.PostgreSQL.Simple.FromField +import Database.PostgreSQL.Simple.ToField + +import Shared.Common.Database.Mapping.Common +import Wizard.Model.Tenant.Config.TenantConfig + +instance ToField ProjectCreation where + toField = toFieldGenericEnum + +instance FromField ProjectCreation where + fromField = fromFieldGenericEnum diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/ProjectDetail.hs b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectDetail.hs new file mode 100644 index 000000000..a72bde864 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectDetail.hs @@ -0,0 +1,28 @@ +module Wizard.Database.Mapping.Project.ProjectDetail where + +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.FromRow +import Database.PostgreSQL.Simple.Types + +import Wizard.Api.Resource.Project.Event.ProjectEventJM () +import Wizard.Database.Mapping.Project.ProjectAcl +import Wizard.Database.Mapping.Project.ProjectSharing () +import Wizard.Database.Mapping.Project.ProjectState () +import Wizard.Database.Mapping.Project.ProjectVisibility () +import Wizard.Model.Project.Detail.ProjectDetail + +instance FromRow ProjectDetail where + fromRow = do + uuid <- field + name <- field + visibility <- field + sharing <- field + knowledgeModelPackageId <- field + selectedQuestionTagUuids <- fromPGArray <$> field + isTemplate <- field + migrationUuid <- field + permissions <- loadPermissions uuid + projectActionsAvailable <- field + projectImportersAvailable <- field + fileCount <- field + return $ ProjectDetail {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/ProjectDetailPreview.hs b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectDetailPreview.hs new file mode 100644 index 000000000..f3ea99377 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectDetailPreview.hs @@ -0,0 +1,33 @@ +module Wizard.Database.Mapping.Project.ProjectDetailPreview where + +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.FromRow + +import Shared.DocumentTemplate.Api.Resource.DocumentTemplate.DocumentTemplateJM () +import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplateFormatSimple +import Wizard.Api.Resource.Project.Acl.ProjectPermJM () +import Wizard.Database.Mapping.Project.ProjectAcl +import Wizard.Database.Mapping.Project.ProjectSharing () +import Wizard.Database.Mapping.Project.ProjectVisibility () +import Wizard.Model.Project.Detail.ProjectDetailPreview + +instance FromRow ProjectDetailPreview where + fromRow = do + uuid <- field + name <- field + visibility <- field + sharing <- field + knowledgeModelPackageId <- field + isTemplate <- field + documentTemplateId <- field + migrationUuid <- field + permissions <- loadPermissions uuid + mFormatUuid <- field + mFormatName <- field + mFormatIcon <- field + let format = + case (mFormatUuid, mFormatName, mFormatIcon) of + (Just uuid, Just name, Just icon) -> Just $ DocumentTemplateFormatSimple {uuid = uuid, name = name, icon = icon} + _ -> Nothing + fileCount <- field + return $ ProjectDetailPreview {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/ProjectDetailQuestionnaire.hs b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectDetailQuestionnaire.hs new file mode 100644 index 000000000..19440567d --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectDetailQuestionnaire.hs @@ -0,0 +1,47 @@ +module Wizard.Database.Mapping.Project.ProjectDetailQuestionnaire where + +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.FromField +import Database.PostgreSQL.Simple.FromRow +import Database.PostgreSQL.Simple.Types + +import Shared.Common.Util.String +import Shared.Common.Util.Uuid +import Wizard.Api.Resource.Project.Event.ProjectEventJM () +import Wizard.Database.Mapping.Project.File.ProjectFileSimple () +import Wizard.Database.Mapping.Project.ProjectAcl +import Wizard.Database.Mapping.Project.ProjectSharing () +import Wizard.Database.Mapping.Project.ProjectState () +import Wizard.Database.Mapping.Project.ProjectVisibility () +import Wizard.Model.Project.Detail.ProjectDetailQuestionnaire +import Wizard.Model.Project.File.ProjectFileSimple + +instance FromRow ProjectDetailQuestionnaire where + fromRow = do + uuid <- field + name <- field + visibility <- field + sharing <- field + knowledgeModelPackageId <- field + selectedQuestionTagUuids <- fromPGArray <$> field + isTemplate <- field + migrationUuid <- field + permissions <- loadPermissions uuid + projectActionsAvailable <- field + projectImportersAvailable <- field + mFiles <- fieldWith (optionalField fromField) + let files = + case mFiles of + Just files -> fmap parseFile . fromPGArray $ files + Nothing -> [] + return $ ProjectDetailQuestionnaire {..} + where + parseFile :: String -> ProjectFileSimple + parseFile file = + let parts = splitOn "<:::::>" file + in ProjectFileSimple + { uuid = u' $ head parts + , fileName = parts !! 1 + , contentType = parts !! 2 + , fileSize = read $ parts !! 3 + } diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/ProjectDetailSettings.hs b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectDetailSettings.hs new file mode 100644 index 000000000..f5cb04156 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectDetailSettings.hs @@ -0,0 +1,90 @@ +module Wizard.Database.Mapping.Project.ProjectDetailSettings where + +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.FromField +import Database.PostgreSQL.Simple.FromRow +import Database.PostgreSQL.Simple.Types + +import Shared.Common.Database.Mapping.Common.SemVer2Tuple () +import Shared.DocumentTemplate.Api.Resource.DocumentTemplate.DocumentTemplateDTO +import Shared.DocumentTemplate.Api.Resource.DocumentTemplate.DocumentTemplateJM () +import Shared.DocumentTemplate.Constant.DocumentTemplate +import Shared.DocumentTemplate.Database.Mapping.DocumentTemplate.DocumentTemplatePhase () +import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplateJM () +import Shared.KnowledgeModel.Database.Mapping.KnowledgeModel.Package.KnowledgeModelPackagePhase () +import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSimpleDTO +import Wizard.Api.Resource.Project.Acl.ProjectPermJM () +import Wizard.Database.Mapping.Project.ProjectAcl +import Wizard.Database.Mapping.Project.ProjectSharing () +import Wizard.Database.Mapping.Project.ProjectState () +import Wizard.Database.Mapping.Project.ProjectVisibility () +import Wizard.Model.DocumentTemplate.DocumentTemplateState +import Wizard.Model.Project.Detail.ProjectDetailSettings + +instance FromRow ProjectDetailSettings where + fromRow = do + uuid <- field + name <- field + description <- field + visibility <- field + sharing <- field + isTemplate <- field + projectTags <- fromPGArray <$> field + selectedQuestionTagUuids <- fromPGArray <$> field + formatUuid <- field + migrationUuid <- field + permissions <- loadPermissions uuid + knowledgeModelPackageId <- field + knowledgeModelPackageName <- field + knowledgeModelPackageOrganizationId <- field + knowledgeModelPackageKmId <- field + knowledgeModelPackageVersion <- field + knowledgeModelPackagePhase <- field + knowledgeModelPackageDescription <- field + knowledgeModelPackageNonEditable <- field + knowledgeModelPackageCreatedAt <- field + let knowledgeModelPackage = + KnowledgeModelPackageSimpleDTO + { pId = knowledgeModelPackageId + , name = knowledgeModelPackageName + , organizationId = knowledgeModelPackageOrganizationId + , kmId = knowledgeModelPackageKmId + , version = knowledgeModelPackageVersion + , phase = knowledgeModelPackagePhase + , remoteLatestVersion = Nothing + , description = knowledgeModelPackageDescription + , organization = Nothing + , nonEditable = knowledgeModelPackageNonEditable + , createdAt = knowledgeModelPackageCreatedAt + } + let knowledgeModelTags = [] + mDocumentTemplateId <- field + mDocumentTemplateName <- field + mDocumentTemplateVersion <- field + mDocumentTemplatePhase <- field + mDocumentTemplateDescription <- field + mDocumentTemplateFormats <- fieldWith (optionalField fromJSONField) + let documentTemplate = + case (mDocumentTemplateId, mDocumentTemplateName, mDocumentTemplateVersion, mDocumentTemplatePhase, mDocumentTemplateDescription, mDocumentTemplateFormats) of + (Just documentTemplateId, Just documentTemplateName, Just documentTemplateVersion, Just documentTemplatePhase, Just documentTemplateDescription, Just documentTemplateFormats) -> + Just $ + DocumentTemplateDTO + { tId = documentTemplateId + , name = documentTemplateName + , version = documentTemplateVersion + , phase = documentTemplatePhase + , description = documentTemplateDescription + , formats = documentTemplateFormats + } + _ -> Nothing + let documentTemplatePhase = mDocumentTemplatePhase + mDocumentTemplateMetamodelVersion <- field + let documentTemplateState = + case mDocumentTemplateMetamodelVersion of + Just metamodelVersion -> + if metamodelVersion /= documentTemplateMetamodelVersion + then Just UnsupportedMetamodelVersionDocumentTemplateState + else Just DefaultDocumentTemplateState + _ -> Nothing + fileCount <- field + return $ ProjectDetailSettings {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/ProjectEvent.hs b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectEvent.hs new file mode 100644 index 000000000..8dc304107 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectEvent.hs @@ -0,0 +1,284 @@ +module Wizard.Database.Mapping.Project.ProjectEvent where + +import Data.Maybe (fromJust) +import qualified Data.Text as T +import qualified Data.UUID as U +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.FromField +import Database.PostgreSQL.Simple.FromRow +import Database.PostgreSQL.Simple.ToField +import Database.PostgreSQL.Simple.ToRow +import Database.PostgreSQL.Simple.Types +import GHC.Generics + +import Shared.Common.Util.Uuid +import Wizard.Api.Resource.Project.Event.ProjectEventJM () +import Wizard.Database.Mapping.Project.ProjectSharing () +import Wizard.Database.Mapping.Project.ProjectVisibility () +import Wizard.Model.Project.Event.ProjectEvent +import Wizard.Model.Project.ProjectReply + +instance ToRow ProjectEvent where + toRow (SetReplyEvent' SetReplyEvent {..}) = + let values = + case value of + StringReply {..} -> + [ toField StringReplyType + , toField . PGArray $ [sValue] + , toField (Nothing :: Maybe String) + , toField (Nothing :: Maybe String) + ] + AnswerReply {..} -> + [ toField AnswerReplyType + , toField . PGArray $ [aValue] + , toField (Nothing :: Maybe String) + , toField (Nothing :: Maybe String) + ] + MultiChoiceReply {..} -> + [ toField MultiChoiceReplyType + , toField . PGArray $ mcValue + , toField (Nothing :: Maybe String) + , toField (Nothing :: Maybe String) + ] + ItemListReply {..} -> + [ toField ItemListReplyType + , toField . PGArray $ ilValue + , toField (Nothing :: Maybe String) + , toField (Nothing :: Maybe String) + ] + IntegrationReply {..} -> + case iValue of + PlainType {..} -> + [ toField IntegrationReplyType + , toField . PGArray $ [value] + , toField (Nothing :: Maybe String) + , toField (Nothing :: Maybe String) + ] + IntegrationLegacyType {..} -> + [ toField IntegrationReplyType + , toField . PGArray $ [value] + , case intId of + Just iId -> toField iId + Nothing -> toField "<>" + , toField (Nothing :: Maybe String) + ] + IntegrationType {..} -> + [ toField IntegrationReplyType + , toField . PGArray $ [value] + , toField (Nothing :: Maybe String) + , toField raw + ] + ItemSelectReply {..} -> + [ toField ItemSelectReplyType + , toField . PGArray $ [isValue] + , toField (Nothing :: Maybe String) + , toField (Nothing :: Maybe String) + ] + FileReply {..} -> + [ toField FileReplyType + , toField . PGArray $ [fValue] + , toField (Nothing :: Maybe String) + , toField (Nothing :: Maybe String) + ] + in [ toField uuid + , toField SetReplyEventType + , toField path + , toField createdAt + , toField createdBy + , toField projectUuid + , toField tenantUuid + ] + ++ values + toRow (ClearReplyEvent' ClearReplyEvent {..}) = + [ toField uuid + , toField ClearReplyEventType + , toField path + , toField createdAt + , toField createdBy + , toField projectUuid + , toField tenantUuid + , toField (Nothing :: Maybe String) + , toField (Nothing :: Maybe String) + , toField (Nothing :: Maybe String) + , toField (Nothing :: Maybe String) + ] + toRow (SetPhaseEvent' SetPhaseEvent {..}) = + [ toField uuid + , toField SetPhaseEventType + , toField (Nothing :: Maybe String) + , toField createdAt + , toField createdBy + , toField projectUuid + , toField tenantUuid + , toField (Nothing :: Maybe String) + , case phaseUuid of + Just pUuid -> toField . PGArray $ [pUuid] + Nothing -> toField . PGArray $ ([] :: [U.UUID]) + , toField (Nothing :: Maybe String) + , toField (Nothing :: Maybe String) + ] + toRow (SetLabelsEvent' SetLabelsEvent {..}) = + [ toField uuid + , toField SetLabelsEventType + , toField path + , toField createdAt + , toField createdBy + , toField projectUuid + , toField tenantUuid + , toField (Nothing :: Maybe String) + , toField . PGArray $ value + , toField (Nothing :: Maybe String) + , toField (Nothing :: Maybe String) + ] + +instance FromRow ProjectEvent where + fromRow = do + uuid <- field + aType <- field + mPath <- field + createdAt <- field + createdBy <- field + projectUuid <- field + tenantUuid <- field + valueType <- field + valueText <- fieldValueText + mValueId <- field + mValueRaw <- field + case aType of + SetReplyEventType -> do + return . SetReplyEvent' $ + SetReplyEvent + { uuid = uuid + , path = fromJust mPath + , value = parseValue valueType valueText mValueId mValueRaw + , projectUuid = projectUuid + , tenantUuid = tenantUuid + , createdBy = createdBy + , createdAt = createdAt + } + ClearReplyEventType -> + let path = fromJust mPath + in return . ClearReplyEvent' $ ClearReplyEvent {..} + SetPhaseEventType -> + return . SetPhaseEvent' $ + SetPhaseEvent + { uuid = uuid + , phaseUuid = + case valueText of + [value] -> Just . u' $ value + _ -> Nothing + , projectUuid = projectUuid + , tenantUuid = tenantUuid + , createdBy = createdBy + , createdAt = createdAt + } + SetLabelsEventType -> + return . SetLabelsEvent' $ + SetLabelsEvent + { uuid = uuid + , path = fromJust mPath + , value = fmap u' valueText + , projectUuid = projectUuid + , tenantUuid = tenantUuid + , createdBy = createdBy + , createdAt = createdAt + } + +parseValue valueType valueText mValueId mValueRaw = + case valueType of + Just StringReplyType -> StringReply . head $ valueText + Just AnswerReplyType -> AnswerReply . u' . head $ valueText + Just MultiChoiceReplyType -> MultiChoiceReply . fmap u' $ valueText + Just ItemListReplyType -> ItemListReply . fmap u' $ valueText + Just IntegrationReplyType -> + IntegrationReply + { iValue = + case mValueRaw of + Just raw -> IntegrationType {value = head valueText, raw = raw} + Nothing -> + case mValueId of + Just "<>" -> IntegrationLegacyType {intId = Nothing, value = head valueText} + Just valueId -> IntegrationLegacyType {intId = Just valueId, value = head valueText} + Nothing -> PlainType {value = head valueText} + } + Just ItemSelectReplyType -> ItemSelectReply . u' . head $ valueText + Just FileReplyType -> FileReply . u' . head $ valueText + _ -> error $ "Unknown value type: " ++ show valueType + +parseValueText :: Maybe (PGArray T.Text) -> [String] +parseValueText mValueText = + case mValueText :: Maybe (PGArray T.Text) of + Just valueText -> fmap T.unpack . fromPGArray $ valueText + Nothing -> [] + +fieldValueText :: RowParser [String] +fieldValueText = do + mValueText <- field + return $ parseValueText mValueText + +parsePhaseUuid :: [String] -> Maybe U.UUID +parsePhaseUuid valueText = + case valueText of + [value] -> Just . u' $ value + _ -> Nothing + +data ProjectEventType + = SetReplyEventType + | ClearReplyEventType + | SetPhaseEventType + | SetLabelsEventType + deriving (Show, Read, Eq, Ord, Generic) + +instance FromField ProjectEventType where + fromField f mdata = do + typename <- typename f -- Get the PostgreSQL type name + case mdata of + Just bs | typename == "project_event_type" -> + case bs of + "SetReplyEvent" -> pure SetReplyEventType + "ClearReplyEvent" -> pure ClearReplyEventType + "SetPhaseEvent" -> pure SetPhaseEventType + "SetLabelsEvent" -> pure SetLabelsEventType + _ -> returnError ConversionFailed f "Invalid ENUM value" + _ -> returnError Incompatible f "Expected project_event_type ENUM" + +instance ToField ProjectEventType where + toField SetReplyEventType = toField ("SetReplyEvent" :: T.Text) + toField ClearReplyEventType = toField ("ClearReplyEvent" :: T.Text) + toField SetPhaseEventType = toField ("SetPhaseEvent" :: T.Text) + toField SetLabelsEventType = toField ("SetLabelsEvent" :: T.Text) + +data ProjectReplyType + = StringReplyType + | AnswerReplyType + | MultiChoiceReplyType + | ItemListReplyType + | IntegrationReplyType + | ItemSelectReplyType + | FileReplyType + deriving (Show, Read, Eq, Ord, Generic) + +instance FromField ProjectReplyType where + fromField f mdata = do + typename <- typename f -- Get the PostgreSQL type name + case mdata of + Just bs -> + case bs of + "StringReply" -> pure StringReplyType + "AnswerReply" -> pure AnswerReplyType + "MultiChoiceReply" -> pure MultiChoiceReplyType + "ItemListReply" -> pure ItemListReplyType + "IntegrationReply" -> pure IntegrationReplyType + "ItemSelectReply" -> pure ItemSelectReplyType + "FileReply" -> pure FileReplyType + _ -> returnError ConversionFailed f "Invalid ENUM value" + _ -> returnError Incompatible f "Expected value_type ENUM" + +instance ToField ProjectReplyType where + toField StringReplyType = toField ("StringReply" :: T.Text) + toField AnswerReplyType = toField ("AnswerReply" :: T.Text) + toField MultiChoiceReplyType = toField ("MultiChoiceReply" :: T.Text) + toField ItemListReplyType = toField ("ItemListReply" :: T.Text) + toField IntegrationReplyType = toField ("IntegrationReply" :: T.Text) + toField ItemSelectReplyType = toField ("ItemSelectReply" :: T.Text) + toField FileReplyType = toField ("FileReply" :: T.Text) diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/ProjectEventList.hs b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectEventList.hs new file mode 100644 index 000000000..3e449972a --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectEventList.hs @@ -0,0 +1,52 @@ +module Wizard.Database.Mapping.Project.ProjectEventList where + +import Data.Maybe (fromJust) +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.FromRow + +import Shared.Common.Util.Uuid +import Wizard.Database.Mapping.Project.ProjectEvent +import Wizard.Model.Project.Event.ProjectEventList +import WizardLib.Public.Database.Mapping.User.UserSuggestion + +instance FromRow ProjectEventList where + fromRow = do + uuid <- field + aType <- field + mPath <- field + createdAt <- field + valueType <- field + valueText <- fieldValueText + mValueId <- field + mValueRaw <- field + createdBy <- fieldUserSuggestion' + case aType of + SetReplyEventType -> do + return . SetReplyEventList' $ + SetReplyEventList + { uuid = uuid + , path = fromJust mPath + , value = parseValue valueType valueText mValueId mValueRaw + , createdBy = createdBy + , createdAt = createdAt + } + ClearReplyEventType -> + let path = fromJust mPath + in return . ClearReplyEventList' $ ClearReplyEventList {..} + SetPhaseEventType -> + return . SetPhaseEventList' $ + SetPhaseEventList + { uuid = uuid + , phaseUuid = parsePhaseUuid valueText + , createdBy = createdBy + , createdAt = createdAt + } + SetLabelsEventType -> + return . SetLabelsEventList' $ + SetLabelsEventList + { uuid = uuid + , path = fromJust mPath + , value = fmap u' valueText + , createdBy = createdBy + , createdAt = createdAt + } diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/ProjectList.hs b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectList.hs new file mode 100644 index 000000000..8894a62d4 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectList.hs @@ -0,0 +1,84 @@ +module Wizard.Database.Mapping.Project.ProjectList where + +import qualified Data.List as L +import qualified Data.UUID as U +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.FromField +import Database.PostgreSQL.Simple.FromRow +import Database.PostgreSQL.Simple.Types + +import Shared.Common.Util.Gravatar +import Shared.Common.Util.String +import Shared.Common.Util.Uuid +import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackageSimple +import Wizard.Api.Resource.Acl.MemberDTO +import Wizard.Api.Resource.Project.Acl.ProjectPermDTO +import Wizard.Api.Resource.Project.Acl.ProjectPermJM () +import Wizard.Database.Mapping.Project.ProjectSharing () +import Wizard.Database.Mapping.Project.ProjectState () +import Wizard.Database.Mapping.Project.ProjectVisibility () +import Wizard.Model.Project.ProjectList + +instance FromRow ProjectList where + fromRow = do + uuid <- field + name <- field + description <- field + visibility <- field + sharing <- field + isTemplate <- field + createdAt <- field + updatedAt <- field + state <- field + packageId <- field + packageName <- field + packageVersion <- field + let knowledgeModelPackage = KnowledgeModelPackageSimple {pId = packageId, name = packageName, version = packageVersion} + mUserPermissions <- fieldWith (optionalField fromField) + let userPermissions = + case mUserPermissions of + Just userPermissions -> L.sort . fmap (parseUserPermission uuid) . fromPGArray $ userPermissions + Nothing -> [] + mGroupPermissions <- fieldWith (optionalField fromField) + let groupPermissions = + case mGroupPermissions of + Just groupPermissions -> L.sort . fmap (parseGroupPermission uuid) . fromPGArray $ groupPermissions + Nothing -> [] + let permissions = userPermissions ++ groupPermissions + return $ ProjectList {..} + where + parseUserPermission :: U.UUID -> String -> ProjectPermDTO + parseUserPermission projectUuid permission = + let parts = splitOn "::" permission + in ProjectPermDTO + { projectUuid = projectUuid + , perms = splitOn "," . replace "}" "" . replace "{" "" $ parts !! 1 + , member = + UserMemberDTO + { uuid = u' (parts !! 2) + , firstName = parts !! 3 + , lastName = parts !! 4 + , gravatarHash = createGravatarHash $ parts !! 5 + , imageUrl = + case parts !! 6 of + "" -> Nothing + imageUrl -> Just imageUrl + } + } + parseGroupPermission :: U.UUID -> String -> ProjectPermDTO + parseGroupPermission projectUuid permission = + let parts = splitOn "::" permission + in ProjectPermDTO + { projectUuid = projectUuid + , perms = splitOn "," . replace "}" "" . replace "{" "" $ parts !! 1 + , member = + UserGroupMemberDTO + { uuid = u' (parts !! 2) + , name = parts !! 3 + , description = if length parts == 6 then Just $ parts !! 5 else Nothing + , private = + case parts !! 4 of + "t" -> True + _ -> False + } + } diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/ProjectPerm.hs b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectPerm.hs new file mode 100644 index 000000000..c83afa840 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectPerm.hs @@ -0,0 +1,34 @@ +module Wizard.Database.Mapping.Project.ProjectPerm where + +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.FromField +import Database.PostgreSQL.Simple.FromRow +import Database.PostgreSQL.Simple.ToField +import Database.PostgreSQL.Simple.ToRow +import Database.PostgreSQL.Simple.Types + +import Shared.Common.Database.Mapping.Common +import Wizard.Model.Project.Acl.ProjectPerm + +instance ToField ProjectPermType where + toField = toFieldGenericEnum + +instance FromField ProjectPermType where + fromField = fromFieldGenericEnum + +instance ToRow ProjectPerm where + toRow r@ProjectPerm {..} = + [ toField projectUuid + , toField memberUuid + , toField . PGArray $ perms + , toField tenantUuid + ] + +instance FromRow ProjectPerm where + fromRow = do + projectUuid <- field + memberType <- field + memberUuid <- field + perms <- fromPGArray <$> field + tenantUuid <- field + return ProjectPerm {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/ProjectSharing.hs b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectSharing.hs new file mode 100644 index 000000000..d59196b81 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectSharing.hs @@ -0,0 +1,13 @@ +module Wizard.Database.Mapping.Project.ProjectSharing where + +import Database.PostgreSQL.Simple.FromField +import Database.PostgreSQL.Simple.ToField + +import Shared.Common.Database.Mapping.Common +import Wizard.Model.Project.Project + +instance ToField ProjectSharing where + toField = toFieldGenericEnum + +instance FromField ProjectSharing where + fromField = fromFieldGenericEnum diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/ProjectSimple.hs b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectSimple.hs new file mode 100644 index 000000000..e1fdd9b59 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectSimple.hs @@ -0,0 +1,23 @@ +module Wizard.Database.Mapping.Project.ProjectSimple where + +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.FromRow +import Database.PostgreSQL.Simple.ToField +import Database.PostgreSQL.Simple.ToRow + +import Wizard.Model.Project.ProjectSimple + +instance ToRow ProjectSimple where + toRow ProjectSimple {..} = [toField uuid, toField name] + +instance FromRow ProjectSimple where + fromRow = do + uuid <- field + name <- field + return $ ProjectSimple {..} + +fieldProjectSimple :: RowParser ProjectSimple +fieldProjectSimple = do + uuid <- field + name <- field + return ProjectSimple {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/ProjectSimpleWithPerm.hs b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectSimpleWithPerm.hs new file mode 100644 index 000000000..78ee2846c --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectSimpleWithPerm.hs @@ -0,0 +1,55 @@ +module Wizard.Database.Mapping.Project.ProjectSimpleWithPerm where + +import qualified Data.UUID as U +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.FromField +import Database.PostgreSQL.Simple.FromRow +import Database.PostgreSQL.Simple.Types + +import Shared.Common.Util.String +import Shared.Common.Util.Uuid +import Wizard.Database.Mapping.Project.ProjectPerm () +import Wizard.Database.Mapping.Project.ProjectSharing () +import Wizard.Database.Mapping.Project.ProjectVisibility () +import Wizard.Model.Project.Acl.ProjectPerm +import Wizard.Model.Project.ProjectSimpleWithPerm + +instance FromRow ProjectSimpleWithPerm where + fromRow = do + uuid <- field + visibility <- field + sharing <- field + tenantUuid <- field + mUserPermissions <- fieldWith (optionalField fromField) + let userPermissions = + case mUserPermissions of + Just userPermissions -> fmap (parseUserPermission uuid tenantUuid) . fromPGArray $ userPermissions + Nothing -> [] + mGroupPermissions <- fieldWith (optionalField fromField) + let groupPermissions = + case mGroupPermissions of + Just groupPermissions -> fmap (parseGroupPermission uuid tenantUuid) . fromPGArray $ groupPermissions + Nothing -> [] + let permissions = userPermissions ++ groupPermissions + return $ ProjectSimpleWithPerm {..} + where + parseUserPermission :: U.UUID -> U.UUID -> String -> ProjectPerm + parseUserPermission projectUuid tenantUuid permission = + let parts = splitOn "::" permission + in ProjectPerm + { projectUuid = projectUuid + , memberType = UserProjectPermType + , memberUuid = u' $ head parts + , perms = splitOn "," . replace "}" "" . replace "{" "" $ parts !! 1 + , tenantUuid = tenantUuid + } + parseGroupPermission :: U.UUID -> U.UUID -> String -> ProjectPerm + parseGroupPermission projectUuid tenantUuid permission = + let parts = splitOn "::" permission + in ProjectPerm + { projectUuid = projectUuid + , memberType = UserGroupProjectPermType + , memberUuid = u' $ head parts + , perms = splitOn "," . replace "}" "" . replace "{" "" $ parts !! 1 + , tenantUuid = tenantUuid + } diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/ProjectState.hs b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectState.hs new file mode 100644 index 000000000..afa63b603 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectState.hs @@ -0,0 +1,9 @@ +module Wizard.Database.Mapping.Project.ProjectState where + +import Database.PostgreSQL.Simple.FromField + +import Shared.Common.Database.Mapping.Common +import Wizard.Model.Project.ProjectState + +instance FromField ProjectState where + fromField = fromFieldGenericEnum diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/ProjectSuggestion.hs b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectSuggestion.hs new file mode 100644 index 000000000..5f45f7944 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectSuggestion.hs @@ -0,0 +1,7 @@ +module Wizard.Database.Mapping.Project.ProjectSuggestion where + +import Database.PostgreSQL.Simple + +import Wizard.Model.Project.ProjectSuggestion + +instance FromRow ProjectSuggestion diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/ProjectVisibility.hs b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectVisibility.hs new file mode 100644 index 000000000..6ffc174b8 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/ProjectVisibility.hs @@ -0,0 +1,13 @@ +module Wizard.Database.Mapping.Project.ProjectVisibility where + +import Database.PostgreSQL.Simple.FromField +import Database.PostgreSQL.Simple.ToField + +import Shared.Common.Database.Mapping.Common +import Wizard.Model.Project.Project + +instance ToField ProjectVisibility where + toField = toFieldGenericEnum + +instance FromField ProjectVisibility where + fromField = fromFieldGenericEnum diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/Version/ProjectVersion.hs b/wizard-server/src/Wizard/Database/Mapping/Project/Version/ProjectVersion.hs new file mode 100644 index 000000000..2529e3e93 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/Version/ProjectVersion.hs @@ -0,0 +1,9 @@ +module Wizard.Database.Mapping.Project.Version.ProjectVersion where + +import Database.PostgreSQL.Simple + +import Wizard.Model.Project.Version.ProjectVersion + +instance ToRow ProjectVersion + +instance FromRow ProjectVersion diff --git a/wizard-server/src/Wizard/Database/Mapping/Project/Version/ProjectVersionList.hs b/wizard-server/src/Wizard/Database/Mapping/Project/Version/ProjectVersionList.hs new file mode 100644 index 000000000..07ea55b74 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Project/Version/ProjectVersionList.hs @@ -0,0 +1,29 @@ +module Wizard.Database.Mapping.Project.Version.ProjectVersionList where + +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.FromRow + +import Shared.Common.Util.Gravatar +import Wizard.Model.Project.Version.ProjectVersionList +import WizardLib.Public.Model.User.UserSuggestion + +instance FromRow ProjectVersionList where + fromRow = do + uuid <- field + name <- field + description <- field + eventUuid <- field + createdAt <- field + updatedAt <- field + createdByUuid <- field + createdByFirstName <- field + createdByLastName <- field + createdByEmail <- field + createdByImageUrl <- field + let createdBy = + case (createdByUuid, createdByFirstName, createdByLastName, createdByEmail, createdByImageUrl) of + (Just uuid, Just firstName, Just lastName, Just email, imageUrl) -> + let gravatarHash = createGravatarHash email + in Just UserSuggestion {..} + _ -> Nothing + return $ ProjectVersionList {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/MigratorState.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/MigratorState.hs deleted file mode 100644 index 86c8d45c4..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/MigratorState.hs +++ /dev/null @@ -1,25 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.MigratorState where - -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.FromRow -import Database.PostgreSQL.Simple.ToField -import Database.PostgreSQL.Simple.ToRow -import Database.PostgreSQL.Simple.Types - -import Wizard.Model.Questionnaire.MigratorState - -instance ToRow MigratorState where - toRow MigratorState {..} = - [ toField oldQuestionnaireUuid - , toField newQuestionnaireUuid - , toField . PGArray $ resolvedQuestionUuids - , toField tenantUuid - ] - -instance FromRow MigratorState where - fromRow = do - oldQuestionnaireUuid <- field - newQuestionnaireUuid <- field - resolvedQuestionUuids <- fromPGArray <$> field - tenantUuid <- field - return $ MigratorState {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/Questionnaire.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/Questionnaire.hs deleted file mode 100644 index 221794cd0..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/Questionnaire.hs +++ /dev/null @@ -1,54 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.Questionnaire where - -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.FromRow -import Database.PostgreSQL.Simple.ToField -import Database.PostgreSQL.Simple.ToRow -import Database.PostgreSQL.Simple.Types - -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventJM () -import Wizard.Api.Resource.Questionnaire.QuestionnairePermJM () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireSharing () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireVisibility () -import Wizard.Model.Questionnaire.Questionnaire - -instance ToRow Questionnaire where - toRow Questionnaire {..} = - [ toField uuid - , toField name - , toField visibility - , toField sharing - , toField knowledgeModelPackageId - , toField . PGArray $ selectedQuestionTagUuids - , toField documentTemplateId - , toField formatUuid - , toField creatorUuid - , toField createdAt - , toField updatedAt - , toField description - , toField isTemplate - , toField squashed - , toField tenantUuid - , toField . PGArray $ projectTags - ] - -instance FromRow Questionnaire where - fromRow = do - uuid <- field - name <- field - visibility <- field - sharing <- field - knowledgeModelPackageId <- field - selectedQuestionTagUuids <- fromPGArray <$> field - documentTemplateId <- field - formatUuid <- field - creatorUuid <- field - let permissions = [] - createdAt <- field - updatedAt <- field - description <- field - isTemplate <- field - squashed <- field - tenantUuid <- field - projectTags <- fromPGArray <$> field - return $ Questionnaire {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireAcl.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireAcl.hs deleted file mode 100644 index 5d0014caf..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireAcl.hs +++ /dev/null @@ -1,64 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.QuestionnaireAcl where - -import qualified Data.List as L -import qualified Data.UUID as U -import Database.PostgreSQL.Simple.FromField -import Database.PostgreSQL.Simple.FromRow -import Database.PostgreSQL.Simple.Types - -import Shared.Common.Util.Gravatar -import Shared.Common.Util.String -import Shared.Common.Util.Uuid -import Wizard.Api.Resource.Acl.MemberDTO -import Wizard.Api.Resource.Questionnaire.QuestionnairePermDTO -import Wizard.Api.Resource.Questionnaire.QuestionnairePermJM () - -loadPermissions :: U.UUID -> RowParser [QuestionnairePermDTO] -loadPermissions qtnUuid = do - mUserPermissions <- fieldWith (optionalField fromField) - let userPermissions = - case mUserPermissions of - Just userPermissions -> L.sort . fmap (parseUserPermission qtnUuid) . fromPGArray $ userPermissions - Nothing -> [] - mGroupPermissions <- fieldWith (optionalField fromField) - let groupPermissions = - case mGroupPermissions of - Just groupPermissions -> L.sort . fmap (parseGroupPermission qtnUuid) . fromPGArray $ groupPermissions - Nothing -> [] - return $ userPermissions ++ groupPermissions - -parseUserPermission :: U.UUID -> String -> QuestionnairePermDTO -parseUserPermission qtnUuid permission = - let parts = splitOn "::" permission - in QuestionnairePermDTO - { questionnaireUuid = qtnUuid - , perms = splitOn "," . replace "}" "" . replace "{" "" $ parts !! 1 - , member = - UserMemberDTO - { uuid = u' (parts !! 2) - , firstName = parts !! 3 - , lastName = parts !! 4 - , gravatarHash = createGravatarHash $ parts !! 5 - , imageUrl = - case parts !! 6 of - "" -> Nothing - imageUrl -> Just imageUrl - } - } -parseGroupPermission :: U.UUID -> String -> QuestionnairePermDTO -parseGroupPermission qtnUuid permission = - let parts = splitOn "::" permission - in QuestionnairePermDTO - { questionnaireUuid = qtnUuid - , perms = splitOn "," . replace "}" "" . replace "{" "" $ parts !! 1 - , member = - UserGroupMemberDTO - { uuid = u' (parts !! 2) - , name = parts !! 3 - , description = if length parts == 6 then Just $ parts !! 5 else Nothing - , private = - case parts !! 4 of - "t" -> True - _ -> False - } - } diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireComment.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireComment.hs deleted file mode 100644 index 884d46a1d..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireComment.hs +++ /dev/null @@ -1,30 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.QuestionnaireComment where - -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.FromRow -import Database.PostgreSQL.Simple.ToField -import Database.PostgreSQL.Simple.ToRow - -import Wizard.Model.Questionnaire.QuestionnaireComment - -instance ToRow QuestionnaireComment where - toRow QuestionnaireComment {..} = - [ toField uuid - , toField text - , toField threadUuid - , toField createdBy - , toField createdAt - , toField updatedAt - , toField tenantUuid - ] - -instance FromRow QuestionnaireComment where - fromRow = do - uuid <- field - text <- field - threadUuid <- field - createdBy <- field - createdAt <- field - updatedAt <- field - tenantUuid <- field - return QuestionnaireComment {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireCommentThread.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireCommentThread.hs deleted file mode 100644 index 2bd6cd19d..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireCommentThread.hs +++ /dev/null @@ -1,62 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.QuestionnaireCommentThread where - -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.FromRow -import Database.PostgreSQL.Simple.ToField -import Database.PostgreSQL.Simple.ToRow -import Database.PostgreSQL.Simple.Types - -import Shared.Common.Util.Date -import Shared.Common.Util.String (splitOn) -import Shared.Common.Util.Uuid -import Wizard.Model.Questionnaire.QuestionnaireComment - -instance ToRow QuestionnaireCommentThread where - toRow QuestionnaireCommentThread {..} = - [ toField uuid - , toField path - , toField resolved - , toField private - , toField questionnaireUuid - , toField createdBy - , toField createdAt - , toField updatedAt - , toField tenantUuid - , toField assignedTo - , toField assignedBy - , toField notificationRequired - ] - -instance FromRow QuestionnaireCommentThread where - fromRow = do - uuid <- field - path <- field - resolved <- field - private <- field - questionnaireUuid <- field - createdBy <- field - createdAt <- field - updatedAt <- field - tenantUuid <- field - assignedTo <- field - assignedBy <- field - notificationRequired <- field - commentsArray <- fromPGArray <$> field - let comments = fmap parseComment commentsArray - return $ QuestionnaireCommentThread {..} - -parseComment :: String -> QuestionnaireComment -parseComment commentS = - let parts = splitOn ":::::" commentS - in QuestionnaireComment - { uuid = u' (head parts) - , text = parts !! 1 - , threadUuid = u' (parts !! 2) - , tenantUuid = u' (parts !! 3) - , createdBy = - case parts !! 4 of - "" -> Nothing - u -> Just . u' $ u - , createdAt = parsePostgresDateTime' $ parts !! 5 - , updatedAt = parsePostgresDateTime' $ parts !! 6 - } diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireCommentThreadAssigned.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireCommentThreadAssigned.hs deleted file mode 100644 index b1ac288be..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireCommentThreadAssigned.hs +++ /dev/null @@ -1,38 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.QuestionnaireCommentThreadAssigned where - -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.FromField -import Database.PostgreSQL.Simple.FromRow - -import Shared.Common.Util.Gravatar -import Wizard.Model.Questionnaire.QuestionnaireCommentThreadAssigned -import WizardLib.Public.Model.User.UserSuggestion - -instance FromRow QuestionnaireCommentThreadAssigned where - fromRow = do - questionnaireUuid <- field - questionnaireName <- field - commentThreadUuid <- field - path <- field - resolved <- field - private <- field - updatedAt <- field - text <- field - mCreatedByUuid <- fieldWith (optionalField fromField) - mCreatedByFirstName <- fieldWith (optionalField fromField) - mCreatedByLastName <- fieldWith (optionalField fromField) - mCreatedByEmail <- fieldWith (optionalField fromField) - mCreatedByImageUrl <- fieldWith (optionalField fromField) - let createdBy = - case (mCreatedByUuid, mCreatedByFirstName, mCreatedByLastName, mCreatedByEmail) of - (Just createdByUuid, Just createdByFirstName, Just createdByLastName, Just createdByEmail) -> - Just $ - UserSuggestion - { uuid = createdByUuid - , firstName = createdByFirstName - , lastName = createdByLastName - , imageUrl = mCreatedByImageUrl - , gravatarHash = createGravatarHash createdByEmail - } - _ -> Nothing - return QuestionnaireCommentThreadAssigned {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireCommentThreadList.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireCommentThreadList.hs deleted file mode 100644 index 0dd062820..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireCommentThreadList.hs +++ /dev/null @@ -1,85 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.QuestionnaireCommentThreadList where - -import qualified Data.List as L -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.FromField -import Database.PostgreSQL.Simple.FromRow -import Database.PostgreSQL.Simple.Types - -import Shared.Common.Util.Date -import Shared.Common.Util.Gravatar -import Shared.Common.Util.String (splitOn) -import Shared.Common.Util.Uuid -import Wizard.Model.Questionnaire.QuestionnaireCommentList -import WizardLib.Public.Model.User.UserSuggestion - -instance FromRow QuestionnaireCommentThreadList where - fromRow = do - uuid <- field - path <- field - resolved <- field - private <- field - createdAt <- field - updatedAt <- field - mAssignedToUuid <- fieldWith (optionalField fromField) - mAssignedToFirstName <- fieldWith (optionalField fromField) - mAssignedToLastName <- fieldWith (optionalField fromField) - mAssignedToEmail <- fieldWith (optionalField fromField) - mAssignedToImageUrl <- fieldWith (optionalField fromField) - let assignedTo = - case (mAssignedToUuid, mAssignedToFirstName, mAssignedToLastName, mAssignedToEmail) of - (Just assignedToUuid, Just assignedToFirstName, Just assignedToLastName, Just assignedToEmail) -> - Just $ - UserSuggestion - { uuid = assignedToUuid - , firstName = assignedToFirstName - , lastName = assignedToLastName - , imageUrl = mAssignedToImageUrl - , gravatarHash = createGravatarHash assignedToEmail - } - _ -> Nothing - mCreatedByUuid <- fieldWith (optionalField fromField) - mCreatedByFirstName <- fieldWith (optionalField fromField) - mCreatedByLastName <- fieldWith (optionalField fromField) - mCreatedByEmail <- fieldWith (optionalField fromField) - mCreatedByImageUrl <- fieldWith (optionalField fromField) - let createdBy = - case (mCreatedByUuid, mCreatedByFirstName, mCreatedByLastName, mCreatedByEmail) of - (Just createdByUuid, Just createdByFirstName, Just createdByLastName, Just createdByEmail) -> - Just $ - UserSuggestion - { uuid = createdByUuid - , firstName = createdByFirstName - , lastName = createdByLastName - , imageUrl = mCreatedByImageUrl - , gravatarHash = createGravatarHash createdByEmail - } - _ -> Nothing - commentsArray <- fromPGArray <$> field - let comments = L.sort . fmap parseComment $ commentsArray - return QuestionnaireCommentThreadList {..} - -parseComment :: String -> QuestionnaireCommentList -parseComment commentS = - let parts = splitOn "<:::::>" commentS - in QuestionnaireCommentList - { uuid = u' (head parts) - , text = parts !! 1 - , createdAt = parsePostgresDateTime' $ parts !! 2 - , updatedAt = parsePostgresDateTime' $ parts !! 3 - , createdBy = - case parts !! 4 of - "" -> Nothing - _ -> - Just $ - UserSuggestion - { uuid = u' $ parts !! 4 - , firstName = parts !! 5 - , lastName = parts !! 6 - , imageUrl = - case parts !! 8 of - "" -> Nothing - value -> Just value - , gravatarHash = createGravatarHash $ parts !! 7 - } - } diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireCommentThreadNotification.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireCommentThreadNotification.hs deleted file mode 100644 index 664191c30..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireCommentThreadNotification.hs +++ /dev/null @@ -1,55 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.QuestionnaireCommentThreadNotification where - -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.FromField -import Database.PostgreSQL.Simple.FromRow - -import Wizard.Model.Questionnaire.QuestionnaireCommentThreadNotification -import WizardLib.Public.Model.User.UserSimple - -instance FromRow QuestionnaireCommentThreadNotification where - fromRow = do - questionnaireUuid <- field - questionnaireName <- field - tenantUuid <- field - commentThreadUuid <- field - path <- field - resolved <- field - private <- field - assignedToUuid <- field - assignedToFirstName <- field - assignedToLastName <- field - assignedToEmail <- field - let assignedTo = - UserSimple - { uuid = assignedToUuid - , firstName = assignedToFirstName - , lastName = assignedToLastName - , imageUrl = Nothing - , email = assignedToEmail - } - mAssignedByUuid <- fieldWith (optionalField fromField) - mAssignedByFirstName <- fieldWith (optionalField fromField) - mAssignedByLastName <- fieldWith (optionalField fromField) - mAssignedByEmail <- fieldWith (optionalField fromField) - let assignedBy = - case (mAssignedByUuid, mAssignedByFirstName, mAssignedByLastName, mAssignedByEmail) of - (Just assignedByUuid, Just assignedByFirstName, Just assignedByLastName, Just assignedByEmail) -> - Just $ - UserSimple - { uuid = assignedByUuid - , firstName = assignedByFirstName - , lastName = assignedByLastName - , imageUrl = Nothing - , email = assignedByEmail - } - _ -> Nothing - text <- field - clientUrl <- field - appTitle <- field - logoUrl <- field - primaryColor <- field - illustrationsColor <- field - supportEmail <- field - mailConfigUuid <- field - return QuestionnaireCommentThreadNotification {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireCreation.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireCreation.hs deleted file mode 100644 index 6b2fca4c6..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireCreation.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.QuestionnaireCreation where - -import Database.PostgreSQL.Simple.FromField -import Database.PostgreSQL.Simple.ToField - -import Shared.Common.Database.Mapping.Common -import Wizard.Model.Tenant.Config.TenantConfig - -instance ToField QuestionnaireCreation where - toField = toFieldGenericEnum - -instance FromField QuestionnaireCreation where - fromField = fromFieldGenericEnum diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireDetail.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireDetail.hs deleted file mode 100644 index 3a7842b0c..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireDetail.hs +++ /dev/null @@ -1,28 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.QuestionnaireDetail where - -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.FromRow -import Database.PostgreSQL.Simple.Types - -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventJM () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireAcl -import Wizard.Database.Mapping.Questionnaire.QuestionnaireSharing () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireState () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireVisibility () -import Wizard.Model.Questionnaire.QuestionnaireDetail - -instance FromRow QuestionnaireDetail where - fromRow = do - uuid <- field - name <- field - visibility <- field - sharing <- field - knowledgeModelPackageId <- field - selectedQuestionTagUuids <- fromPGArray <$> field - isTemplate <- field - migrationUuid <- field - permissions <- loadPermissions uuid - questionnaireActionsAvailable <- field - questionnaireImportersAvailable <- field - fileCount <- field - return $ QuestionnaireDetail {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireDetailPreview.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireDetailPreview.hs deleted file mode 100644 index 6c6489745..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireDetailPreview.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.QuestionnaireDetailPreview where - -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.FromRow - -import Shared.DocumentTemplate.Api.Resource.DocumentTemplate.DocumentTemplateJM () -import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplateFormatSimple -import Wizard.Api.Resource.Questionnaire.QuestionnairePermJM () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireAcl -import Wizard.Database.Mapping.Questionnaire.QuestionnaireSharing () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireVisibility () -import Wizard.Model.Questionnaire.QuestionnaireDetailPreview - -instance FromRow QuestionnaireDetailPreview where - fromRow = do - uuid <- field - name <- field - visibility <- field - sharing <- field - knowledgeModelPackageId <- field - isTemplate <- field - documentTemplateId <- field - migrationUuid <- field - permissions <- loadPermissions uuid - mFormatUuid <- field - mFormatName <- field - mFormatIcon <- field - let format = - case (mFormatUuid, mFormatName, mFormatIcon) of - (Just uuid, Just name, Just icon) -> Just $ DocumentTemplateFormatSimple {uuid = uuid, name = name, icon = icon} - _ -> Nothing - fileCount <- field - return $ QuestionnaireDetailPreview {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireDetailQuestionnaire.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireDetailQuestionnaire.hs deleted file mode 100644 index 5f49de9fd..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireDetailQuestionnaire.hs +++ /dev/null @@ -1,47 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.QuestionnaireDetailQuestionnaire where - -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.FromField -import Database.PostgreSQL.Simple.FromRow -import Database.PostgreSQL.Simple.Types - -import Shared.Common.Util.String -import Shared.Common.Util.Uuid -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventJM () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireAcl -import Wizard.Database.Mapping.Questionnaire.QuestionnaireFileSimple () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireSharing () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireState () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireVisibility () -import Wizard.Model.Questionnaire.QuestionnaireDetailQuestionnaire -import Wizard.Model.Questionnaire.QuestionnaireFileSimple - -instance FromRow QuestionnaireDetailQuestionnaire where - fromRow = do - uuid <- field - name <- field - visibility <- field - sharing <- field - knowledgeModelPackageId <- field - selectedQuestionTagUuids <- fromPGArray <$> field - isTemplate <- field - migrationUuid <- field - permissions <- loadPermissions uuid - questionnaireActionsAvailable <- field - questionnaireImportersAvailable <- field - mFiles <- fieldWith (optionalField fromField) - let files = - case mFiles of - Just files -> fmap parseFile . fromPGArray $ files - Nothing -> [] - return $ QuestionnaireDetailQuestionnaire {..} - where - parseFile :: String -> QuestionnaireFileSimple - parseFile file = - let parts = splitOn "<:::::>" file - in QuestionnaireFileSimple - { uuid = u' $ head parts - , fileName = parts !! 1 - , contentType = parts !! 2 - , fileSize = read $ parts !! 3 - } diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireDetailSettings.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireDetailSettings.hs deleted file mode 100644 index 58772bece..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireDetailSettings.hs +++ /dev/null @@ -1,90 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.QuestionnaireDetailSettings where - -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.FromField -import Database.PostgreSQL.Simple.FromRow -import Database.PostgreSQL.Simple.Types - -import Shared.Common.Database.Mapping.Common.SemVer2Tuple () -import Shared.DocumentTemplate.Api.Resource.DocumentTemplate.DocumentTemplateDTO -import Shared.DocumentTemplate.Api.Resource.DocumentTemplate.DocumentTemplateJM () -import Shared.DocumentTemplate.Constant.DocumentTemplate -import Shared.DocumentTemplate.Database.Mapping.DocumentTemplate.DocumentTemplatePhase () -import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplateJM () -import Shared.KnowledgeModel.Database.Mapping.KnowledgeModel.Package.KnowledgeModelPackagePhase () -import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSimpleDTO -import Wizard.Api.Resource.Questionnaire.QuestionnairePermJM () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireAcl -import Wizard.Database.Mapping.Questionnaire.QuestionnaireSharing () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireState () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireVisibility () -import Wizard.Model.DocumentTemplate.DocumentTemplateState -import Wizard.Model.Questionnaire.QuestionnaireDetailSettings - -instance FromRow QuestionnaireDetailSettings where - fromRow = do - uuid <- field - name <- field - description <- field - visibility <- field - sharing <- field - isTemplate <- field - projectTags <- fromPGArray <$> field - selectedQuestionTagUuids <- fromPGArray <$> field - formatUuid <- field - migrationUuid <- field - permissions <- loadPermissions uuid - knowledgeModelPackageId <- field - knowledgeModelPackageName <- field - knowledgeModelPackageOrganizationId <- field - knowledgeModelPackageKmId <- field - knowledgeModelPackageVersion <- field - knowledgeModelPackagePhase <- field - knowledgeModelPackageDescription <- field - knowledgeModelPackageNonEditable <- field - knowledgeModelPackageCreatedAt <- field - let knowledgeModelPackage = - KnowledgeModelPackageSimpleDTO - { pId = knowledgeModelPackageId - , name = knowledgeModelPackageName - , organizationId = knowledgeModelPackageOrganizationId - , kmId = knowledgeModelPackageKmId - , version = knowledgeModelPackageVersion - , phase = knowledgeModelPackagePhase - , remoteLatestVersion = Nothing - , description = knowledgeModelPackageDescription - , organization = Nothing - , nonEditable = knowledgeModelPackageNonEditable - , createdAt = knowledgeModelPackageCreatedAt - } - let knowledgeModelTags = [] - mDocumentTemplateId <- field - mDocumentTemplateName <- field - mDocumentTemplateVersion <- field - mDocumentTemplatePhase <- field - mDocumentTemplateDescription <- field - mDocumentTemplateFormats <- fieldWith (optionalField fromJSONField) - let documentTemplate = - case (mDocumentTemplateId, mDocumentTemplateName, mDocumentTemplateVersion, mDocumentTemplatePhase, mDocumentTemplateDescription, mDocumentTemplateFormats) of - (Just documentTemplateId, Just documentTemplateName, Just documentTemplateVersion, Just documentTemplatePhase, Just documentTemplateDescription, Just documentTemplateFormats) -> - Just $ - DocumentTemplateDTO - { tId = documentTemplateId - , name = documentTemplateName - , version = documentTemplateVersion - , phase = documentTemplatePhase - , description = documentTemplateDescription - , formats = documentTemplateFormats - } - _ -> Nothing - let documentTemplatePhase = mDocumentTemplatePhase - mDocumentTemplateMetamodelVersion <- field - let documentTemplateState = - case mDocumentTemplateMetamodelVersion of - Just metamodelVersion -> - if metamodelVersion /= documentTemplateMetamodelVersion - then Just UnsupportedMetamodelVersionDocumentTemplateState - else Just DefaultDocumentTemplateState - _ -> Nothing - fileCount <- field - return $ QuestionnaireDetailSettings {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireEvent.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireEvent.hs deleted file mode 100644 index 20ea2b259..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireEvent.hs +++ /dev/null @@ -1,284 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.QuestionnaireEvent where - -import Data.Maybe (fromJust) -import qualified Data.Text as T -import qualified Data.UUID as U -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.FromField -import Database.PostgreSQL.Simple.FromRow -import Database.PostgreSQL.Simple.ToField -import Database.PostgreSQL.Simple.ToRow -import Database.PostgreSQL.Simple.Types -import GHC.Generics - -import Shared.Common.Util.Uuid -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventJM () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireSharing () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireVisibility () -import Wizard.Model.Questionnaire.QuestionnaireEvent -import Wizard.Model.Questionnaire.QuestionnaireReply - -instance ToRow QuestionnaireEvent where - toRow (SetReplyEvent' SetReplyEvent {..}) = - let values = - case value of - StringReply {..} -> - [ toField StringReplyType - , toField . PGArray $ [sValue] - , toField (Nothing :: Maybe String) - , toField (Nothing :: Maybe String) - ] - AnswerReply {..} -> - [ toField AnswerReplyType - , toField . PGArray $ [aValue] - , toField (Nothing :: Maybe String) - , toField (Nothing :: Maybe String) - ] - MultiChoiceReply {..} -> - [ toField MultiChoiceReplyType - , toField . PGArray $ mcValue - , toField (Nothing :: Maybe String) - , toField (Nothing :: Maybe String) - ] - ItemListReply {..} -> - [ toField ItemListReplyType - , toField . PGArray $ ilValue - , toField (Nothing :: Maybe String) - , toField (Nothing :: Maybe String) - ] - IntegrationReply {..} -> - case iValue of - PlainType {..} -> - [ toField IntegrationReplyType - , toField . PGArray $ [value] - , toField (Nothing :: Maybe String) - , toField (Nothing :: Maybe String) - ] - IntegrationLegacyType {..} -> - [ toField IntegrationReplyType - , toField . PGArray $ [value] - , case intId of - Just iId -> toField iId - Nothing -> toField "<>" - , toField (Nothing :: Maybe String) - ] - IntegrationType {..} -> - [ toField IntegrationReplyType - , toField . PGArray $ [value] - , toField (Nothing :: Maybe String) - , toField raw - ] - ItemSelectReply {..} -> - [ toField ItemSelectReplyType - , toField . PGArray $ [isValue] - , toField (Nothing :: Maybe String) - , toField (Nothing :: Maybe String) - ] - FileReply {..} -> - [ toField FileReplyType - , toField . PGArray $ [fValue] - , toField (Nothing :: Maybe String) - , toField (Nothing :: Maybe String) - ] - in [ toField uuid - , toField SetReplyEventType - , toField path - , toField createdAt - , toField createdBy - , toField questionnaireUuid - , toField tenantUuid - ] - ++ values - toRow (ClearReplyEvent' ClearReplyEvent {..}) = - [ toField uuid - , toField ClearReplyEventType - , toField path - , toField createdAt - , toField createdBy - , toField questionnaireUuid - , toField tenantUuid - , toField (Nothing :: Maybe String) - , toField (Nothing :: Maybe String) - , toField (Nothing :: Maybe String) - , toField (Nothing :: Maybe String) - ] - toRow (SetPhaseEvent' SetPhaseEvent {..}) = - [ toField uuid - , toField SetPhaseEventType - , toField (Nothing :: Maybe String) - , toField createdAt - , toField createdBy - , toField questionnaireUuid - , toField tenantUuid - , toField (Nothing :: Maybe String) - , case phaseUuid of - Just pUuid -> toField . PGArray $ [pUuid] - Nothing -> toField . PGArray $ ([] :: [U.UUID]) - , toField (Nothing :: Maybe String) - , toField (Nothing :: Maybe String) - ] - toRow (SetLabelsEvent' SetLabelsEvent {..}) = - [ toField uuid - , toField SetLabelsEventType - , toField path - , toField createdAt - , toField createdBy - , toField questionnaireUuid - , toField tenantUuid - , toField (Nothing :: Maybe String) - , toField . PGArray $ value - , toField (Nothing :: Maybe String) - , toField (Nothing :: Maybe String) - ] - -instance FromRow QuestionnaireEvent where - fromRow = do - uuid <- field - aType <- field - mPath <- field - createdAt <- field - createdBy <- field - questionnaireUuid <- field - tenantUuid <- field - valueType <- field - valueText <- fieldValueText - mValueId <- field - mValueRaw <- field - case aType of - SetReplyEventType -> do - return . SetReplyEvent' $ - SetReplyEvent - { uuid = uuid - , path = fromJust mPath - , value = parseValue valueType valueText mValueId mValueRaw - , questionnaireUuid = questionnaireUuid - , tenantUuid = tenantUuid - , createdBy = createdBy - , createdAt = createdAt - } - ClearReplyEventType -> - let path = fromJust mPath - in return . ClearReplyEvent' $ ClearReplyEvent {..} - SetPhaseEventType -> - return . SetPhaseEvent' $ - SetPhaseEvent - { uuid = uuid - , phaseUuid = - case valueText of - [value] -> Just . u' $ value - _ -> Nothing - , questionnaireUuid = questionnaireUuid - , tenantUuid = tenantUuid - , createdBy = createdBy - , createdAt = createdAt - } - SetLabelsEventType -> - return . SetLabelsEvent' $ - SetLabelsEvent - { uuid = uuid - , path = fromJust mPath - , value = fmap u' valueText - , questionnaireUuid = questionnaireUuid - , tenantUuid = tenantUuid - , createdBy = createdBy - , createdAt = createdAt - } - -parseValue valueType valueText mValueId mValueRaw = - case valueType of - Just StringReplyType -> StringReply . head $ valueText - Just AnswerReplyType -> AnswerReply . u' . head $ valueText - Just MultiChoiceReplyType -> MultiChoiceReply . fmap u' $ valueText - Just ItemListReplyType -> ItemListReply . fmap u' $ valueText - Just IntegrationReplyType -> - IntegrationReply - { iValue = - case mValueRaw of - Just raw -> IntegrationType {value = head valueText, raw = raw} - Nothing -> - case mValueId of - Just "<>" -> IntegrationLegacyType {intId = Nothing, value = head valueText} - Just valueId -> IntegrationLegacyType {intId = Just valueId, value = head valueText} - Nothing -> PlainType {value = head valueText} - } - Just ItemSelectReplyType -> ItemSelectReply . u' . head $ valueText - Just FileReplyType -> FileReply . u' . head $ valueText - _ -> error $ "Unknown value type: " ++ show valueType - -parseValueText :: Maybe (PGArray T.Text) -> [String] -parseValueText mValueText = - case mValueText :: Maybe (PGArray T.Text) of - Just valueText -> fmap T.unpack . fromPGArray $ valueText - Nothing -> [] - -fieldValueText :: RowParser [String] -fieldValueText = do - mValueText <- field - return $ parseValueText mValueText - -parsePhaseUuid :: [String] -> Maybe U.UUID -parsePhaseUuid valueText = - case valueText of - [value] -> Just . u' $ value - _ -> Nothing - -data QuestionnaireEventType - = SetReplyEventType - | ClearReplyEventType - | SetPhaseEventType - | SetLabelsEventType - deriving (Show, Read, Eq, Ord, Generic) - -instance FromField QuestionnaireEventType where - fromField f mdata = do - typename <- typename f -- Get the PostgreSQL type name - case mdata of - Just bs | typename == "questionnaire_event_type" -> - case bs of - "SetReplyEvent" -> pure SetReplyEventType - "ClearReplyEvent" -> pure ClearReplyEventType - "SetPhaseEvent" -> pure SetPhaseEventType - "SetLabelsEvent" -> pure SetLabelsEventType - _ -> returnError ConversionFailed f "Invalid ENUM value" - _ -> returnError Incompatible f "Expected questionnaire_event_type ENUM" - -instance ToField QuestionnaireEventType where - toField SetReplyEventType = toField ("SetReplyEvent" :: T.Text) - toField ClearReplyEventType = toField ("ClearReplyEvent" :: T.Text) - toField SetPhaseEventType = toField ("SetPhaseEvent" :: T.Text) - toField SetLabelsEventType = toField ("SetLabelsEvent" :: T.Text) - -data QuestionnaireReplyType - = StringReplyType - | AnswerReplyType - | MultiChoiceReplyType - | ItemListReplyType - | IntegrationReplyType - | ItemSelectReplyType - | FileReplyType - deriving (Show, Read, Eq, Ord, Generic) - -instance FromField QuestionnaireReplyType where - fromField f mdata = do - typename <- typename f -- Get the PostgreSQL type name - case mdata of - Just bs -> - case bs of - "StringReply" -> pure StringReplyType - "AnswerReply" -> pure AnswerReplyType - "MultiChoiceReply" -> pure MultiChoiceReplyType - "ItemListReply" -> pure ItemListReplyType - "IntegrationReply" -> pure IntegrationReplyType - "ItemSelectReply" -> pure ItemSelectReplyType - "FileReply" -> pure FileReplyType - _ -> returnError ConversionFailed f "Invalid ENUM value" - _ -> returnError Incompatible f "Expected value_type ENUM" - -instance ToField QuestionnaireReplyType where - toField StringReplyType = toField ("StringReply" :: T.Text) - toField AnswerReplyType = toField ("AnswerReply" :: T.Text) - toField MultiChoiceReplyType = toField ("MultiChoiceReply" :: T.Text) - toField ItemListReplyType = toField ("ItemListReply" :: T.Text) - toField IntegrationReplyType = toField ("IntegrationReply" :: T.Text) - toField ItemSelectReplyType = toField ("ItemSelectReply" :: T.Text) - toField FileReplyType = toField ("FileReply" :: T.Text) diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireEventList.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireEventList.hs deleted file mode 100644 index b68fbb724..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireEventList.hs +++ /dev/null @@ -1,52 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.QuestionnaireEventList where - -import Data.Maybe (fromJust) -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.FromRow - -import Shared.Common.Util.Uuid -import Wizard.Database.Mapping.Questionnaire.QuestionnaireEvent -import Wizard.Model.Questionnaire.QuestionnaireEventList -import WizardLib.Public.Database.Mapping.User.UserSuggestion - -instance FromRow QuestionnaireEventList where - fromRow = do - uuid <- field - aType <- field - mPath <- field - createdAt <- field - valueType <- field - valueText <- fieldValueText - mValueId <- field - mValueRaw <- field - createdBy <- fieldUserSuggestion' - case aType of - SetReplyEventType -> do - return . SetReplyEventList' $ - SetReplyEventList - { uuid = uuid - , path = fromJust mPath - , value = parseValue valueType valueText mValueId mValueRaw - , createdBy = createdBy - , createdAt = createdAt - } - ClearReplyEventType -> - let path = fromJust mPath - in return . ClearReplyEventList' $ ClearReplyEventList {..} - SetPhaseEventType -> - return . SetPhaseEventList' $ - SetPhaseEventList - { uuid = uuid - , phaseUuid = parsePhaseUuid valueText - , createdBy = createdBy - , createdAt = createdAt - } - SetLabelsEventType -> - return . SetLabelsEventList' $ - SetLabelsEventList - { uuid = uuid - , path = fromJust mPath - , value = fmap u' valueText - , createdBy = createdBy - , createdAt = createdAt - } diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireFile.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireFile.hs deleted file mode 100644 index e95664ed0..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireFile.hs +++ /dev/null @@ -1,9 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.QuestionnaireFile where - -import Database.PostgreSQL.Simple - -import Wizard.Model.Questionnaire.QuestionnaireFile - -instance ToRow QuestionnaireFile - -instance FromRow QuestionnaireFile diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireFileList.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireFileList.hs deleted file mode 100644 index d1c31b23b..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireFileList.hs +++ /dev/null @@ -1,36 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.QuestionnaireFileList where - -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.FromRow - -import Shared.Common.Util.Gravatar -import Wizard.Model.Questionnaire.QuestionnaireFileList -import Wizard.Model.Questionnaire.QuestionnaireSimple -import WizardLib.Public.Model.User.UserSuggestion - -instance FromRow QuestionnaireFileList where - fromRow = do - uuid <- field - fileName <- field - contentType <- field - fileSize <- field - createdAt <- field - questionnaireUuid <- field - questionnaireName <- field - let questionnaire = - QuestionnaireSimple - { uuid = questionnaireUuid - , name = questionnaireName - } - createdByUuid <- field - createdByFirstName <- field - createdByLastName <- field - createdByEmail <- field - createdByImageUrl <- field - let createdBy = - case (createdByUuid, createdByFirstName, createdByLastName, createdByEmail, createdByImageUrl) of - (Just uuid, Just firstName, Just lastName, Just email, imageUrl) -> - let gravatarHash = createGravatarHash email - in Just UserSuggestion {..} - _ -> Nothing - return $ QuestionnaireFileList {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireFileSimple.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireFileSimple.hs deleted file mode 100644 index 0d4ab674a..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireFileSimple.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.QuestionnaireFileSimple where - -import Database.PostgreSQL.Simple - -import Wizard.Model.Questionnaire.QuestionnaireFileSimple - -instance FromRow QuestionnaireFileSimple diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireList.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireList.hs deleted file mode 100644 index 16dd90932..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireList.hs +++ /dev/null @@ -1,84 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.QuestionnaireList where - -import qualified Data.List as L -import qualified Data.UUID as U -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.FromField -import Database.PostgreSQL.Simple.FromRow -import Database.PostgreSQL.Simple.Types - -import Shared.Common.Util.Gravatar -import Shared.Common.Util.String -import Shared.Common.Util.Uuid -import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackageSimple -import Wizard.Api.Resource.Acl.MemberDTO -import Wizard.Api.Resource.Questionnaire.QuestionnairePermDTO -import Wizard.Api.Resource.Questionnaire.QuestionnairePermJM () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireSharing () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireState () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireVisibility () -import Wizard.Model.Questionnaire.QuestionnaireList - -instance FromRow QuestionnaireList where - fromRow = do - uuid <- field - name <- field - description <- field - visibility <- field - sharing <- field - isTemplate <- field - createdAt <- field - updatedAt <- field - state <- field - packageId <- field - packageName <- field - packageVersion <- field - let knowledgeModelPackage = KnowledgeModelPackageSimple {pId = packageId, name = packageName, version = packageVersion} - mUserPermissions <- fieldWith (optionalField fromField) - let userPermissions = - case mUserPermissions of - Just userPermissions -> L.sort . fmap (parseUserPermission uuid) . fromPGArray $ userPermissions - Nothing -> [] - mGroupPermissions <- fieldWith (optionalField fromField) - let groupPermissions = - case mGroupPermissions of - Just groupPermissions -> L.sort . fmap (parseGroupPermission uuid) . fromPGArray $ groupPermissions - Nothing -> [] - let permissions = userPermissions ++ groupPermissions - return $ QuestionnaireList {..} - where - parseUserPermission :: U.UUID -> String -> QuestionnairePermDTO - parseUserPermission qtnUuid permission = - let parts = splitOn "::" permission - in QuestionnairePermDTO - { questionnaireUuid = qtnUuid - , perms = splitOn "," . replace "}" "" . replace "{" "" $ parts !! 1 - , member = - UserMemberDTO - { uuid = u' (parts !! 2) - , firstName = parts !! 3 - , lastName = parts !! 4 - , gravatarHash = createGravatarHash $ parts !! 5 - , imageUrl = - case parts !! 6 of - "" -> Nothing - imageUrl -> Just imageUrl - } - } - parseGroupPermission :: U.UUID -> String -> QuestionnairePermDTO - parseGroupPermission qtnUuid permission = - let parts = splitOn "::" permission - in QuestionnairePermDTO - { questionnaireUuid = qtnUuid - , perms = splitOn "," . replace "}" "" . replace "{" "" $ parts !! 1 - , member = - UserGroupMemberDTO - { uuid = u' (parts !! 2) - , name = parts !! 3 - , description = if length parts == 6 then Just $ parts !! 5 else Nothing - , private = - case parts !! 4 of - "t" -> True - _ -> False - } - } diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnairePerm.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnairePerm.hs deleted file mode 100644 index d339c4511..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnairePerm.hs +++ /dev/null @@ -1,34 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.QuestionnairePerm where - -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.FromField -import Database.PostgreSQL.Simple.FromRow -import Database.PostgreSQL.Simple.ToField -import Database.PostgreSQL.Simple.ToRow -import Database.PostgreSQL.Simple.Types - -import Shared.Common.Database.Mapping.Common -import Wizard.Model.Questionnaire.QuestionnairePerm - -instance ToField QuestionnairePermType where - toField = toFieldGenericEnum - -instance FromField QuestionnairePermType where - fromField = fromFieldGenericEnum - -instance ToRow QuestionnairePerm where - toRow r@QuestionnairePerm {..} = - [ toField questionnaireUuid - , toField memberUuid - , toField . PGArray $ perms - , toField tenantUuid - ] - -instance FromRow QuestionnairePerm where - fromRow = do - questionnaireUuid <- field - memberType <- field - memberUuid <- field - perms <- fromPGArray <$> field - tenantUuid <- field - return QuestionnairePerm {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireSharing.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireSharing.hs deleted file mode 100644 index 3c7d77061..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireSharing.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.QuestionnaireSharing where - -import Database.PostgreSQL.Simple.FromField -import Database.PostgreSQL.Simple.ToField - -import Shared.Common.Database.Mapping.Common -import Wizard.Model.Questionnaire.Questionnaire - -instance ToField QuestionnaireSharing where - toField = toFieldGenericEnum - -instance FromField QuestionnaireSharing where - fromField = fromFieldGenericEnum diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireSimple.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireSimple.hs deleted file mode 100644 index 8b2c9cc1b..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireSimple.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.QuestionnaireSimple where - -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.FromRow -import Database.PostgreSQL.Simple.ToField -import Database.PostgreSQL.Simple.ToRow - -import Wizard.Model.Questionnaire.QuestionnaireSimple - -instance ToRow QuestionnaireSimple where - toRow QuestionnaireSimple {..} = [toField uuid, toField name] - -instance FromRow QuestionnaireSimple where - fromRow = do - uuid <- field - name <- field - return $ QuestionnaireSimple {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireSimpleWithPerm.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireSimpleWithPerm.hs deleted file mode 100644 index 0e32f86c7..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireSimpleWithPerm.hs +++ /dev/null @@ -1,55 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.QuestionnaireSimpleWithPerm where - -import qualified Data.UUID as U -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.FromField -import Database.PostgreSQL.Simple.FromRow -import Database.PostgreSQL.Simple.Types - -import Shared.Common.Util.String -import Shared.Common.Util.Uuid -import Wizard.Database.Mapping.Questionnaire.QuestionnairePerm () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireSharing () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireVisibility () -import Wizard.Model.Questionnaire.QuestionnairePerm -import Wizard.Model.Questionnaire.QuestionnaireSimpleWithPerm - -instance FromRow QuestionnaireSimpleWithPerm where - fromRow = do - uuid <- field - visibility <- field - sharing <- field - tenantUuid <- field - mUserPermissions <- fieldWith (optionalField fromField) - let userPermissions = - case mUserPermissions of - Just userPermissions -> fmap (parseUserPermission uuid tenantUuid) . fromPGArray $ userPermissions - Nothing -> [] - mGroupPermissions <- fieldWith (optionalField fromField) - let groupPermissions = - case mGroupPermissions of - Just groupPermissions -> fmap (parseGroupPermission uuid tenantUuid) . fromPGArray $ groupPermissions - Nothing -> [] - let permissions = userPermissions ++ groupPermissions - return $ QuestionnaireSimpleWithPerm {..} - where - parseUserPermission :: U.UUID -> U.UUID -> String -> QuestionnairePerm - parseUserPermission qtnUuid tenantUuid permission = - let parts = splitOn "::" permission - in QuestionnairePerm - { questionnaireUuid = qtnUuid - , memberType = UserQuestionnairePermType - , memberUuid = u' $ head parts - , perms = splitOn "," . replace "}" "" . replace "{" "" $ parts !! 1 - , tenantUuid = tenantUuid - } - parseGroupPermission :: U.UUID -> U.UUID -> String -> QuestionnairePerm - parseGroupPermission qtnUuid tenantUuid permission = - let parts = splitOn "::" permission - in QuestionnairePerm - { questionnaireUuid = qtnUuid - , memberType = UserGroupQuestionnairePermType - , memberUuid = u' $ head parts - , perms = splitOn "," . replace "}" "" . replace "{" "" $ parts !! 1 - , tenantUuid = tenantUuid - } diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireState.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireState.hs deleted file mode 100644 index 00ae5fbb7..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireState.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.QuestionnaireState where - -import qualified Data.ByteString.Char8 as BS -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.FromField - -import Wizard.Model.Questionnaire.QuestionnaireState - -instance FromField QuestionnaireState where - fromField f dat = - case fmap BS.unpack dat of - Just "Default" -> return QSDefault - Just "Migrating" -> return QSMigrating - Just "Outdated" -> return QSOutdated - _ -> returnError ConversionFailed f "Unsupported type" diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireSuggestion.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireSuggestion.hs deleted file mode 100644 index 82fc14c50..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireSuggestion.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.QuestionnaireSuggestion where - -import Database.PostgreSQL.Simple - -import Wizard.Model.Questionnaire.QuestionnaireSuggestion - -instance FromRow QuestionnaireSuggestion diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireVersion.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireVersion.hs deleted file mode 100644 index dda43a7e0..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireVersion.hs +++ /dev/null @@ -1,9 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.QuestionnaireVersion where - -import Database.PostgreSQL.Simple - -import Wizard.Model.Questionnaire.QuestionnaireVersion - -instance ToRow QuestionnaireVersion - -instance FromRow QuestionnaireVersion diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireVersionList.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireVersionList.hs deleted file mode 100644 index 5a7f20a9b..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireVersionList.hs +++ /dev/null @@ -1,29 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.QuestionnaireVersionList where - -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.FromRow - -import Shared.Common.Util.Gravatar -import Wizard.Model.Questionnaire.QuestionnaireVersionList -import WizardLib.Public.Model.User.UserSuggestion - -instance FromRow QuestionnaireVersionList where - fromRow = do - uuid <- field - name <- field - description <- field - eventUuid <- field - createdAt <- field - updatedAt <- field - createdByUuid <- field - createdByFirstName <- field - createdByLastName <- field - createdByEmail <- field - createdByImageUrl <- field - let createdBy = - case (createdByUuid, createdByFirstName, createdByLastName, createdByEmail, createdByImageUrl) of - (Just uuid, Just firstName, Just lastName, Just email, imageUrl) -> - let gravatarHash = createGravatarHash email - in Just UserSuggestion {..} - _ -> Nothing - return $ QuestionnaireVersionList {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireVisibility.hs b/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireVisibility.hs deleted file mode 100644 index 55a7bfdfd..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Questionnaire/QuestionnaireVisibility.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Wizard.Database.Mapping.Questionnaire.QuestionnaireVisibility where - -import Database.PostgreSQL.Simple.FromField -import Database.PostgreSQL.Simple.ToField - -import Shared.Common.Database.Mapping.Common -import Wizard.Model.Questionnaire.Questionnaire - -instance ToField QuestionnaireVisibility where - toField = toFieldGenericEnum - -instance FromField QuestionnaireVisibility where - fromField = fromFieldGenericEnum diff --git a/wizard-server/src/Wizard/Database/Mapping/QuestionnaireAction/QuestionnaireAction.hs b/wizard-server/src/Wizard/Database/Mapping/QuestionnaireAction/QuestionnaireAction.hs deleted file mode 100644 index d1d441d99..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/QuestionnaireAction/QuestionnaireAction.hs +++ /dev/null @@ -1,50 +0,0 @@ -module Wizard.Database.Mapping.QuestionnaireAction.QuestionnaireAction where - -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.FromField -import Database.PostgreSQL.Simple.FromRow -import Database.PostgreSQL.Simple.ToField -import Database.PostgreSQL.Simple.ToRow - -import Shared.KnowledgeModel.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackagePatternJM () -import Wizard.Model.QuestionnaireAction.QuestionnaireAction - -instance ToRow QuestionnaireAction where - toRow QuestionnaireAction {..} = - [ toField qaId - , toField name - , toField organizationId - , toField actionId - , toField version - , toField metamodelVersion - , toField description - , toField readme - , toField license - , toJSONField allowedPackages - , toField url - , toJSONField config - , toField enabled - , toField tenantUuid - , toField createdAt - , toField updatedAt - ] - -instance FromRow QuestionnaireAction where - fromRow = do - qaId <- field - name <- field - organizationId <- field - actionId <- field - version <- field - metamodelVersion <- field - description <- field - readme <- field - license <- field - allowedPackages <- fieldWith fromJSONField - url <- field - config <- fieldWith fromJSONField - enabled <- field - tenantUuid <- field - createdAt <- field - updatedAt <- field - return $ QuestionnaireAction {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/QuestionnaireImporter/QuestionnaireImporter.hs b/wizard-server/src/Wizard/Database/Mapping/QuestionnaireImporter/QuestionnaireImporter.hs deleted file mode 100644 index ac46aabbc..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/QuestionnaireImporter/QuestionnaireImporter.hs +++ /dev/null @@ -1,48 +0,0 @@ -module Wizard.Database.Mapping.QuestionnaireImporter.QuestionnaireImporter where - -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.FromField -import Database.PostgreSQL.Simple.FromRow -import Database.PostgreSQL.Simple.ToField -import Database.PostgreSQL.Simple.ToRow - -import Shared.KnowledgeModel.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackagePatternJM () -import Wizard.Model.QuestionnaireImporter.QuestionnaireImporter - -instance ToRow QuestionnaireImporter where - toRow QuestionnaireImporter {..} = - [ toField qiId - , toField name - , toField organizationId - , toField importerId - , toField version - , toField metamodelVersion - , toField description - , toField readme - , toField license - , toJSONField allowedPackages - , toField url - , toField enabled - , toField tenantUuid - , toField createdAt - , toField updatedAt - ] - -instance FromRow QuestionnaireImporter where - fromRow = do - qiId <- field - name <- field - organizationId <- field - importerId <- field - version <- field - metamodelVersion <- field - description <- field - readme <- field - license <- field - allowedPackages <- fieldWith fromJSONField - url <- field - enabled <- field - tenantUuid <- field - createdAt <- field - updatedAt <- field - return $ QuestionnaireImporter {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Tenant/Config/TenantConfigProject.hs b/wizard-server/src/Wizard/Database/Mapping/Tenant/Config/TenantConfigProject.hs new file mode 100644 index 000000000..d07652a44 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Tenant/Config/TenantConfigProject.hs @@ -0,0 +1,77 @@ +module Wizard.Database.Mapping.Tenant.Config.TenantConfigProject where + +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.FromRow +import Database.PostgreSQL.Simple.ToField +import Database.PostgreSQL.Simple.ToRow +import Database.PostgreSQL.Simple.Types + +import Shared.Common.Model.Config.SimpleFeature +import Wizard.Database.Mapping.Project.ProjectCreation () +import Wizard.Database.Mapping.Project.ProjectSharing () +import Wizard.Database.Mapping.Project.ProjectVisibility () +import Wizard.Model.Tenant.Config.TenantConfig + +instance ToRow TenantConfigProject where + toRow TenantConfigProject {..} = + [ toField tenantUuid + , toField projectVisibility.enabled + , toField projectVisibility.defaultValue + , toField projectSharing.enabled + , toField projectSharing.defaultValue + , toField projectSharing.anonymousEnabled + , toField projectCreation + , toField projectTagging.enabled + , toField . PGArray $ projectTagging.tags + , toField summaryReport.enabled + , toField feedback.enabled + , toField feedback.token + , toField feedback.owner + , toField feedback.repo + , toField createdAt + , toField updatedAt + ] + +instance FromRow TenantConfigProject where + fromRow = do + tenantUuid <- field + projectVisibilityEnabled <- field + projectVisibilityDefaultValue <- field + let projectVisibility = + TenantConfigProjectVisibility + { enabled = projectVisibilityEnabled + , defaultValue = projectVisibilityDefaultValue + } + projectSharingEnabled <- field + projectSharingDefaultValue <- field + projectSharingAnonymousEnabled <- field + let projectSharing = + TenantConfigProjectSharing + { enabled = projectSharingEnabled + , defaultValue = projectSharingDefaultValue + , anonymousEnabled = projectSharingAnonymousEnabled + } + projectCreation <- field + projectTaggingEnabled <- field + projectTaggingTags <- fromPGArray <$> field + let projectTagging = + TenantConfigProjectProjectTagging + { enabled = projectTaggingEnabled + , tags = projectTaggingTags + } + summaryReportEnabled <- field + let summaryReport = SimpleFeature summaryReportEnabled + feedbackEnabled <- field + feedbackToken <- field + feedbackOwner <- field + feedbackRepo <- field + let feedback = + TenantConfigProjectFeedback + { enabled = feedbackEnabled + , token = feedbackToken + , owner = feedbackOwner + , repo = feedbackRepo + } + createdAt <- field + updatedAt <- field + return TenantConfigProject {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Tenant/Config/TenantConfigQuestionnaire.hs b/wizard-server/src/Wizard/Database/Mapping/Tenant/Config/TenantConfigQuestionnaire.hs deleted file mode 100644 index 99d49d71e..000000000 --- a/wizard-server/src/Wizard/Database/Mapping/Tenant/Config/TenantConfigQuestionnaire.hs +++ /dev/null @@ -1,77 +0,0 @@ -module Wizard.Database.Mapping.Tenant.Config.TenantConfigQuestionnaire where - -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.FromRow -import Database.PostgreSQL.Simple.ToField -import Database.PostgreSQL.Simple.ToRow -import Database.PostgreSQL.Simple.Types - -import Shared.Common.Model.Config.SimpleFeature -import Wizard.Database.Mapping.Questionnaire.QuestionnaireCreation () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireSharing () -import Wizard.Database.Mapping.Questionnaire.QuestionnaireVisibility () -import Wizard.Model.Tenant.Config.TenantConfig - -instance ToRow TenantConfigQuestionnaire where - toRow TenantConfigQuestionnaire {..} = - [ toField tenantUuid - , toField questionnaireVisibility.enabled - , toField questionnaireVisibility.defaultValue - , toField questionnaireSharing.enabled - , toField questionnaireSharing.defaultValue - , toField questionnaireSharing.anonymousEnabled - , toField questionnaireCreation - , toField projectTagging.enabled - , toField . PGArray $ projectTagging.tags - , toField summaryReport.enabled - , toField feedback.enabled - , toField feedback.token - , toField feedback.owner - , toField feedback.repo - , toField createdAt - , toField updatedAt - ] - -instance FromRow TenantConfigQuestionnaire where - fromRow = do - tenantUuid <- field - questionnaireVisibilityEnabled <- field - questionnaireVisibilityDefaultValue <- field - let questionnaireVisibility = - TenantConfigQuestionnaireVisibility - { enabled = questionnaireVisibilityEnabled - , defaultValue = questionnaireVisibilityDefaultValue - } - questionnaireSharingEnabled <- field - questionnaireSharingDefaultValue <- field - questionnaireSharingAnonymousEnabled <- field - let questionnaireSharing = - TenantConfigQuestionnaireSharing - { enabled = questionnaireSharingEnabled - , defaultValue = questionnaireSharingDefaultValue - , anonymousEnabled = questionnaireSharingAnonymousEnabled - } - questionnaireCreation <- field - projectTaggingEnabled <- field - projectTaggingTags <- fromPGArray <$> field - let projectTagging = - TenantConfigQuestionnaireProjectTagging - { enabled = projectTaggingEnabled - , tags = projectTaggingTags - } - summaryReportEnabled <- field - let summaryReport = SimpleFeature summaryReportEnabled - feedbackEnabled <- field - feedbackToken <- field - feedbackOwner <- field - feedbackRepo <- field - let feedback = - TenantConfigQuestionnaireFeedback - { enabled = feedbackEnabled - , token = feedbackToken - , owner = feedbackOwner - , repo = feedbackRepo - } - createdAt <- field - updatedAt <- field - return TenantConfigQuestionnaire {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Tenant/TenantLimitBundle.hs b/wizard-server/src/Wizard/Database/Mapping/Tenant/TenantLimitBundle.hs index 1b3f949e4..ab044430e 100644 --- a/wizard-server/src/Wizard/Database/Mapping/Tenant/TenantLimitBundle.hs +++ b/wizard-server/src/Wizard/Database/Mapping/Tenant/TenantLimitBundle.hs @@ -15,7 +15,7 @@ instance FromRow TenantLimitBundle where knowledgeModels <- field knowledgeModelEditors <- field documentTemplates <- field - questionnaires <- field + projects <- field documents <- field storage <- field createdAt <- field @@ -32,7 +32,7 @@ instance ToRow TenantLimitBundle where , toField knowledgeModels , toField knowledgeModelEditors , toField documentTemplates - , toField questionnaires + , toField projects , toField documents , toField storage , toField createdAt diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Document/Data/Documents.hs b/wizard-server/src/Wizard/Database/Migration/Development/Document/Data/Documents.hs index b34030e08..84961cf8c 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/Document/Data/Documents.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/Document/Data/Documents.hs @@ -16,20 +16,20 @@ import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data. import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModelLenses import Wizard.Api.Resource.Document.DocumentCreateDTO import Wizard.Api.Resource.Document.DocumentDTO -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires +import Wizard.Database.Migration.Development.Project.Data.Projects import Wizard.Database.Migration.Development.Report.Data.Reports import Wizard.Database.Migration.Development.Tenant.Data.TenantConfigs import Wizard.Database.Migration.Development.Tenant.Data.Tenants import Wizard.Database.Migration.Development.User.Data.Users import Wizard.Model.Document.Document import Wizard.Model.Document.DocumentContext -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireContent +import Wizard.Model.Project.Project +import Wizard.Model.Project.ProjectContent import Wizard.Model.Tenant.Tenant import Wizard.Model.User.User import Wizard.Service.Document.Context.DocumentContextMapper import Wizard.Service.Document.DocumentMapper -import Wizard.Service.Questionnaire.Version.QuestionnaireVersionMapper +import Wizard.Service.Project.Version.ProjectVersionMapper import qualified Wizard.Service.User.UserMapper as USR_Mapper doc1 :: Document @@ -39,9 +39,9 @@ doc1 = , name = "My exported document" , state = DoneDocumentState , durability = PersistentDocumentDurability - , questionnaireUuid = Just questionnaire1.uuid - , questionnaireEventUuid = Just . getUuid . last $ questionnaire1Events - , questionnaireRepliesHash = hash . M.toList $ questionnaire1Ctn.replies + , projectUuid = Just project1.uuid + , projectEventUuid = Just . getUuid . last $ project1Events + , projectRepliesHash = hash . M.toList $ project1Ctn.replies , documentTemplateId = wizardDocumentTemplate.tId , formatUuid = formatJson.uuid , createdBy = Just $ userNikola.uuid @@ -78,21 +78,21 @@ dmp1 = , createdBy = Just . USR_Mapper.toDTO $ userNikola , createdAt = doc1.createdAt } - , questionnaire = + , project = DocumentContextQuestionnaire - { uuid = questionnaire1.uuid - , name = questionnaire1.name - , description = questionnaire1.description - , replies = questionnaire1Ctn.replies - , phaseUuid = questionnaire1Ctn.phaseUuid - , labels = questionnaire1Ctn.labels + { uuid = project1.uuid + , name = project1.name + , description = project1.description + , replies = project1Ctn.replies + , phaseUuid = project1Ctn.phaseUuid + , labels = project1Ctn.labels , versionUuid = Nothing - , versions = fmap (`toVersionList` Just userAlbertDto) questionnaire1Versions - , projectTags = questionnaire1.projectTags + , versions = fmap (`toVersionList` Just userAlbertDto) project1Versions + , projectTags = project1.projectTags , files = [] , createdBy = Just . USR_Mapper.toDTO $ userAlbert - , createdAt = questionnaire1.createdAt - , updatedAt = questionnaire1.updatedAt + , createdAt = project1.createdAt + , updatedAt = project1.updatedAt } , knowledgeModel = km1WithQ4 , report = report1 @@ -112,14 +112,14 @@ doc1Create :: DocumentCreateDTO doc1Create = DocumentCreateDTO { name = doc1.name - , questionnaireUuid = questionnaire1.uuid - , questionnaireEventUuid = Just . getUuid . last $ questionnaire1Events + , projectUuid = project1.uuid + , projectEventUuid = Just . getUuid . last $ project1Events , documentTemplateId = doc1.documentTemplateId , formatUuid = doc1.formatUuid } doc1Dto :: DocumentDTO -doc1Dto = toDTOWithDocTemplate doc1 questionnaire1 Nothing [] wizardDocumentTemplate formatJsonSimple +doc1Dto = toDTOWithDocTemplate doc1 project1 Nothing [] wizardDocumentTemplate formatJsonSimple doc2 :: Document doc2 = @@ -128,9 +128,9 @@ doc2 = , name = "My exported document 2" , state = DoneDocumentState , durability = PersistentDocumentDurability - , questionnaireUuid = Just questionnaire2.uuid - , questionnaireEventUuid = Just . getUuid . last $ questionnaire2Events - , questionnaireRepliesHash = hash . M.toList $ questionnaire2Ctn.replies + , projectUuid = Just project2.uuid + , projectEventUuid = Just . getUuid . last $ project2Events + , projectRepliesHash = hash . M.toList $ project2Ctn.replies , documentTemplateId = wizardDocumentTemplate.tId , formatUuid = formatJson.uuid , createdBy = Just $ userNikola.uuid @@ -151,9 +151,9 @@ doc3 = , name = "My exported document 3" , state = DoneDocumentState , durability = PersistentDocumentDurability - , questionnaireUuid = Just questionnaire2.uuid - , questionnaireEventUuid = Just . getUuid . last $ questionnaire2Events - , questionnaireRepliesHash = hash . M.toList $ questionnaire2Ctn.replies + , projectUuid = Just project2.uuid + , projectEventUuid = Just . getUuid . last $ project2Events + , projectRepliesHash = hash . M.toList $ project2Ctn.replies , documentTemplateId = wizardDocumentTemplate.tId , formatUuid = formatJson.uuid , createdBy = Just $ userAlbert.uuid @@ -234,9 +234,9 @@ differentDoc = , name = "My different document" , state = DoneDocumentState , durability = PersistentDocumentDurability - , questionnaireUuid = Just differentQuestionnaire.uuid - , questionnaireEventUuid = Nothing - , questionnaireRepliesHash = hash . M.toList $ questionnaire1Ctn.replies + , projectUuid = Just differentProject.uuid + , projectEventUuid = Nothing + , projectRepliesHash = hash . M.toList $ project1Ctn.replies , documentTemplateId = anotherWizardDocumentTemplate.tId , formatUuid = formatJson.uuid , createdBy = Just $ userCharles.uuid diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Document/DocumentSchemaMigration.hs b/wizard-server/src/Wizard/Database/Migration/Development/Document/DocumentSchemaMigration.hs index d8a25991d..edeb29f91 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/Document/DocumentSchemaMigration.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/Document/DocumentSchemaMigration.hs @@ -32,26 +32,26 @@ createDocumentTable = do let sql = "CREATE TABLE document \ \( \ - \ uuid uuid NOT NULL, \ - \ name varchar NOT NULL, \ - \ state varchar NOT NULL, \ - \ durability varchar NOT NULL, \ - \ questionnaire_uuid uuid, \ - \ questionnaire_event_uuid uuid, \ - \ questionnaire_replies_hash bigint NOT NULL, \ - \ document_template_id varchar NOT NULL, \ - \ format_uuid uuid NOT NULL, \ - \ created_by uuid, \ - \ retrieved_at timestamptz, \ - \ finished_at timestamptz, \ - \ created_at timestamptz NOT NULL, \ - \ file_name varchar, \ - \ content_type varchar, \ - \ worker_log varchar, \ - \ tenant_uuid uuid NOT NULL, \ - \ file_size bigint, \ + \ uuid uuid NOT NULL, \ + \ name varchar NOT NULL, \ + \ state varchar NOT NULL, \ + \ durability varchar NOT NULL, \ + \ project_uuid uuid, \ + \ project_event_uuid uuid, \ + \ project_replies_hash bigint NOT NULL, \ + \ document_template_id varchar NOT NULL, \ + \ format_uuid uuid NOT NULL, \ + \ created_by uuid, \ + \ retrieved_at timestamptz, \ + \ finished_at timestamptz, \ + \ created_at timestamptz NOT NULL, \ + \ file_name varchar, \ + \ content_type varchar, \ + \ worker_log varchar, \ + \ tenant_uuid uuid NOT NULL, \ + \ file_size bigint, \ \ CONSTRAINT document_pk PRIMARY KEY (uuid), \ - \ CONSTRAINT document_questionnaire_uuid_fk FOREIGN KEY (questionnaire_uuid) REFERENCES questionnaire (uuid) ON DELETE CASCADE, \ + \ CONSTRAINT document_project_uuid_fk FOREIGN KEY (project_uuid) REFERENCES project (uuid) ON DELETE CASCADE, \ \ CONSTRAINT document_document_template_id_fk FOREIGN KEY (document_template_id, tenant_uuid) REFERENCES document_template (id, tenant_uuid) ON DELETE CASCADE, \ \ CONSTRAINT document_format_uuid_fk FOREIGN KEY (document_template_id, format_uuid, tenant_uuid) REFERENCES document_template_format (document_template_id, uuid, tenant_uuid) ON DELETE CASCADE, \ \ CONSTRAINT document_created_by_fk FOREIGN KEY (created_by) REFERENCES user_entity (uuid) ON DELETE SET NULL, \ diff --git a/wizard-server/src/Wizard/Database/Migration/Development/DocumentTemplate/Data/DocumentTemplateDrafts.hs b/wizard-server/src/Wizard/Database/Migration/Development/DocumentTemplate/Data/DocumentTemplateDrafts.hs index e9a2ca2a0..0aceb1fcc 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/DocumentTemplate/Data/DocumentTemplateDrafts.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/DocumentTemplate/Data/DocumentTemplateDrafts.hs @@ -7,17 +7,17 @@ import Wizard.Api.Resource.DocumentTemplate.Draft.DocumentTemplateDraftChangeDTO import Wizard.Api.Resource.DocumentTemplate.Draft.DocumentTemplateDraftCreateDTO import Wizard.Api.Resource.DocumentTemplate.Draft.DocumentTemplateDraftDataChangeDTO import Wizard.Api.Resource.DocumentTemplate.Draft.DocumentTemplateDraftDataDTO -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires +import Wizard.Database.Migration.Development.Project.Data.Projects import Wizard.Model.DocumentTemplate.DocumentTemplateDraftData -import Wizard.Model.Questionnaire.Questionnaire +import Wizard.Model.Project.Project import Wizard.Service.DocumentTemplate.Draft.DocumentTemplateDraftMapper -import qualified Wizard.Service.Questionnaire.QuestionnaireMapper as QuestionnaireMapper +import qualified Wizard.Service.Project.ProjectMapper as ProjectMapper wizardDocumentTemplateDraftData :: DocumentTemplateDraftData wizardDocumentTemplateDraftData = DocumentTemplateDraftData { documentTemplateId = wizardDocumentTemplateDraft.tId - , questionnaireUuid = Just questionnaire1.uuid + , projectUuid = Just project1.uuid , knowledgeModelEditorUuid = Nothing , formatUuid = Just formatJson.uuid , tenantUuid = wizardDocumentTemplateDraft.tenantUuid @@ -28,7 +28,7 @@ wizardDocumentTemplateDraftData = wizardDocumentTemplateDraftDataEdited :: DocumentTemplateDraftData wizardDocumentTemplateDraftDataEdited = wizardDocumentTemplateDraftData - { questionnaireUuid = Just questionnaire2.uuid + { projectUuid = Just project2.uuid , formatUuid = Just formatPdf.uuid } @@ -47,8 +47,8 @@ wizardDocumentTemplateDraftChangeDTO = toChangeDTO wizardDocumentTemplateDraft wizardDocumentTemplateDraftDataDTO :: DocumentTemplateDraftDataDTO wizardDocumentTemplateDraftDataDTO = DocumentTemplateDraftDataDTO - { questionnaireUuid = wizardDocumentTemplateDraftDataEdited.questionnaireUuid - , questionnaire = Just . QuestionnaireMapper.toSuggestion $ questionnaire2 + { projectUuid = wizardDocumentTemplateDraftDataEdited.projectUuid + , project = Just . ProjectMapper.toSuggestion $ project2 , knowledgeModelEditorUuid = Nothing , knowledgeModelEditor = Nothing , formatUuid = wizardDocumentTemplateDraftDataEdited.formatUuid @@ -57,7 +57,7 @@ wizardDocumentTemplateDraftDataDTO = wizardDocumentTemplateDraftDataChangeDTO :: DocumentTemplateDraftDataChangeDTO wizardDocumentTemplateDraftDataChangeDTO = DocumentTemplateDraftDataChangeDTO - { questionnaireUuid = wizardDocumentTemplateDraftDataEdited.questionnaireUuid + { projectUuid = wizardDocumentTemplateDraftDataEdited.projectUuid , knowledgeModelEditorUuid = Nothing , formatUuid = wizardDocumentTemplateDraftDataEdited.formatUuid } diff --git a/wizard-server/src/Wizard/Database/Migration/Development/DocumentTemplate/Data/DocumentTemplates.hs b/wizard-server/src/Wizard/Database/Migration/Development/DocumentTemplate/Data/DocumentTemplates.hs index eee530fe9..a2800f560 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/DocumentTemplate/Data/DocumentTemplates.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/DocumentTemplate/Data/DocumentTemplates.hs @@ -31,7 +31,7 @@ wizardDocumentTemplateDetailDTO = [commonWizardRegistryTemplate] [globalRegistryOrganization] ["1.0.0"] - (Just "https://registry-test.ds-wizard.org/document-templates/global:questionnaire-report:1.0.0") + (Just "https://registry-test.ds-wizard.org/document-templates/global:project-report:1.0.0") [globalKmPackage, netherlandsKmPackageV2] wizardDocumentTemplateDeprecatedChangeDTO :: DocumentTemplateChangeDTO diff --git a/wizard-server/src/Wizard/Database/Migration/Development/DocumentTemplate/DocumentTemplateSchemaMigration.hs b/wizard-server/src/Wizard/Database/Migration/Development/DocumentTemplate/DocumentTemplateSchemaMigration.hs index 3d9e86c5d..bc44f89a0 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/DocumentTemplate/DocumentTemplateSchemaMigration.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/DocumentTemplate/DocumentTemplateSchemaMigration.hs @@ -32,14 +32,14 @@ dropBucket = do dropFunctions :: AppContextM Int64 dropFunctions = do logInfo _CMP_MIGRATION "(Function/DocumentTemplate) drop functions" - let sql = "DROP FUNCTION IF EXISTS create_persistent_command_from_questionnaire_file_delete;" + let sql = "DROP FUNCTION IF EXISTS create_persistent_command_from_project_file_delete;" let action conn = execute_ conn sql runDB action dropTriggers :: AppContextM Int64 dropTriggers = do logInfo _CMP_MIGRATION "(Trigger/DocumentTemplate) drop tables" - let sql = "DROP TRIGGER IF EXISTS trigger_on_after_questionnaire_file_delete ON questionnaire_file;" + let sql = "DROP TRIGGER IF EXISTS trigger_on_after_document_template_asset_delete ON project_file;" let action conn = execute_ conn sql runDB action @@ -161,7 +161,7 @@ createDraftDataTable = do "CREATE TABLE document_template_draft_data \ \( \ \ document_template_id varchar NOT NULL, \ - \ questionnaire_uuid uuid, \ + \ project_uuid uuid, \ \ format_uuid uuid, \ \ tenant_uuid uuid NOT NULL, \ \ created_at timestamptz NOT NULL, \ @@ -169,7 +169,7 @@ createDraftDataTable = do \ knowledge_model_editor_uuid uuid, \ \ CONSTRAINT document_template_draft_data_pk PRIMARY KEY (document_template_id, tenant_uuid), \ \ CONSTRAINT document_template_draft_data_document_template_id_fk FOREIGN KEY (document_template_id, tenant_uuid) REFERENCES document_template (id, tenant_uuid) ON DELETE CASCADE, \ - \ CONSTRAINT document_template_draft_data_questionnaire_uuid_fk FOREIGN KEY (questionnaire_uuid) REFERENCES questionnaire (uuid) ON DELETE SET NULL, \ + \ CONSTRAINT document_template_draft_data_project_uuid_fk FOREIGN KEY (project_uuid) REFERENCES project (uuid) ON DELETE SET NULL, \ \ CONSTRAINT document_template_draft_data_knowledge_model_editor_uuid_fk FOREIGN KEY (knowledge_model_editor_uuid) REFERENCES knowledge_model_editor (uuid) ON DELETE CASCADE, \ \ CONSTRAINT document_template_draft_data_tenant_uuid_fk FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) ON DELETE CASCADE \ \);" diff --git a/wizard-server/src/Wizard/Database/Migration/Development/KnowledgeModel/Data/Editor/KnowledgeModelEditorActions.hs b/wizard-server/src/Wizard/Database/Migration/Development/KnowledgeModel/Data/Editor/KnowledgeModelEditorActions.hs deleted file mode 100644 index 7a2ab2f53..000000000 --- a/wizard-server/src/Wizard/Database/Migration/Development/KnowledgeModel/Data/Editor/KnowledgeModelEditorActions.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Wizard.Database.Migration.Development.KnowledgeModel.Data.Editor.KnowledgeModelEditorActions where - -import Wizard.Api.Resource.Websocket.KnowledgeModelEditorActionDTO -import Wizard.Database.Migration.Development.KnowledgeModel.Data.Editor.KnowledgeModelEditorEvents -import Wizard.Database.Migration.Development.User.Data.Users - -ensureOnlineUserAction :: ClientKnowledgeModelEditorActionDTO -ensureOnlineUserAction = SetContent_ClientKnowledgeModelEditorActionDTO knowledgeModelEditorWebsocketEvent1' - -setUserListAction :: ServerKnowledgeModelEditorActionDTO -setUserListAction = SetUserList_ServerKnowledgeModelEditorActionDTO [userAlbertOnlineInfo] diff --git a/wizard-server/src/Wizard/Database/Migration/Development/KnowledgeModel/Data/Editor/KnowledgeModelEditorEvents.hs b/wizard-server/src/Wizard/Database/Migration/Development/KnowledgeModel/Data/Editor/KnowledgeModelEditorEvents.hs index 10963dd6f..bc83fd683 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/KnowledgeModel/Data/Editor/KnowledgeModelEditorEvents.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/KnowledgeModel/Data/Editor/KnowledgeModelEditorEvents.hs @@ -4,7 +4,7 @@ import Shared.Common.Util.Uuid import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Event.KnowledgeModelEvents import Wizard.Api.Resource.KnowledgeModel.Editor.Event.KnowledgeModelEditorWebSocketEventDTO import Wizard.Api.Resource.KnowledgeModel.Editor.Event.SetRepliesDTO -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireReplies +import Wizard.Database.Migration.Development.Project.Data.ProjectReplies knowledgeModelEditorWebsocketEvent1' :: KnowledgeModelEditorWebSocketEventDTO knowledgeModelEditorWebsocketEvent1' = AddKnowledgeModelEditorWebSocketEventDTO' knowledgeModelEditorWebsocketEvent1 diff --git a/wizard-server/src/Wizard/Database/Migration/Development/KnowledgeModel/Data/Editor/KnowledgeModelEditorMessages.hs b/wizard-server/src/Wizard/Database/Migration/Development/KnowledgeModel/Data/Editor/KnowledgeModelEditorMessages.hs new file mode 100644 index 000000000..21ae23ac1 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Migration/Development/KnowledgeModel/Data/Editor/KnowledgeModelEditorMessages.hs @@ -0,0 +1,11 @@ +module Wizard.Database.Migration.Development.KnowledgeModel.Data.Editor.KnowledgeModelEditorMessages where + +import Wizard.Api.Resource.Websocket.KnowledgeModelEditorMessageDTO +import Wizard.Database.Migration.Development.KnowledgeModel.Data.Editor.KnowledgeModelEditorEvents +import Wizard.Database.Migration.Development.User.Data.Users + +ensureOnlineUserAction :: ClientKnowledgeModelEditorMessageDTO +ensureOnlineUserAction = SetContent_ClientKnowledgeModelEditorMessageDTO knowledgeModelEditorWebsocketEvent1' + +setUserListAction :: ServerKnowledgeModelEditorMessageDTO +setUserListAction = SetUserList_ServerKnowledgeModelEditorMessageDTO [userAlbertOnlineInfo] diff --git a/wizard-server/src/Wizard/Database/Migration/Development/KnowledgeModel/Data/Editor/KnowledgeModelEditors.hs b/wizard-server/src/Wizard/Database/Migration/Development/KnowledgeModel/Data/Editor/KnowledgeModelEditors.hs index c1d60ad6e..951826e30 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/KnowledgeModel/Data/Editor/KnowledgeModelEditors.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/KnowledgeModel/Data/Editor/KnowledgeModelEditors.hs @@ -26,7 +26,7 @@ import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditorEvent import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditorList import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditorState import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditorSuggestion -import Wizard.Model.Questionnaire.QuestionnaireReply +import Wizard.Model.Project.ProjectReply import Wizard.Model.Tenant.Tenant import Wizard.Model.User.User import Wizard.Service.KnowledgeModel.Compiler.Compiler diff --git a/wizard-server/src/Wizard/Database/Migration/Development/KnowledgeModel/Data/Migration/KnowledgeModelMigrations.hs b/wizard-server/src/Wizard/Database/Migration/Development/KnowledgeModel/Data/Migration/KnowledgeModelMigrations.hs index 22a5c9461..6d785c63d 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/KnowledgeModel/Data/Migration/KnowledgeModelMigrations.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/KnowledgeModel/Data/Migration/KnowledgeModelMigrations.hs @@ -19,8 +19,8 @@ import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditorList import Wizard.Model.KnowledgeModel.Migration.KnowledgeModelMigration import Wizard.Model.Tenant.Tenant -migratorState :: KnowledgeModelMigrationDTO -migratorState = +knowledgeModelMigrationDTO :: KnowledgeModelMigrationDTO +knowledgeModelMigrationDTO = KnowledgeModelMigrationDTO { editorUuid = amsterdamKnowledgeModelEditorList.uuid , editorName = amsterdamKnowledgeModelEditorList.name @@ -30,18 +30,18 @@ migratorState = , currentKnowledgeModel = Just km1Netherlands } -migratorStateCreate :: KnowledgeModelMigrationCreateDTO -migratorStateCreate = KnowledgeModelMigrationCreateDTO {targetPackageId = netherlandsKmPackageV2.pId} +knowledgeModelMigrationCreateDTO :: KnowledgeModelMigrationCreateDTO +knowledgeModelMigrationCreateDTO = KnowledgeModelMigrationCreateDTO {targetPackageId = netherlandsKmPackageV2.pId} -migratorConflict :: KnowledgeModelMigrationResolutionDTO -migratorConflict = +knowledgeModelMigrationResolutionDTO :: KnowledgeModelMigrationResolutionDTO +knowledgeModelMigrationResolutionDTO = KnowledgeModelMigrationResolutionDTO { originalEventUuid = a_km1_ch4.uuid , action = RejectKnowledgeModelMigrationAction } -differentMigratorState :: KnowledgeModelMigration -differentMigratorState = +differentKnowledgeModelMigration :: KnowledgeModelMigration +differentKnowledgeModelMigration = KnowledgeModelMigration { editorUuid = differentKnowledgeModelEditor.uuid , metamodelVersion = knowledgeModelMetamodelVersion diff --git a/wizard-server/src/Wizard/Database/Migration/Development/KnowledgeModel/KnowledgeModelMigrationMigration.hs b/wizard-server/src/Wizard/Database/Migration/Development/KnowledgeModel/KnowledgeModelMigrationMigration.hs index 57bafdd96..7db4bf894 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/KnowledgeModel/KnowledgeModelMigrationMigration.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/KnowledgeModel/KnowledgeModelMigrationMigration.hs @@ -7,6 +7,6 @@ import Wizard.Database.Migration.Development.KnowledgeModel.Data.Migration.Knowl runMigration = do logInfo _CMP_MIGRATION "(Migration/KnowledgeModel) started" - deleteMigratorStates - insertMigratorState differentMigratorState + deleteKnowledgeModelMigrations + insertKnowledgeModelMigration differentKnowledgeModelMigration logInfo _CMP_MIGRATION "(Migration/KnowledgeModel) ended" diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Migration.hs b/wizard-server/src/Wizard/Database/Migration/Development/Migration.hs index 0d5872141..fc74f00f6 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/Migration.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/Migration.hs @@ -24,8 +24,8 @@ import qualified Wizard.Database.Migration.Development.Instance.InstanceSchemaMi import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeModelCacheSchemaMigration as KnowledgeModelCache import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeModelEditorMigration as KnowledgeModelEditor import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeModelEditorSchemaMigration as KnowledgeModelEditor -import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeModelMigrationMigration as KnowledgeModelMigrator -import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeModelMigrationSchemaMigration as KnowledgeModelMigrator +import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeModelMigrationMigration as KnowledgeModelMigration +import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeModelMigrationSchemaMigration as KnowledgeModelMigration import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeModelPackageMigration as KnowledgeModelPackage import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeModelPackageSchemaMigration as KnowledgeModelPackage import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeModelSecretMigration as KnowledgeModelSecret @@ -33,14 +33,14 @@ import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeM import qualified Wizard.Database.Migration.Development.Locale.LocaleMigration as Locale import qualified Wizard.Database.Migration.Development.Locale.LocaleSchemaMigration as Locale import qualified Wizard.Database.Migration.Development.PersistentCommand.PersistentCommandSchemaMigration as PersistentCommand -import qualified Wizard.Database.Migration.Development.Questionnaire.MigratorMigration as QuestionnaireMigrator -import qualified Wizard.Database.Migration.Development.Questionnaire.MigratorSchemaMigration as QuestionnaireMigrator -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as Questionnaire -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireSchemaMigration as Questionnaire -import qualified Wizard.Database.Migration.Development.QuestionnaireAction.QuestionnaireActionMigration as QuestionnaireAction -import qualified Wizard.Database.Migration.Development.QuestionnaireAction.QuestionnaireActionSchemaMigration as QuestionnaireAction -import qualified Wizard.Database.Migration.Development.QuestionnaireImporter.QuestionnaireImporterMigration as QuestionnaireImporter -import qualified Wizard.Database.Migration.Development.QuestionnaireImporter.QuestionnaireImporterSchemaMigration as QuestionnaireImporter +import qualified Wizard.Database.Migration.Development.Project.ProjectActionMigration as ProjectAction +import qualified Wizard.Database.Migration.Development.Project.ProjectActionSchemaMigration as ProjectAction +import qualified Wizard.Database.Migration.Development.Project.ProjectImporterMigration as ProjectImporter +import qualified Wizard.Database.Migration.Development.Project.ProjectImporterSchemaMigration as ProjectImporter +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as Project +import qualified Wizard.Database.Migration.Development.Project.ProjectMigrationMigration as ProjectMigration +import qualified Wizard.Database.Migration.Development.Project.ProjectMigrationSchemaMigration as ProjectMigration +import qualified Wizard.Database.Migration.Development.Project.ProjectSchemaMigration as Project import qualified Wizard.Database.Migration.Development.Registry.RegistryMigration as Registry import qualified Wizard.Database.Migration.Development.Registry.RegistrySchemaMigration as Registry import qualified Wizard.Database.Migration.Development.Submission.SubmissionSchemaMigration as Submission @@ -57,10 +57,10 @@ runMigration = runAppContextWithBaseContext $ do logInfo _CMP_MIGRATION "started" -- 1. Drop DB triggers Document.dropTriggers - Questionnaire.dropTriggers + Project.dropTriggers Locale.dropTriggers -- 2. Drop DB functions - Questionnaire.dropFunctions + Project.dropFunctions DocumentTemplate.dropFunctions KnowledgeModelEditor.dropFunctions KnowledgeModelPackage.dropFunctions @@ -69,20 +69,20 @@ runMigration = runAppContextWithBaseContext $ do ExternalLink.dropTables Component.dropTables Registry.dropTables - QuestionnaireAction.dropTables - QuestionnaireImporter.dropTables + ProjectAction.dropTables + ProjectImporter.dropTables Audit.dropTables Prefab.dropTables PersistentCommand.dropTables Submission.dropTables ActionKey.dropTables Feedback.dropTables - KnowledgeModelMigrator.dropTables + KnowledgeModelMigration.dropTables KnowledgeModelEditor.dropTables KnowledgeModelCache.dropTables Document.dropTables - QuestionnaireMigrator.dropTables - Questionnaire.dropTables + ProjectMigration.dropTables + Project.dropTables KnowledgeModelSecret.dropTables KnowledgeModelPackage.dropTables TemporaryFile.dropTables @@ -110,17 +110,17 @@ runMigration = runAppContextWithBaseContext $ do Feedback.createTables KnowledgeModelEditor.createTables KnowledgeModelCache.createTables - Questionnaire.createTables + Project.createTables DocumentTemplate.createDraftDataTable Document.createTables - QuestionnaireMigrator.createTables - KnowledgeModelMigrator.createTables + ProjectMigration.createTables + KnowledgeModelMigration.createTables Submission.createTables PersistentCommand.createTables Prefab.createTables Audit.createTables - QuestionnaireAction.createTables - QuestionnaireImporter.createTables + ProjectAction.createTables + ProjectImporter.createTables Registry.createTables Component.createTables ExternalLink.createTables @@ -129,12 +129,12 @@ runMigration = runAppContextWithBaseContext $ do KnowledgeModelPackage.createFunctions KnowledgeModelEditor.createFunctions DocumentTemplate.createFunctions - Questionnaire.createFunctions + Project.createFunctions -- 8. Create missing foreign key constraints User.createUserLocaleForeignKeyConstraint -- 9. Create DB triggers Locale.createTriggers - Questionnaire.createTriggers + Project.createTriggers Document.createTriggers -- 10. Load S3 fixtures DocumentTemplate.runS3Migration @@ -147,16 +147,16 @@ runMigration = runAppContextWithBaseContext $ do DocumentTemplate.runMigration ActionKey.runMigration KnowledgeModelEditor.runMigration - Questionnaire.runMigration + Project.runMigration Feedback.runMigration Document.runMigration - QuestionnaireMigrator.runMigration - KnowledgeModelMigrator.runMigration + ProjectMigration.runMigration + KnowledgeModelMigration.runMigration PersistentCommand.runMigration Prefab.runMigration Audit.runMigration - QuestionnaireAction.runMigration - QuestionnaireImporter.runMigration + ProjectAction.runMigration + ProjectImporter.runMigration Registry.runMigration Locale.runMigration Component.runMigration diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectActions.hs b/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectActions.hs new file mode 100644 index 000000000..c4b2b6152 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectActions.hs @@ -0,0 +1,122 @@ +module Wizard.Database.Migration.Development.Project.Data.ProjectActions where + +import qualified Data.Aeson.KeyMap as KM + +import Shared.Common.Constant.Tenant +import Shared.Common.Util.Date +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Api.Resource.Project.Action.ProjectActionDTO +import Wizard.Constant.ProjectAction +import Wizard.Model.Project.Action.ProjectAction +import Wizard.Service.Project.Action.ProjectActionMapper + +projectActionFtp1 :: ProjectAction +projectActionFtp1 = + ProjectAction + { paId = "global:project-action-ftp:1.0.0" + , name = "Project Action FTP" + , organizationId = "global" + , actionId = "project-action-ftp" + , version = "1.0.0" + , metamodelVersion = projectActionMetamodelVersion + , description = "Uploading project to FTP" + , readme = "# Project Action FTP" + , license = "Apache-2.0" + , allowedPackages = [kmPackagePatternAll] + , url = "http://example.com/project-action-ftp" + , config = KM.empty + , enabled = True + , tenantUuid = defaultTenantUuid + , createdAt = dt' 2018 1 21 + , updatedAt = dt' 2018 1 21 + } + +projectActionFtp2 :: ProjectAction +projectActionFtp2 = + ProjectAction + { paId = "global:project-action-ftp:2.0.0" + , name = "Project Action FTP" + , organizationId = "global" + , actionId = "project-action-ftp" + , version = "2.0.0" + , metamodelVersion = projectActionMetamodelVersion + , description = "Uploading project to FTP" + , readme = "# Project Action FTP" + , license = "Apache-2.0" + , allowedPackages = [kmPackagePatternAll] + , url = "http://example.com/project-action-ftp" + , config = KM.empty + , enabled = True + , tenantUuid = defaultTenantUuid + , createdAt = dt' 2018 1 21 + , updatedAt = dt' 2018 1 21 + } + +projectActionFtp3 :: ProjectAction +projectActionFtp3 = + ProjectAction + { paId = "global:project-action-ftp:3.0.0" + , name = "Project Action FTP" + , organizationId = "global" + , actionId = "project-action-ftp" + , version = "3.0.0" + , metamodelVersion = projectActionMetamodelVersion + , description = "Uploading project to FTP" + , readme = "# Project Action FTP" + , license = "Apache-2.0" + , allowedPackages = [kmPackagePatternAll] + , url = "http://example.com/project-action-ftp" + , config = KM.empty + , enabled = False + , tenantUuid = defaultTenantUuid + , createdAt = dt' 2018 1 21 + , updatedAt = dt' 2018 1 21 + } + +projectActionFtp3Edited :: ProjectAction +projectActionFtp3Edited = projectActionFtp3 {enabled = True} + +projectActionFtp3Dto :: ProjectActionDTO +projectActionFtp3Dto = toDTO projectActionFtp3 + +projectActionMail1 :: ProjectAction +projectActionMail1 = + ProjectAction + { paId = "global:project-action-mail:1.0.0" + , name = "Project Action Mail" + , organizationId = "global" + , actionId = "project-action-mail" + , version = "1.0.0" + , metamodelVersion = projectActionMetamodelVersion + , description = "Sending project via mail" + , readme = "# Project Action Mail" + , license = "Apache-2.0" + , allowedPackages = [kmPackagePatternGlobal] + , url = "http://example.com/project-action-mail" + , config = KM.empty + , enabled = True + , tenantUuid = defaultTenantUuid + , createdAt = dt' 2018 1 21 + , updatedAt = dt' 2018 1 21 + } + +projectActionScp1 :: ProjectAction +projectActionScp1 = + ProjectAction + { paId = "global:project-action-onto:1.0.0" + , name = "Project Action SCP" + , organizationId = "global" + , actionId = "project-action-onto" + , version = "1.0.0" + , metamodelVersion = projectActionMetamodelVersion + , description = "Uploading project via SCP" + , readme = "# Project Action SCP" + , license = "Apache-2.0" + , allowedPackages = [kmPackagePatternGlobal] + , url = "http://example.com/project-action-onto" + , config = KM.empty + , enabled = False + , tenantUuid = defaultTenantUuid + , createdAt = dt' 2018 1 21 + , updatedAt = dt' 2018 1 21 + } diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectCommands.hs b/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectCommands.hs new file mode 100644 index 000000000..14cc9c36a --- /dev/null +++ b/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectCommands.hs @@ -0,0 +1,33 @@ +module Wizard.Database.Migration.Development.Project.Data.ProjectCommands where + +import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplates +import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplate +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackage +import Wizard.Database.Migration.Development.User.Data.Users +import Wizard.Model.User.User +import WizardLib.Public.Model.PersistentCommand.Project.CreateProjectCommand + +command1 :: CreateProjectCommand +command1 = + CreateProjectCommand + { name = "Project 1" + , emails = + [ userAlbert.email + , userNikola.email + ] + , knowledgeModelPackageId = netherlandsKmPackageV2.pId + , documentTemplateId = Just wizardDocumentTemplate.tId + } + +command2 :: CreateProjectCommand +command2 = + CreateProjectCommand + { name = "Project 2" + , emails = + [ userAlbert.email + , userIsaac.email + ] + , knowledgeModelPackageId = netherlandsKmPackageV2.pId + , documentTemplateId = Nothing + } diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectComments.hs b/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectComments.hs new file mode 100644 index 000000000..dbea3a899 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectComments.hs @@ -0,0 +1,192 @@ +module Wizard.Database.Migration.Development.Project.Data.ProjectComments where + +import Control.Monad.Reader (liftIO) +import qualified Data.Map.Strict as M +import Data.Maybe (fromJust) +import Data.Time +import qualified Data.UUID as U + +import Shared.Common.Constant.Tenant +import Shared.Common.Util.Date +import Shared.Common.Util.Uuid +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Chapters +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Questions +import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel +import Wizard.Database.Migration.Development.User.Data.Users +import Wizard.Model.Project.Comment.ProjectComment +import Wizard.Model.Project.Comment.ProjectCommentList +import Wizard.Model.Project.Comment.ProjectCommentThreadAssigned +import Wizard.Model.Project.ProjectUtil +import Wizard.Model.User.User +import Wizard.Service.Project.Comment.ProjectCommentMapper +import Wizard.Service.User.UserMapper + +projectCommentThreadsList :: M.Map String [ProjectCommentThreadList] +projectCommentThreadsList = M.fromList [(cmtQ1_path, [cmtQ1_t1Dto]), (cmtQ2_path, [cmtQ2_t1Dto])] + +cmtQ1_path :: String +cmtQ1_path = createReplyKey [chapter1.uuid, question1.uuid] + +cmtQ1_t1 :: ProjectCommentThread +cmtQ1_t1 = + ProjectCommentThread + { uuid = u' "f1de85a9-7f22-4d0c-bc23-3315cc4c85d7" + , path = cmtQ1_path + , resolved = False + , comments = [cmtQ1_t1_1, cmtQ1_t1_2] + , private = False + , projectUuid = u' "af984a75-56e3-49f8-b16f-d6b99599910a" + , tenantUuid = defaultTenantUuid + , assignedTo = Nothing + , assignedBy = Nothing + , notificationRequired = False + , createdBy = Just userAlbert.uuid + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 + , updatedAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 + } + +create_cmtQ1_t1 :: U.UUID -> IO ProjectCommentThread +create_cmtQ1_t1 projectUuid = do + threadUuid <- liftIO generateUuid + return $ + ProjectCommentThread + { uuid = threadUuid + , path = cmtQ1_path + , resolved = False + , comments = [] + , private = False + , projectUuid = projectUuid + , tenantUuid = defaultTenantUuid + , assignedTo = Nothing + , assignedBy = Nothing + , notificationRequired = False + , createdBy = Just userAlbert.uuid + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 + , updatedAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 + } + +cmtQ1_t1Dto :: ProjectCommentThreadList +cmtQ1_t1Dto = toCommentThreadList cmtQ1_t1 Nothing (Just userAlbert) [cmtQ1_t1_1Dto, cmtQ1_t1_2Dto] + +cmtQ1_t1WithEditedCmt :: ProjectCommentThread +cmtQ1_t1WithEditedCmt = cmtQ1_t1 {comments = [cmtQ1_t1_1Edited, cmtQ1_t1_2]} + +cmtQ1_t1WithDeletedCmt :: ProjectCommentThread +cmtQ1_t1WithDeletedCmt = cmtQ1_t1 {comments = [cmtQ1_t1_2]} + +cmtQ1_t1Resolved :: ProjectCommentThread +cmtQ1_t1Resolved = cmtQ1_t1 {resolved = True} + +cmtQ1_t1_1 :: ProjectComment +cmtQ1_t1_1 = + ProjectComment + { uuid = u' "a2d4a1f6-6148-43a0-98d1-158176863a3c" + , text = "1st comment to 1st question" + , threadUuid = cmtQ1_t1.uuid + , tenantUuid = defaultTenantUuid + , createdBy = Just userAlbert.uuid + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 + , updatedAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 + } + +create_cmtQ1_t1_1 :: U.UUID -> IO ProjectComment +create_cmtQ1_t1_1 threadUuid = do + commentUuid <- liftIO generateUuid + return $ + ProjectComment + { uuid = commentUuid + , text = "1st comment to 1st question" + , threadUuid = threadUuid + , tenantUuid = defaultTenantUuid + , createdBy = Just userAlbert.uuid + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 + , updatedAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 + } + +cmtQ1_t1_1Dto :: ProjectCommentList +cmtQ1_t1_1Dto = toCommentList cmtQ1_t1_1 (Just userAlbert) + +cmtQ1_t1_1Edited :: ProjectComment +cmtQ1_t1_1Edited = cmtQ1_t1_1 {text = "EDITED: 1st comment to 1st question"} + +cmtQ1_t1_2 :: ProjectComment +cmtQ1_t1_2 = + ProjectComment + { uuid = u' "a9861528-7ca9-48d8-917c-3bf9f240bdf3" + , text = "2nd comment to 1st question" + , threadUuid = cmtQ1_t1.uuid + , tenantUuid = defaultTenantUuid + , createdBy = Just userAlbert.uuid + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 + , updatedAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 + } + +create_cmtQ1_t1_2 :: U.UUID -> IO ProjectComment +create_cmtQ1_t1_2 threadUuid = do + commentUuid <- liftIO generateUuid + return $ + ProjectComment + { uuid = commentUuid + , text = "2nd comment to 1st question" + , threadUuid = threadUuid + , tenantUuid = defaultTenantUuid + , createdBy = Just userAlbert.uuid + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 + , updatedAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 + } + +cmtQ1_t1_2Dto :: ProjectCommentList +cmtQ1_t1_2Dto = toCommentList cmtQ1_t1_2 (Just userAlbert) + +cmtQ2_path :: String +cmtQ2_path = createReplyKey [chapter1.uuid, question2.uuid] + +cmtQ2_t1 :: ProjectCommentThread +cmtQ2_t1 = + ProjectCommentThread + { uuid = u' "2b8681dc-54b5-4bc4-bf9f-a1ec6ad37823" + , path = cmtQ2_path + , resolved = False + , comments = [cmtQ2_t1_1] + , private = False + , projectUuid = u' "af984a75-56e3-49f8-b16f-d6b99599910a" + , tenantUuid = defaultTenantUuid + , assignedTo = Nothing + , assignedBy = Nothing + , notificationRequired = False + , createdBy = Just userAlbert.uuid + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 + , updatedAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 + } + +cmtQ2_t1Dto :: ProjectCommentThreadList +cmtQ2_t1Dto = toCommentThreadList cmtQ2_t1 Nothing (Just userAlbert) [cmtQ2_t1_1Dto] + +cmtQ2_t1_1 :: ProjectComment +cmtQ2_t1_1 = + ProjectComment + { uuid = u' "e9827a92-ecfd-4410-8809-ea761fe03bd3" + , text = "1nd comment to 2st question" + , threadUuid = cmtQ2_t1.uuid + , tenantUuid = defaultTenantUuid + , createdBy = Just userAlbert.uuid + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 + , updatedAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 + } + +cmtQ2_t1_1Dto :: ProjectCommentList +cmtQ2_t1_1Dto = toCommentList cmtQ2_t1_1 (Just userAlbert) + +cmtAssigned :: ProjectCommentThreadAssigned +cmtAssigned = + ProjectCommentThreadAssigned + { projectUuid = u' "af984a75-56e3-49f8-b16f-d6b99599910a" + , projectName = "My Private Project" + , commentThreadUuid = cmtQ1_t1.uuid + , path = cmtQ1_t1.path + , resolved = cmtQ1_t1.resolved + , private = cmtQ1_t1.private + , text = cmtQ1_t1_1.text + , createdBy = Just . toSuggestion . toSimple $ userAlbert + , updatedAt = dt' 2018 1 21 + } diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectEvents.hs b/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectEvents.hs new file mode 100644 index 000000000..a1a3edd28 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectEvents.hs @@ -0,0 +1,606 @@ +module Wizard.Database.Migration.Development.Project.Data.ProjectEvents where + +import qualified Data.List as L +import Data.Maybe (fromJust) +import Data.Time +import qualified Data.UUID as U + +import Shared.Common.Constant.Tenant +import Shared.Common.Util.String +import Shared.Common.Util.Uuid +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Phases +import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel +import Wizard.Api.Resource.Project.Event.ProjectEventChangeDTO +import Wizard.Api.Resource.Project.Event.ProjectEventDTO +import Wizard.Database.Migration.Development.Project.Data.ProjectComments +import Wizard.Database.Migration.Development.Project.Data.ProjectLabels +import Wizard.Database.Migration.Development.Project.Data.ProjectReplies +import Wizard.Database.Migration.Development.User.Data.Users +import Wizard.Model.Project.Comment.ProjectComment +import Wizard.Model.Project.Event.ProjectEvent +import Wizard.Model.Project.Event.ProjectEventList +import Wizard.Model.Project.ProjectReply +import Wizard.Model.User.User +import Wizard.Service.Project.Event.ProjectEventMapper +import Wizard.Service.User.UserMapper +import WizardLib.Public.Model.User.UserSuggestion + +fEvents :: U.UUID -> [ProjectEvent] +fEvents projectUuid = + [ sre_rQ1' projectUuid + , sre_rQ2' projectUuid + , sre_rQ2_aYes_fuQ1' projectUuid + , sre_rQ3' projectUuid + , sre_rQ4' projectUuid + , sre_rQ4_it1_q5' projectUuid + , sre_rQ4_it1_q5_it1_question7' projectUuid + , sre_rQ4_it1_q5_it1_question8' projectUuid + , sre_rQ4_it1_q6' projectUuid + , sre_rQ4_it2_q5' projectUuid + , sre_rQ4_it2_q6' projectUuid + , sre_rQ9' projectUuid + , sre_rQ10' projectUuid + , sre_rQ11' projectUuid + , sphse_1' projectUuid + , slble_rQ1' projectUuid + ] + +fEventsDto :: U.UUID -> [ProjectEventDTO] +fEventsDto projectUuid = fmap (\event -> toEventDTO event (Just userAlbert)) (fEvents projectUuid) + +fEventsList :: U.UUID -> [ProjectEventList] +fEventsList projectUuid = fmap (\event -> toEventList event (Just userAlbert)) (fEvents projectUuid) + +fEventsWithUpdated :: U.UUID -> [ProjectEvent] +fEventsWithUpdated projectUuid = fEvents projectUuid ++ [sre_rQ1Updated' projectUuid] + +fEventsWithDeleted :: U.UUID -> [ProjectEvent] +fEventsWithDeleted projectUuid = fEvents projectUuid ++ [cre_rQ1' projectUuid] + +fEventsEdited :: U.UUID -> [ProjectEvent] +fEventsEdited projectUuid = fEvents projectUuid ++ [slble_rQ2' projectUuid] + +sre_rQ1' :: U.UUID -> ProjectEvent +sre_rQ1' = SetReplyEvent' . sre_rQ1 + +sre_rQ1 :: U.UUID -> SetReplyEvent +sre_rQ1 projectUuid = + SetReplyEvent + { uuid = createEventUuid projectUuid "12bc42247314" + , path = fst rQ1 + , value = (snd rQ1).value + , projectUuid = projectUuid + , tenantUuid = defaultTenantUuid + , createdBy = fmap (.uuid) $ (snd rQ1).createdBy + , createdAt = (snd rQ1).createdAt + } + +sre_rQ1Updated' :: U.UUID -> ProjectEvent +sre_rQ1Updated' = SetReplyEvent' . sre_rQ1Updated + +sre_rQ1Updated :: U.UUID -> SetReplyEvent +sre_rQ1Updated projectUuid = + SetReplyEvent + { uuid = createEventUuid projectUuid "ede0aa4d6c5a" + , path = fst rQ1Updated + , value = (snd rQ1Updated).value + , projectUuid = projectUuid + , tenantUuid = defaultTenantUuid + , createdBy = fmap (.uuid) $ (snd rQ1Updated).createdBy + , createdAt = (snd rQ1Updated).createdAt + } + +sre_rQ1Dto' :: U.UUID -> ProjectEventDTO +sre_rQ1Dto' projectUuid = toEventDTO (sre_rQ1' projectUuid) (Just userAlbert) + +sre_rQ2' :: U.UUID -> ProjectEvent +sre_rQ2' = SetReplyEvent' . sre_rQ2 + +sre_rQ2 :: U.UUID -> SetReplyEvent +sre_rQ2 projectUuid = + SetReplyEvent + { uuid = createEventUuid projectUuid "5dc60233046e" + , path = fst rQ2 + , value = (snd rQ2).value + , projectUuid = projectUuid + , tenantUuid = defaultTenantUuid + , createdBy = fmap (.uuid) $ (snd rQ2).createdBy + , createdAt = (snd rQ2).createdAt + } + +sre_rQ2_aYes_fuQ1' :: U.UUID -> ProjectEvent +sre_rQ2_aYes_fuQ1' = SetReplyEvent' . sre_rQ2_aYes_fuQ1 + +sre_rQ2_aYes_fuQ1 :: U.UUID -> SetReplyEvent +sre_rQ2_aYes_fuQ1 projectUuid = + SetReplyEvent + { uuid = createEventUuid projectUuid "c4db3ec5fadd" + , path = fst rQ2_aYes_fuQ1 + , value = (snd rQ2_aYes_fuQ1).value + , projectUuid = projectUuid + , tenantUuid = defaultTenantUuid + , createdBy = fmap (.uuid) $ (snd rQ2_aYes_fuQ1).createdBy + , createdAt = (snd rQ2_aYes_fuQ1).createdAt + } + +sre_rQ3' :: U.UUID -> ProjectEvent +sre_rQ3' = SetReplyEvent' . sre_rQ3 + +sre_rQ3 :: U.UUID -> SetReplyEvent +sre_rQ3 projectUuid = + SetReplyEvent + { uuid = createEventUuid projectUuid "cf42760517d7" + , path = fst rQ3 + , value = (snd rQ3).value + , projectUuid = projectUuid + , tenantUuid = defaultTenantUuid + , createdBy = fmap (.uuid) $ (snd rQ3).createdBy + , createdAt = (snd rQ3).createdAt + } + +sre_rQ4' :: U.UUID -> ProjectEvent +sre_rQ4' = SetReplyEvent' . sre_rQ4 + +sre_rQ4 :: U.UUID -> SetReplyEvent +sre_rQ4 projectUuid = + SetReplyEvent + { uuid = createEventUuid projectUuid "52d6816a471c" + , path = fst rQ4 + , value = (snd rQ4).value + , projectUuid = projectUuid + , tenantUuid = defaultTenantUuid + , createdBy = fmap (.uuid) $ (snd rQ4).createdBy + , createdAt = (snd rQ4).createdAt + } + +sre_rQ4_it1_q5' :: U.UUID -> ProjectEvent +sre_rQ4_it1_q5' = SetReplyEvent' . sre_rQ4_it1_q5 + +sre_rQ4_it1_q5 :: U.UUID -> SetReplyEvent +sre_rQ4_it1_q5 projectUuid = + SetReplyEvent + { uuid = createEventUuid projectUuid "51954a9feb0b" + , path = fst rQ4_it1_q5 + , value = (snd rQ4_it1_q5).value + , projectUuid = projectUuid + , tenantUuid = defaultTenantUuid + , createdBy = fmap (.uuid) $ (snd rQ4_it1_q5).createdBy + , createdAt = (snd rQ4_it1_q5).createdAt + } + +sre_rQ4_it1_q5_it1_question7' :: U.UUID -> ProjectEvent +sre_rQ4_it1_q5_it1_question7' = SetReplyEvent' . sre_rQ4_it1_q5_it1_question7 + +sre_rQ4_it1_q5_it1_question7 :: U.UUID -> SetReplyEvent +sre_rQ4_it1_q5_it1_question7 projectUuid = + SetReplyEvent + { uuid = createEventUuid projectUuid "7927b71393bc" + , path = fst rQ4_it1_q5_it1_question7 + , value = (snd rQ4_it1_q5_it1_question7).value + , projectUuid = projectUuid + , tenantUuid = defaultTenantUuid + , createdBy = fmap (.uuid) $ (snd rQ4_it1_q5_it1_question7).createdBy + , createdAt = (snd rQ4_it1_q5_it1_question7).createdAt + } + +sre_rQ4_it1_q5_it1_question8' :: U.UUID -> ProjectEvent +sre_rQ4_it1_q5_it1_question8' = SetReplyEvent' . sre_rQ4_it1_q5_it1_question8 + +sre_rQ4_it1_q5_it1_question8 :: U.UUID -> SetReplyEvent +sre_rQ4_it1_q5_it1_question8 projectUuid = + SetReplyEvent + { uuid = createEventUuid projectUuid "a8b3312ce8be" + , path = fst rQ4_it1_q5_it1_question8 + , value = (snd rQ4_it1_q5_it1_question8).value + , projectUuid = projectUuid + , tenantUuid = defaultTenantUuid + , createdBy = fmap (.uuid) $ (snd rQ4_it1_q5_it1_question8).createdBy + , createdAt = (snd rQ4_it1_q5_it1_question8).createdAt + } + +sre_rQ4_it1_q6' :: U.UUID -> ProjectEvent +sre_rQ4_it1_q6' = SetReplyEvent' . sre_rQ4_it1_q6 + +sre_rQ4_it1_q6 :: U.UUID -> SetReplyEvent +sre_rQ4_it1_q6 projectUuid = + SetReplyEvent + { uuid = createEventUuid projectUuid "d270a461c2bb" + , path = fst rQ4_it1_q6 + , value = (snd rQ4_it1_q6).value + , projectUuid = projectUuid + , tenantUuid = defaultTenantUuid + , createdBy = fmap (.uuid) $ (snd rQ4_it1_q6).createdBy + , createdAt = (snd rQ4_it1_q6).createdAt + } + +sre_rQ4_it2_q5' :: U.UUID -> ProjectEvent +sre_rQ4_it2_q5' = SetReplyEvent' . sre_rQ4_it2_q5 + +sre_rQ4_it2_q5 :: U.UUID -> SetReplyEvent +sre_rQ4_it2_q5 projectUuid = + SetReplyEvent + { uuid = createEventUuid projectUuid "e30b5086cea2" + , path = fst rQ4_it2_q5 + , value = (snd rQ4_it2_q5).value + , projectUuid = projectUuid + , tenantUuid = defaultTenantUuid + , createdBy = fmap (.uuid) $ (snd rQ4_it2_q5).createdBy + , createdAt = (snd rQ4_it2_q5).createdAt + } + +sre_rQ4_it2_q6' :: U.UUID -> ProjectEvent +sre_rQ4_it2_q6' = SetReplyEvent' . sre_rQ4_it2_q6 + +sre_rQ4_it2_q6 :: U.UUID -> SetReplyEvent +sre_rQ4_it2_q6 projectUuid = + SetReplyEvent + { uuid = createEventUuid projectUuid "8a83232defb2" + , path = fst rQ4_it2_q6 + , value = (snd rQ4_it2_q6).value + , projectUuid = projectUuid + , tenantUuid = defaultTenantUuid + , createdBy = fmap (.uuid) $ (snd rQ4_it2_q6).createdBy + , createdAt = (snd rQ4_it2_q6).createdAt + } + +sre_rQ9' :: U.UUID -> ProjectEvent +sre_rQ9' = SetReplyEvent' . sre_rQ9 + +sre_rQ9 :: U.UUID -> SetReplyEvent +sre_rQ9 projectUuid = + SetReplyEvent + { uuid = createEventUuid projectUuid "064a51dfe89a" + , path = fst rQ9 + , value = (snd rQ9).value + , projectUuid = projectUuid + , tenantUuid = defaultTenantUuid + , createdBy = fmap (.uuid) $ (snd rQ9).createdBy + , createdAt = (snd rQ9).createdAt + } + +sre_rQ10' :: U.UUID -> ProjectEvent +sre_rQ10' = SetReplyEvent' . sre_rQ10 + +sre_rQ10 :: U.UUID -> SetReplyEvent +sre_rQ10 projectUuid = + SetReplyEvent + { uuid = createEventUuid projectUuid "40df71a81b92" + , path = fst rQ10 + , value = (snd rQ10).value + , projectUuid = projectUuid + , tenantUuid = defaultTenantUuid + , createdBy = fmap (.uuid) $ (snd rQ10).createdBy + , createdAt = (snd rQ10).createdAt + } + +sre_rQ11' :: U.UUID -> ProjectEvent +sre_rQ11' = SetReplyEvent' . sre_rQ11 + +sre_rQ11 :: U.UUID -> SetReplyEvent +sre_rQ11 projectUuid = + SetReplyEvent + { uuid = createEventUuid projectUuid "c4f4481d5670" + , path = fst rQ11 + , value = (snd rQ11).value + , projectUuid = projectUuid + , tenantUuid = defaultTenantUuid + , createdBy = fmap (.uuid) $ (snd rQ11).createdBy + , createdAt = (snd rQ11).createdAt + } + +cre_rQ1' :: U.UUID -> ProjectEvent +cre_rQ1' = ClearReplyEvent' . cre_rQ1 + +cre_rQ1 :: U.UUID -> ClearReplyEvent +cre_rQ1 projectUuid = + ClearReplyEvent + { uuid = createEventUuid projectUuid "c513e14de55e" + , path = fst rQ1 + , projectUuid = projectUuid + , tenantUuid = defaultTenantUuid + , createdBy = Just userAlbert.uuid + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 17 + } + +sphse_1' :: U.UUID -> ProjectEvent +sphse_1' = SetPhaseEvent' . sphse_1 + +sphse_1 :: U.UUID -> SetPhaseEvent +sphse_1 projectUuid = + SetPhaseEvent + { uuid = createEventUuid projectUuid "ee411f0005d3" + , phaseUuid = Just $ phase1.uuid + , projectUuid = projectUuid + , tenantUuid = defaultTenantUuid + , createdBy = Just userAlbert.uuid + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 18 + } + +sphse_2' :: U.UUID -> ProjectEvent +sphse_2' = SetPhaseEvent' . sphse_2 + +sphse_2 :: U.UUID -> SetPhaseEvent +sphse_2 projectUuid = + SetPhaseEvent + { uuid = createEventUuid projectUuid "43eae0986894" + , phaseUuid = Just $ phase2.uuid + , projectUuid = projectUuid + , tenantUuid = defaultTenantUuid + , createdBy = Just userAlbert.uuid + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 19 + } + +sphse_3' :: U.UUID -> ProjectEvent +sphse_3' = SetPhaseEvent' . sphse_3 + +sphse_3 :: U.UUID -> SetPhaseEvent +sphse_3 projectUuid = + SetPhaseEvent + { uuid = createEventUuid projectUuid "dacc8f77de05" + , phaseUuid = Just $ phase3.uuid + , projectUuid = projectUuid + , tenantUuid = defaultTenantUuid + , createdBy = Just userAlbert.uuid + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 20 + } + +slble_rQ1' :: U.UUID -> ProjectEvent +slble_rQ1' = SetLabelsEvent' . slble_rQ1 + +slble_rQ1 :: U.UUID -> SetLabelsEvent +slble_rQ1 projectUuid = + SetLabelsEvent + { uuid = createEventUuid projectUuid "dd016270ce7e" + , path = fst rQ1 + , value = [fLabel1] + , projectUuid = projectUuid + , tenantUuid = defaultTenantUuid + , createdBy = Just userAlbert.uuid + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 21 + } + +slble_rQ2' :: U.UUID -> ProjectEvent +slble_rQ2' = SetLabelsEvent' . slble_rQ2 + +slble_rQ2 :: U.UUID -> SetLabelsEvent +slble_rQ2 projectUuid = + SetLabelsEvent + { uuid = createEventUuid projectUuid "e2acc52bf8db" + , path = fst rQ2 + , value = [fLabel1] + , projectUuid = projectUuid + , tenantUuid = defaultTenantUuid + , createdBy = Just userAlbert.uuid + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 22 + } + +rte_rQ1_t1' :: ProjectEventDTO +rte_rQ1_t1' = ResolveCommentThreadEventDTO' rte_rQ1_t1 + +rte_rQ1_t1 :: ResolveCommentThreadEventDTO +rte_rQ1_t1 = + ResolveCommentThreadEventDTO + { uuid = u' "ad5ffe15-d895-4452-af31-3b952db0b8a8" + , path = cmtQ1_path + , threadUuid = cmtQ1_t1.uuid + , commentCount = 1 + , createdBy = Just . toSuggestion . toSimple $ userAlbert + , createdAt = cmtQ1_t1Resolved.createdAt + } + +rtche_rQ1_t1' :: ProjectEventChangeDTO +rtche_rQ1_t1' = ResolveCommentThreadEventChangeDTO' rtche_rQ1_t1 + +rtche_rQ1_t1 :: ResolveCommentThreadEventChangeDTO +rtche_rQ1_t1 = + ResolveCommentThreadEventChangeDTO + { uuid = rte_rQ1_t1.uuid + , path = rte_rQ1_t1.path + , threadUuid = rte_rQ1_t1.threadUuid + , private = False + , commentCount = 1 + } + +ote_rQ1_t1' :: ProjectEventDTO +ote_rQ1_t1' = ReopenCommentThreadEventDTO' ote_rQ1_t1 + +ote_rQ1_t1 :: ReopenCommentThreadEventDTO +ote_rQ1_t1 = + ReopenCommentThreadEventDTO + { uuid = u' "444c89c8-ead9-44c7-9621-0c0c43ff5f9f" + , path = cmtQ1_path + , threadUuid = cmtQ1_t1.uuid + , commentCount = 1 + , createdBy = Just . toSuggestion . toSimple $ userAlbert + , createdAt = cmtQ1_t1.createdAt + } + +otche_rQ1_t1' :: ProjectEventChangeDTO +otche_rQ1_t1' = ReopenCommentThreadEventChangeDTO' otche_rQ1_t1 + +otche_rQ1_t1 :: ReopenCommentThreadEventChangeDTO +otche_rQ1_t1 = + ReopenCommentThreadEventChangeDTO + { uuid = ote_rQ1_t1.uuid + , path = ote_rQ1_t1.path + , threadUuid = ote_rQ1_t1.threadUuid + , commentCount = 1 + , private = False + } + +aste_rQ1_t1' :: ProjectEventDTO +aste_rQ1_t1' = AssignCommentThreadEventDTO' aste_rQ1_t1 + +aste_rQ1_t1 :: AssignCommentThreadEventDTO +aste_rQ1_t1 = + AssignCommentThreadEventDTO + { uuid = u' "444c89c8-ead9-44c7-9621-0c0c43ff5f9f" + , path = cmtQ1_path + , threadUuid = cmtQ1_t1.uuid + , private = False + , assignedTo = Just . toSuggestion . toSimple $ userAlbert + , createdBy = Just . toSuggestion . toSimple $ userAlbert + , createdAt = cmtQ1_t1.createdAt + } + +asche_rQ1_t1' :: ProjectEventChangeDTO +asche_rQ1_t1' = AssignCommentThreadEventChangeDTO' asche_rQ1_t1 + +asche_rQ1_t1 :: AssignCommentThreadEventChangeDTO +asche_rQ1_t1 = + AssignCommentThreadEventChangeDTO + { uuid = aste_rQ1_t1.uuid + , path = aste_rQ1_t1.path + , threadUuid = aste_rQ1_t1.threadUuid + , private = aste_rQ1_t1.private + , assignedTo = aste_rQ1_t1.assignedTo + } + +dte_rQ1_t1' :: ProjectEventDTO +dte_rQ1_t1' = DeleteCommentThreadEventDTO' dte_rQ1_t1 + +dte_rQ1_t1 :: DeleteCommentThreadEventDTO +dte_rQ1_t1 = + DeleteCommentThreadEventDTO + { uuid = u' "0e8a5812-90da-43b1-bb20-dbf8a95aa00d" + , path = cmtQ1_path + , threadUuid = cmtQ1_t1.uuid + , createdBy = Just . toSuggestion . toSimple $ userAlbert + , createdAt = cmtQ1_t1.createdAt + } + +dtche_rQ1_t1' :: ProjectEventChangeDTO +dtche_rQ1_t1' = DeleteCommentThreadEventChangeDTO' dtche_rQ1_t1 + +dtche_rQ1_t1 :: DeleteCommentThreadEventChangeDTO +dtche_rQ1_t1 = + DeleteCommentThreadEventChangeDTO + { uuid = dte_rQ1_t1.uuid + , path = dte_rQ1_t1.path + , threadUuid = dte_rQ1_t1.threadUuid + , private = False + } + +ace_rQ1_t1_1' :: ProjectEventDTO +ace_rQ1_t1_1' = AddCommentEventDTO' ace_rQ1_t1_1 + +ace_rQ1_t1_1 :: AddCommentEventDTO +ace_rQ1_t1_1 = + AddCommentEventDTO + { uuid = u' "471ef7d8-5164-44ba-9d28-8aad036458fd" + , path = cmtQ1_path + , threadUuid = cmtQ1_t1.uuid + , commentUuid = cmtQ1_t1_1.uuid + , text = cmtQ1_t1_1.text + , private = cmtQ1_t1.private + , createdBy = Just . toSuggestion . toSimple $ userAlbert + , createdAt = cmtQ1_t1_1.createdAt + } + +ace_rQ1_t1_2' :: ProjectEventDTO +ace_rQ1_t1_2' = AddCommentEventDTO' ace_rQ1_t1_2 + +ace_rQ1_t1_2 :: AddCommentEventDTO +ace_rQ1_t1_2 = + AddCommentEventDTO + { uuid = u' "3450c5ca-a267-4be0-b112-92f5c0d2e2a8" + , path = cmtQ1_path + , threadUuid = cmtQ1_t1.uuid + , commentUuid = cmtQ1_t1_2.uuid + , text = cmtQ1_t1_2.text + , private = cmtQ1_t1.private + , createdBy = Just . toSuggestion . toSimple $ userAlbert + , createdAt = cmtQ1_t1_2.createdAt + } + +ace_rQ2_t1_1' :: ProjectEventDTO +ace_rQ2_t1_1' = AddCommentEventDTO' ace_rQ2_t1_1 + +ace_rQ2_t1_1 :: AddCommentEventDTO +ace_rQ2_t1_1 = + AddCommentEventDTO + { uuid = u' "b46c4ff7-8af2-4164-8e94-841b4f8c312b" + , path = cmtQ2_path + , threadUuid = cmtQ2_t1.uuid + , commentUuid = cmtQ2_t1_1.uuid + , text = cmtQ2_t1_1.text + , private = cmtQ2_t1.private + , createdBy = Just . toSuggestion . toSimple $ userAlbert + , createdAt = cmtQ2_t1_1.createdAt + } + +acche_rQ2_t1_1' :: ProjectEventChangeDTO +acche_rQ2_t1_1' = AddCommentEventChangeDTO' acche_rQ2_t1_1 + +acche_rQ2_t1_1 :: AddCommentEventChangeDTO +acche_rQ2_t1_1 = + AddCommentEventChangeDTO + { uuid = ace_rQ2_t1_1.uuid + , path = ace_rQ2_t1_1.path + , threadUuid = ace_rQ2_t1_1.threadUuid + , commentUuid = ace_rQ2_t1_1.commentUuid + , text = ace_rQ2_t1_1.text + , private = False + , newThread = True + } + +ece_rQ1_t1_1' :: ProjectEventDTO +ece_rQ1_t1_1' = EditCommentEventDTO' ece_rQ1_t1_1 + +ece_rQ1_t1_1 :: EditCommentEventDTO +ece_rQ1_t1_1 = + EditCommentEventDTO + { uuid = u' "6a598663-4bce-48e9-83d0-422ae753f60d" + , path = cmtQ1_path + , threadUuid = cmtQ1_t1.uuid + , commentUuid = cmtQ1_t1_1Edited.uuid + , text = cmtQ1_t1_1Edited.text + , createdBy = Just . toSuggestion . toSimple $ userAlbert + , createdAt = cmtQ1_t1_1Edited.updatedAt + } + +ecche_rQ1_t1_1' :: ProjectEventChangeDTO +ecche_rQ1_t1_1' = EditCommentEventChangeDTO' ecche_rQ1_t1_1 + +ecche_rQ1_t1_1 :: EditCommentEventChangeDTO +ecche_rQ1_t1_1 = + EditCommentEventChangeDTO + { uuid = ece_rQ1_t1_1.uuid + , path = ece_rQ1_t1_1.path + , threadUuid = ece_rQ1_t1_1.threadUuid + , commentUuid = ece_rQ1_t1_1.commentUuid + , text = ece_rQ1_t1_1.text + , private = False + } + +dce_rQ1_t1_1' :: ProjectEventDTO +dce_rQ1_t1_1' = DeleteCommentEventDTO' dce_rQ1_t1_1 + +dce_rQ1_t1_1 :: DeleteCommentEventDTO +dce_rQ1_t1_1 = + DeleteCommentEventDTO + { uuid = u' "0e8a5812-90da-43b1-bb20-dbf8a95aa00d" + , path = cmtQ1_path + , threadUuid = cmtQ1_t1.uuid + , commentUuid = cmtQ1_t1_1.uuid + , createdBy = Just . toSuggestion . toSimple $ userAlbert + , createdAt = cmtQ1_t1_1.createdAt + } + +dcche_rQ1_t1_1' :: ProjectEventChangeDTO +dcche_rQ1_t1_1' = DeleteCommentEventChangeDTO' dcche_rQ1_t1_1 + +dcche_rQ1_t1_1 :: DeleteCommentEventChangeDTO +dcche_rQ1_t1_1 = + DeleteCommentEventChangeDTO + { uuid = dce_rQ1_t1_1.uuid + , path = dce_rQ1_t1_1.path + , threadUuid = dce_rQ1_t1_1.threadUuid + , commentUuid = dce_rQ1_t1_1.commentUuid + , private = False + } + +createEventUuid :: U.UUID -> String -> U.UUID +createEventUuid projectUuid eventSuffix = + let parts = splitOn "-" . U.toString $ projectUuid + in u' . L.intercalate "-" $ [head parts, parts !! 1, parts !! 2, parts !! 3, eventSuffix] diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectFiles.hs b/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectFiles.hs new file mode 100644 index 000000000..8fc99f83f --- /dev/null +++ b/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectFiles.hs @@ -0,0 +1,33 @@ +module Wizard.Database.Migration.Development.Project.Data.ProjectFiles where + +import Shared.Common.Util.Date +import Shared.Common.Util.Uuid +import Wizard.Database.Migration.Development.User.Data.Users +import Wizard.Model.Project.File.ProjectFileList +import Wizard.Model.Project.File.ProjectFileSimple +import Wizard.Model.Project.ProjectSimple + +projectFileList :: ProjectFileList +projectFileList = + ProjectFileList + { uuid = u' "e3726571-f81e-4e34-a17a-2f5714b7aade" + , fileName = "my_file.txt" + , contentType = "application/json" + , fileSize = 123456 + , project = + ProjectSimple + { uuid = u' "af984a75-56e3-49f8-b16f-d6b99599910a" + , name = "My Private Project" + } + , createdBy = Just userAlbertSuggestion + , createdAt = dt' 2018 01 21 + } + +projectFileSimple :: ProjectFileSimple +projectFileSimple = + ProjectFileSimple + { uuid = projectFileList.uuid + , fileName = projectFileList.fileName + , contentType = projectFileList.contentType + , fileSize = projectFileList.fileSize + } diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectImporters.hs b/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectImporters.hs new file mode 100644 index 000000000..3bd6e1a46 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectImporters.hs @@ -0,0 +1,115 @@ +module Wizard.Database.Migration.Development.Project.Data.ProjectImporters where + +import Shared.Common.Constant.Tenant +import Shared.Common.Util.Date +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Api.Resource.Project.Importer.ProjectImporterDTO +import Wizard.Constant.ProjectImporter +import Wizard.Model.Project.Importer.ProjectImporter +import Wizard.Service.Project.Importer.ProjectImporterMapper + +projectImporterBio1 :: ProjectImporter +projectImporterBio1 = + ProjectImporter + { piId = "global:project-importer-bio:1.0.0" + , name = "ProjectImporterBio" + , organizationId = "global" + , importerId = "project-importer-bio" + , version = "1.0.0" + , metamodelVersion = projectImporterMetamodelVersion + , description = "Import bio answers from project" + , readme = "# Default ProjectImporter BIO 1" + , license = "Apache-2.0" + , allowedPackages = [kmPackagePatternAll] + , url = "http://example.com/project-importer-bio" + , enabled = True + , tenantUuid = defaultTenantUuid + , createdAt = dt' 2018 1 21 + , updatedAt = dt' 2018 1 21 + } + +projectImporterBio2 :: ProjectImporter +projectImporterBio2 = + ProjectImporter + { piId = "global:project-importer-bio:2.0.0" + , name = "ProjectImporterBio" + , organizationId = "global" + , importerId = "project-importer-bio" + , version = "2.0.0" + , metamodelVersion = projectImporterMetamodelVersion + , description = "Import bio answers from project" + , readme = "# Default ProjectImporter BIO 2" + , license = "Apache-2.0" + , allowedPackages = [kmPackagePatternAll] + , url = "http://example.com/project-importer-bio" + , enabled = True + , tenantUuid = defaultTenantUuid + , createdAt = dt' 2018 1 21 + , updatedAt = dt' 2018 1 21 + } + +projectImporterBio3 :: ProjectImporter +projectImporterBio3 = + ProjectImporter + { piId = "global:project-importer-bio:3.0.0" + , name = "ProjectImporterBio" + , organizationId = "global" + , importerId = "project-importer-bio" + , version = "3.0.0" + , metamodelVersion = projectImporterMetamodelVersion + , description = "Import bio answers from project" + , readme = "# Default ProjectImporter BIO 3" + , license = "Apache-2.0" + , allowedPackages = [kmPackagePatternAll] + , url = "http://example.com/project-importer-bio" + , enabled = False + , tenantUuid = defaultTenantUuid + , createdAt = dt' 2018 1 21 + , updatedAt = dt' 2018 1 21 + } + +projectImporterBio3Edited :: ProjectImporter +projectImporterBio3Edited = projectImporterBio3 {enabled = True} + +projectImporterBio3Dto :: ProjectImporterDTO +projectImporterBio3Dto = toDTO projectImporterBio3 + +projectImporterExt1 :: ProjectImporter +projectImporterExt1 = + ProjectImporter + { piId = "global:project-ext-importer:1.0.0" + , name = "ProjectImporterExt" + , organizationId = "global" + , importerId = "project-ext-importer" + , version = "1.0.0" + , metamodelVersion = projectImporterMetamodelVersion + , description = "Import ext answers from project" + , readme = "# Default Ext ProjectImporter" + , license = "Apache-2.0" + , allowedPackages = [kmPackagePatternGlobal] + , url = "http://example.com/project-ext-importer" + , enabled = True + , tenantUuid = defaultTenantUuid + , createdAt = dt' 2018 1 21 + , updatedAt = dt' 2018 1 21 + } + +projectImporterOnto1 :: ProjectImporter +projectImporterOnto1 = + ProjectImporter + { piId = "global:project-importer-onto:1.0.0" + , name = "ProjectImporterOnto" + , organizationId = "global" + , importerId = "project-importer-onto" + , version = "1.0.0" + , metamodelVersion = projectImporterMetamodelVersion + , description = "Import onto answers from project" + , readme = "# Default Ext ProjectImporter" + , license = "Apache-2.0" + , allowedPackages = [kmPackagePatternGlobal] + , url = "http://example.com/project-importer-onto" + , enabled = False + , tenantUuid = defaultTenantUuid + , createdAt = dt' 2018 1 21 + , updatedAt = dt' 2018 1 21 + } diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectLabels.hs b/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectLabels.hs new file mode 100644 index 000000000..bbb7c80a5 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectLabels.hs @@ -0,0 +1,15 @@ +module Wizard.Database.Migration.Development.Project.Data.ProjectLabels where + +import qualified Data.Map.Strict as M +import qualified Data.UUID as U + +import Shared.Common.Util.Uuid +import Wizard.Database.Migration.Development.Project.Data.ProjectReplies + +fLabel1 = u' "3268ae3b-8c1a-44ea-ba69-ad759b3ef2ae" + +fLabels :: M.Map String [U.UUID] +fLabels = M.fromList [(fst rQ1, [fLabel1])] + +fLabelsEdited :: M.Map String [U.UUID] +fLabelsEdited = M.fromList [(fst rQ1, [fLabel1]), (fst rQ2, [fLabel1])] diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectMessages.hs b/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectMessages.hs new file mode 100644 index 000000000..ff4740dd6 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectMessages.hs @@ -0,0 +1,16 @@ +module Wizard.Database.Migration.Development.Project.Data.ProjectMessages where + +import Wizard.Api.Resource.Project.Event.ProjectEventChangeDTO +import Wizard.Api.Resource.Websocket.ProjectMessageDTO +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Database.Migration.Development.User.Data.Users +import Wizard.Service.Project.Event.ProjectEventMapper + +ensureOnlineUserAction :: ClientProjectMessageDTO +ensureOnlineUserAction = + SetContent_ClientProjectMessageDTO . SetReplyEventChangeDTO' $ + toSetReplyEventChangeDTO (sre_rQ1 project1Uuid) + +setUserListAction :: ServerProjectMessageDTO +setUserListAction = SetUserList_ServerProjectMessageDTO [userAlbertOnlineInfo] diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectMigrations.hs b/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectMigrations.hs new file mode 100644 index 000000000..adb6b3edf --- /dev/null +++ b/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectMigrations.hs @@ -0,0 +1,135 @@ +module Wizard.Database.Migration.Development.Project.Data.ProjectMigrations where + +import qualified Data.Map.Strict as M + +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.KnowledgeModels +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Questions +import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel +import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackage +import Wizard.Api.Resource.Project.Detail.ProjectDetailQuestionnaireDTO +import Wizard.Api.Resource.Project.Migration.ProjectMigrationChangeDTO +import Wizard.Api.Resource.Project.Migration.ProjectMigrationCreateDTO +import Wizard.Api.Resource.Project.Migration.ProjectMigrationDTO +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Database.Migration.Development.Tenant.Data.Tenants +import Wizard.Model.Project.Migration.ProjectMigration +import Wizard.Model.Project.Project +import Wizard.Model.Project.ProjectContent +import Wizard.Model.Tenant.Tenant +import Wizard.Service.Project.ProjectMapper + +projectMigration :: ProjectMigration +projectMigration = + ProjectMigration + { oldProjectUuid = projectMigrationDto.oldProject.uuid + , newProjectUuid = projectMigrationDto.newProject.uuid + , resolvedQuestionUuids = [question2.uuid] + , tenantUuid = defaultTenant.uuid + } + +projectMigrationDto :: ProjectMigrationDTO +projectMigrationDto = + ProjectMigrationDTO + { oldProject = + toDetailProjectDTO + (toDetailQuestionnaire project4 (Just project4Upgraded.uuid) [] 0 0) + M.empty + M.empty + km1Netherlands + project4Ctn.phaseUuid + project4Ctn.replies + project4Ctn.labels + , newProject = + toDetailProjectDTO + (toDetailQuestionnaire project4Upgraded Nothing [] 0 0) + M.empty + M.empty + km1NetherlandsV2 + project4Ctn.phaseUuid + project4Ctn.replies + project4Ctn.labels + , resolvedQuestionUuids = [question2.uuid] + , tenantUuid = defaultTenant.uuid + } + +projectMigrationVisibleViewDto :: ProjectMigrationDTO +projectMigrationVisibleViewDto = + ProjectMigrationDTO + { oldProject = + toDetailProjectDTO + (toDetailQuestionnaire project4VisibleView (Just project4Upgraded.uuid) [] 0 0) + M.empty + M.empty + km1Netherlands + project4Ctn.phaseUuid + project4Ctn.replies + project4Ctn.labels + , newProject = + toDetailProjectDTO + (toDetailQuestionnaire project4VisibleViewUpgraded Nothing [] 0 0) + M.empty + M.empty + km1NetherlandsV2 + project4Ctn.phaseUuid + project4Ctn.replies + project4Ctn.labels + , resolvedQuestionUuids = projectMigrationDto.resolvedQuestionUuids + , tenantUuid = defaultTenant.uuid + } + +projectMigrationVisibleEditDto :: ProjectMigrationDTO +projectMigrationVisibleEditDto = + ProjectMigrationDTO + { oldProject = + toDetailProjectDTO + (toDetailQuestionnaire project4VisibleEdit (Just project4Upgraded.uuid) [] 0 0) + M.empty + M.empty + km1Netherlands + project4Ctn.phaseUuid + project4Ctn.replies + project4Ctn.labels + , newProject = + toDetailProjectDTO + (toDetailQuestionnaire project4VisibleEditUpgraded Nothing [] 0 0) + M.empty + M.empty + km1NetherlandsV2 + project4Ctn.phaseUuid + project4Ctn.replies + project4Ctn.labels + , resolvedQuestionUuids = projectMigrationDto.resolvedQuestionUuids + , tenantUuid = defaultTenant.uuid + } + +projectMigrationDtoEdited :: ProjectMigrationDTO +projectMigrationDtoEdited = + ProjectMigrationDTO + { oldProject = projectMigrationDto.oldProject + , newProject = projectMigrationDto.newProject + , resolvedQuestionUuids = [question2.uuid, question3.uuid] + , tenantUuid = projectMigrationDto.tenantUuid + } + +projectMigrationCreateDto :: ProjectMigrationCreateDTO +projectMigrationCreateDto = + ProjectMigrationCreateDTO + { targetKnowledgeModelPackageId = netherlandsKmPackageV2.pId + , targetTagUuids = project4Upgraded.selectedQuestionTagUuids + } + +projectMigrationChangeDto :: ProjectMigrationChangeDTO +projectMigrationChangeDto = + ProjectMigrationChangeDTO + { resolvedQuestionUuids = projectMigrationDtoEdited.resolvedQuestionUuids + } + +differentProjectMigration :: ProjectMigration +differentProjectMigration = + ProjectMigration + { oldProjectUuid = differentProject.uuid + , newProjectUuid = differentProject.uuid + , resolvedQuestionUuids = [question2.uuid] + , tenantUuid = differentTenant.uuid + } diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectReplies.hs b/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectReplies.hs new file mode 100644 index 000000000..c41007b9e --- /dev/null +++ b/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectReplies.hs @@ -0,0 +1,287 @@ +module Wizard.Database.Migration.Development.Project.Data.ProjectReplies where + +import qualified Data.Map.Strict as M +import Data.Maybe (fromJust) +import Data.Time +import qualified Data.UUID as U + +import Shared.Common.Util.Uuid +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.AnswersAndFollowUpQuestions +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Chapters +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Choices +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Questions +import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel +import Wizard.Database.Migration.Development.User.Data.Users +import Wizard.Model.Project.ProjectReply +import Wizard.Model.Project.ProjectUtil +import qualified Wizard.Service.User.UserMapper as UM + +fReplies :: M.Map String Reply +fReplies = + M.fromList + [ rQ1 + , rQ2 + , rQ2_aYes_fuQ1 + , rQ3 + , rQ4 + , rQ4_it1_q5 + , rQ4_it1_q5_it1_question7 + , rQ4_it1_q5_it1_question8 + , rQ4_it1_q6 + , rQ4_it2_q5 + , rQ4_it2_q6 + , rQ9 + , rQ10 + , rQ11 + ] + +fRepliesWithUpdated :: M.Map String Reply +fRepliesWithUpdated = + M.fromList + [ rQ1Updated + , rQ2 + , rQ2_aYes_fuQ1 + , rQ3 + , rQ4 + , rQ4_it1_q5 + , rQ4_it1_q5_it1_question7 + , rQ4_it1_q5_it1_question8 + , rQ4_it1_q6 + , rQ4_it2_q5 + , rQ4_it2_q6 + , rQ9 + , rQ10 + , rQ11 + ] + +fRepliesWithDeleted :: M.Map String Reply +fRepliesWithDeleted = + M.fromList + [ rQ2 + , rQ2_aYes_fuQ1 + , rQ3 + , rQ4 + , rQ4_it1_q5 + , rQ4_it1_q5_it1_question7 + , rQ4_it1_q5_it1_question8 + , rQ4_it1_q6 + , rQ4_it2_q5 + , rQ4_it2_q6 + , rQ9 + , rQ10 + , rQ11 + ] + +fRepliesEdited :: M.Map String Reply +fRepliesEdited = M.fromList [rQ1, rQ2, rQ2_aYes_fuQ1, rQ3, rQ9, rQ10, rQ11] + +rQ1 :: ReplyTuple +rQ1 = + ( createReplyKey [chapter1.uuid, question1.uuid] + , Reply + { value = StringReply {sValue = "Reply to 1st question"} + , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 + } + ) + +rQ1Updated :: ReplyTuple +rQ1Updated = + ( createReplyKey [chapter1.uuid, question1.uuid] + , Reply + { value = StringReply {sValue = "Updated Reply to 1st question"} + , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 1 + } + ) + +rQ2 :: ReplyTuple +rQ2 = + ( createReplyKey [chapter1.uuid, question2.uuid] + , Reply + { value = AnswerReply {aValue = q2_answerYes.uuid} + , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 2 + } + ) + +rQ2_aYes_fuQ1 :: ReplyTuple +rQ2_aYes_fuQ1 = + ( createReplyKey [chapter1.uuid, question2.uuid, q2_answerYes.uuid, q2_aYes_fuQuestion1.uuid] + , Reply + { value = AnswerReply {aValue = q2_aYes_fuq1_answerNo.uuid} + , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 3 + } + ) + +unused_rQ2_aYes_fuQ1_aYes_fuq2 :: ReplyTuple +unused_rQ2_aYes_fuQ1_aYes_fuq2 = + ( createReplyKey + [ chapter1.uuid + , question2.uuid + , q2_answerYes.uuid + , q2_aYes_fuQuestion1.uuid + , q2_aYes_fuq1_answerYes.uuid + , q2_aYes_fuq1_aYes_fuQuestion2.uuid + ] + , Reply + { value = AnswerReply {aValue = q2_aYes_fuq1_aYes_fuq2_answerNo.uuid} + , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 4 + } + ) + +rQ3 :: ReplyTuple +rQ3 = + ( createReplyKey [chapter2.uuid, question3.uuid] + , Reply + { value = AnswerReply {aValue = q3_answerNo.uuid} + , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 5 + } + ) + +-- ------------------------------------------------------------ +rQ4 :: ReplyTuple +rQ4 = + ( createReplyKey [chapter2.uuid, question4.uuid] + , Reply + { value = ItemListReply {ilValue = [rQ4_it1, rQ4_it2]} + , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 6 + } + ) + +rQ4_it1 :: U.UUID +rQ4_it1 = u' "97e42df3-f0f6-40f8-83ab-375a1340e8ab" + +rQ4_it1_q5 :: ReplyTuple +rQ4_it1_q5 = + ( createReplyKey [chapter2.uuid, question4.uuid, rQ4_it1, q4_it1_question5.uuid] + , Reply + { value = ItemListReply {ilValue = [rQ4_it1_q5_it1]} + , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 7 + } + ) + +rQ4_it1_q5_it1 :: U.UUID +rQ4_it1_q5_it1 = u' "12c243e0-f300-4178-ae4e-0b30d01c6f73" + +rQ4_it1_q5_it1_question7 :: ReplyTuple +rQ4_it1_q5_it1_question7 = + ( createReplyKey + [ chapter2.uuid + , question4.uuid + , rQ4_it1 + , q4_it1_question5.uuid + , rQ4_it1_q5_it1 + , q4_it1_q5_it2_question7.uuid + ] + , Reply + { value = StringReply {sValue = "Ai1: q5: Ai1: Reply to 7th question"} + , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 8 + } + ) + +rQ4_it1_q5_it1_question8 :: ReplyTuple +rQ4_it1_q5_it1_question8 = + ( createReplyKey + [ chapter2.uuid + , question4.uuid + , rQ4_it1 + , q4_it1_question5.uuid + , rQ4_it1_q5_it1 + , q4_it1_q5_it2_question8.uuid + ] + , Reply + { value = StringReply {sValue = "Ai1: q5: Ai1: Reply to 8th question"} + , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 9 + } + ) + +rQ4_it1_q6 :: ReplyTuple +rQ4_it1_q6 = + ( createReplyKey [chapter2.uuid, question4.uuid, rQ4_it1, q4_it1_question6.uuid] + , Reply + { value = AnswerReply {aValue = q4_it1_q6_answerNo.uuid} + , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 10 + } + ) + +-- ------------------------------------------------------------ +rQ4_it2 :: U.UUID +rQ4_it2 = u' "aed4bcbc-0c63-4bf6-b954-4561e92babfa" + +rQ4_it2_q5 :: ReplyTuple +rQ4_it2_q5 = + ( createReplyKey [chapter2.uuid, question4.uuid, rQ4_it2, q4_it1_question5.uuid] + , Reply + { value = ItemListReply {ilValue = []} + , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 11 + } + ) + +rQ4_it2_q6 :: ReplyTuple +rQ4_it2_q6 = + ( createReplyKey [chapter2.uuid, question4.uuid, rQ4_it2, q4_it1_question6.uuid] + , Reply + { value = AnswerReply {aValue = q4_it1_q6_answerNo.uuid} + , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 12 + } + ) + +-- ------------------------------------------------------------ +rQ9 :: ReplyTuple +rQ9 = + ( createReplyKey [chapter3.uuid, question9.uuid] + , Reply + { value = IntegrationReply {iValue = PlainType rQ9Value} + , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 13 + } + ) + +rQ9Value :: String +rQ9Value = "Plain reply to 9st question" + +rQ9WithNewType :: ReplyTuple +rQ9WithNewType = + ( createReplyKey [chapter3.uuid, question9.uuid] + , Reply + { value = StringReply {sValue = rQ9Value} + , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 14 + } + ) + +rQ10 :: ReplyTuple +rQ10 = + ( createReplyKey [chapter3.uuid, question10.uuid] + , Reply + { value = IntegrationReply {iValue = rQ10IntValue} + , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 15 + } + ) + +rQ10IntValue :: IntegrationReplyType +rQ10IntValue = + IntegrationLegacyType {intId = Just "bsg-p000007", value = "Integration reply to 9st question"} + +-- ------------------------------------------------------------------------ +rQ11 :: ReplyTuple +rQ11 = + ( createReplyKey [chapter3.uuid, question11.uuid] + , Reply + { value = MultiChoiceReply {mcValue = [q11_choice2.uuid]} + , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 16 + } + ) diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectVersions.hs b/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectVersions.hs new file mode 100644 index 000000000..6c1468b0f --- /dev/null +++ b/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/ProjectVersions.hs @@ -0,0 +1,80 @@ +module Wizard.Database.Migration.Development.Project.Data.ProjectVersions where + +import qualified Data.List as L +import Data.Maybe (fromJust) +import Data.Time +import qualified Data.UUID as U + +import Shared.Common.Constant.Tenant (defaultTenantUuid) +import Shared.Common.Util.String +import Shared.Common.Util.Uuid +import Wizard.Api.Resource.Project.Version.ProjectVersionChangeDTO +import Wizard.Api.Resource.Project.Version.ProjectVersionRevertDTO +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.User.Data.Users +import Wizard.Model.Project.Event.ProjectEvent +import Wizard.Model.Project.Version.ProjectVersion +import Wizard.Model.Project.Version.ProjectVersionList +import Wizard.Model.User.User +import Wizard.Service.Project.Version.ProjectVersionMapper + +qVersions :: U.UUID -> [ProjectVersion] +qVersions projectUuid = [projectVersion1 projectUuid] + +qVersionsList :: U.UUID -> [ProjectVersionList] +qVersionsList projectUuid = [projectVersion1List projectUuid] + +projectVersion1 :: U.UUID -> ProjectVersion +projectVersion1 projectUuid = + ProjectVersion + { uuid = createVersionUuid projectUuid "dd016270ce7e" + , name = "Version 1" + , description = Just "Version 1 description" + , eventUuid = (slble_rQ1 projectUuid).uuid + , projectUuid = projectUuid + , tenantUuid = defaultTenantUuid + , createdBy = Just userAlbert.uuid + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 + , updatedAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 + } + +projectVersion1List :: U.UUID -> ProjectVersionList +projectVersion1List projectUuid = toVersionList (projectVersion1 projectUuid) (Just userAlbertDto) + +projectVersion1Edited :: U.UUID -> ProjectVersion +projectVersion1Edited projectUuid = + (projectVersion1 projectUuid) + { name = "EDITED: " ++ (projectVersion1 projectUuid).name + , description = fmap ("EDITED: " ++) (projectVersion1 projectUuid).description + , eventUuid = (sre_rQ11 projectUuid).uuid + } + +projectVersion1EditedList :: U.UUID -> ProjectVersionList +projectVersion1EditedList projectUuid = toVersionList (projectVersion1Edited projectUuid) (Just userAlbertDto) + +projectVersion1EditedChangeDto :: U.UUID -> ProjectVersionChangeDTO +projectVersion1EditedChangeDto projectUuid = toVersionChangeDTO (projectVersion1Edited projectUuid) + +projectVersion1RevertDto :: U.UUID -> ProjectVersionRevertDTO +projectVersion1RevertDto projectUuid = toVersionRevertDTO (sre_rQ2 projectUuid).uuid + +projectVersion2 :: U.UUID -> ProjectVersion +projectVersion2 projectUuid = + ProjectVersion + { uuid = createVersionUuid projectUuid "515f1d45b24f" + , name = "Version 2" + , description = Just "Version 2 description" + , eventUuid = (sre_rQ11 projectUuid).uuid + , projectUuid = projectUuid + , tenantUuid = defaultTenantUuid + , createdBy = Just userAlbert.uuid + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 + , updatedAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 + } +projectVersion2ChangeDto :: U.UUID -> ProjectVersionChangeDTO +projectVersion2ChangeDto projectUuid = toVersionChangeDTO (projectVersion2 projectUuid) + +createVersionUuid :: U.UUID -> String -> U.UUID +createVersionUuid projectUuid eventSuffix = + let parts = splitOn "-" . U.toString $ projectUuid + in u' . L.intercalate "-" $ [head parts, parts !! 1, parts !! 2, parts !! 3, eventSuffix] diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/Projects.hs b/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/Projects.hs new file mode 100644 index 000000000..07aef07d8 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Migration/Development/Project/Data/Projects.hs @@ -0,0 +1,967 @@ +module Wizard.Database.Migration.Development.Project.Data.Projects where + +import qualified Data.Map.Strict as M +import qualified Data.UUID as U + +import Shared.Common.Model.Common.Lens +import Shared.Common.Util.Date +import Shared.Common.Util.Uuid +import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplateFormats +import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplates +import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplate +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Phases +import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel +import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackage +import Wizard.Api.Resource.Project.Acl.ProjectPermDTO +import Wizard.Api.Resource.Project.Detail.ProjectDetailWsDTO +import Wizard.Api.Resource.Project.ProjectContentChangeDTO +import Wizard.Api.Resource.Project.ProjectContentDTO +import Wizard.Api.Resource.Project.ProjectCreateDTO +import Wizard.Api.Resource.Project.ProjectDTO +import Wizard.Api.Resource.Project.ProjectSettingsChangeDTO +import Wizard.Api.Resource.Project.ProjectShareChangeDTO +import Wizard.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Database.Migration.Development.Project.Data.ProjectComments +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.Project.Data.ProjectLabels +import Wizard.Database.Migration.Development.Project.Data.ProjectReplies +import Wizard.Database.Migration.Development.Project.Data.ProjectVersions +import Wizard.Database.Migration.Development.Tenant.Data.Tenants +import Wizard.Database.Migration.Development.User.Data.Users +import Wizard.Model.Project.Acl.ProjectPerm +import Wizard.Model.Project.Event.ProjectEvent +import Wizard.Model.Project.Event.ProjectEventLenses () +import Wizard.Model.Project.Project +import Wizard.Model.Project.ProjectContent +import Wizard.Model.Project.ProjectState +import Wizard.Model.Project.Version.ProjectVersion +import Wizard.Model.Tenant.Tenant +import Wizard.Model.User.User +import Wizard.Service.Project.Event.ProjectEventMapper +import Wizard.Service.Project.ProjectMapper +import WizardLib.Public.Database.Migration.Development.User.Data.UserGroups +import WizardLib.Public.Model.User.UserGroup + +_PROJECT_TAG_1 = "projectTag1" + +_PROJECT_TAG_2 = "projectTag2" + +project1Uuid :: U.UUID +project1Uuid = u' "af984a75-56e3-49f8-b16f-d6b99599910a" + +project1 :: Project +project1 = + Project + { uuid = project1Uuid + , name = "My Private Project" + , description = Just "Some description" + , visibility = PrivateProjectVisibility + , sharing = RestrictedProjectSharing + , knowledgeModelPackageId = germanyKmPackage.pId + , selectedQuestionTagUuids = [] + , projectTags = [_PROJECT_TAG_1] + , documentTemplateId = Just $ wizardDocumentTemplate.tId + , formatUuid = Just $ formatJson.uuid + , creatorUuid = Just $ userAlbert.uuid + , permissions = [project1AlbertEditProjectPerm] + , isTemplate = True + , squashed = True + , tenantUuid = defaultTenant.uuid + , createdAt = dt' 2018 1 20 + , updatedAt = dt' 2018 1 25 + } + +project1Events :: [ProjectEvent] +project1Events = fEvents project1Uuid + +project1Edited :: Project +project1Edited = + project1 + { name = "EDITED: " ++ project1.name + , visibility = VisibleEditProjectVisibility + , sharing = RestrictedProjectSharing + , projectTags = [_PROJECT_TAG_1, _PROJECT_TAG_2] + , permissions = [] + } + +project1ShareEdited :: Project +project1ShareEdited = + project1 + { visibility = VisibleEditProjectVisibility + , sharing = RestrictedProjectSharing + , permissions = [] + } + +project1SettingsEdited :: Project +project1SettingsEdited = + project1 + { name = "EDITED: " ++ project1.name + , projectTags = [_PROJECT_TAG_1, _PROJECT_TAG_2] + } + +project1EventsEdited :: [ProjectEvent] +project1EventsEdited = fEventsEdited project1Uuid + +project1Versions :: [ProjectVersion] +project1Versions = qVersions project1Uuid + +project1Ctn :: ProjectContent +project1Ctn = + ProjectContent + { phaseUuid = Just $ phase1.uuid + , replies = fReplies + , labels = fLabels + } + +project1CtnRevertedDto :: ProjectContentDTO +project1CtnRevertedDto = + ProjectContentDTO + { phaseUuid = Nothing + , replies = M.fromList [rQ1, rQ2] + , commentThreadsMap = projectCommentThreadsList + , labels = M.empty + , events = [toEventList (sre_rQ1' project1Uuid) (Just userAlbert), toEventList (sre_rQ2' project1Uuid) (Just userAlbert)] + , versions = [] + } + +project1Dto :: ProjectDTO +project1Dto = toSimpleDTO project1 germanyKmPackage DefaultProjectState [project1AlbertEditProjectPermDto] + +project1Create :: ProjectCreateDTO +project1Create = + ProjectCreateDTO + { name = project1.name + , knowledgeModelPackageId = project1.knowledgeModelPackageId + , visibility = project1.visibility + , sharing = project1.sharing + , questionTagUuids = [] + , documentTemplateId = project1.documentTemplateId + , formatUuid = project1.formatUuid + } + +project1EditedShareChange :: ProjectShareChangeDTO +project1EditedShareChange = + ProjectShareChangeDTO + { visibility = project1ShareEdited.visibility + , sharing = project1ShareEdited.sharing + , permissions = fmap toProjectPermChangeDTO project1ShareEdited.permissions + } + +project1SettingsChange :: ProjectSettingsChangeDTO +project1SettingsChange = + ProjectSettingsChangeDTO + { name = project1SettingsEdited.name + , description = project1SettingsEdited.description + , projectTags = project1SettingsEdited.projectTags + , documentTemplateId = Nothing + , formatUuid = Nothing + , isTemplate = project1SettingsEdited.isTemplate + } + +project1AlbertEditProjectPerm :: ProjectPerm +project1AlbertEditProjectPerm = + ProjectPerm + { projectUuid = project1.uuid + , memberType = UserProjectPermType + , memberUuid = userAlbert.uuid + , perms = ownerPermissions + , tenantUuid = defaultTenant.uuid + } + +project1AlbertEditProjectPermDto :: ProjectPermDTO +project1AlbertEditProjectPermDto = toUserProjectPermDTO project1AlbertEditProjectPerm userAlbert + +-- ------------------------------------------------------------------------ +-- ------------------------------------------------------------------------ +project2Uuid :: U.UUID +project2Uuid = u' "d57520b4-5a70-4d40-8623-af2bfbbdfdfe" + +project2 :: Project +project2 = + Project + { uuid = project2Uuid + , name = "My VisibleView Project" + , description = Just "Some description" + , visibility = VisibleViewProjectVisibility + , sharing = RestrictedProjectSharing + , knowledgeModelPackageId = germanyKmPackage.pId + , selectedQuestionTagUuids = [] + , projectTags = [_PROJECT_TAG_1, _PROJECT_TAG_2] + , documentTemplateId = Just $ wizardDocumentTemplate.tId + , formatUuid = Just $ formatJson.uuid + , creatorUuid = Just $ userAlbert.uuid + , permissions = [project2AlbertEditProjectPerm] + , isTemplate = False + , squashed = True + , tenantUuid = defaultTenant.uuid + , createdAt = dt' 2018 1 20 + , updatedAt = dt' 2018 1 22 + } + +project2Edited :: Project +project2Edited = + Project + { uuid = project2.uuid + , name = "EDITED: " ++ project2.name + , description = Just "EDITED: Some description" + , visibility = VisibleEditProjectVisibility + , sharing = RestrictedProjectSharing + , knowledgeModelPackageId = project2.knowledgeModelPackageId + , selectedQuestionTagUuids = project2.selectedQuestionTagUuids + , projectTags = project2.projectTags + , documentTemplateId = Just $ wizardDocumentTemplate.tId + , formatUuid = Just $ formatJson.uuid + , creatorUuid = Just $ userAlbert.uuid + , permissions = [] + , isTemplate = False + , squashed = True + , tenantUuid = defaultTenant.uuid + , createdAt = project2.createdAt + , updatedAt = project2.updatedAt + } + +project2Events :: [ProjectEvent] +project2Events = fEvents project2Uuid + +project2Versions :: [ProjectVersion] +project2Versions = qVersions project2Uuid + +project2ShareEdited :: Project +project2ShareEdited = + project2 + { visibility = VisibleEditProjectVisibility + , sharing = RestrictedProjectSharing + , permissions = [] + } + +project2SettingsEdited :: Project +project2SettingsEdited = + project2 + { name = "EDITED: " ++ project2.name + , description = Just "EDITED: Some description" + , documentTemplateId = Just $ wizardDocumentTemplate.tId + , formatUuid = Just $ formatJson.uuid + , creatorUuid = Just $ userAlbert.uuid + , isTemplate = False + } + +project2Ctn :: ProjectContent +project2Ctn = + ProjectContent + { phaseUuid = Just $ phase1.uuid + , replies = fReplies + , labels = fLabels + } + +project2EventsEdited :: [ProjectEvent] +project2EventsEdited = fEventsEdited project2Uuid + +project2Dto :: ProjectDTO +project2Dto = toSimpleDTO project2 germanyKmPackage DefaultProjectState [project2AlbertEditProjectPermDto] + +project2AlbertEditProjectPerm :: ProjectPerm +project2AlbertEditProjectPerm = + ProjectPerm + { projectUuid = project2.uuid + , memberType = UserProjectPermType + , memberUuid = userAlbert.uuid + , perms = ownerPermissions + , tenantUuid = defaultTenant.uuid + } + +project2AlbertEditProjectPermDto :: ProjectPermDTO +project2AlbertEditProjectPermDto = toUserProjectPermDTO project2AlbertEditProjectPerm userAlbert + +-- ------------------------------------------------------------------------ +-- ------------------------------------------------------------------------ +project3Uuid :: U.UUID +project3Uuid = u' "16530a07-e673-4ff3-ac1f-57250f2c1bfe" + +project3 :: Project +project3 = + Project + { uuid = project3Uuid + , name = "My VisibleEdit Project" + , description = Just "Some description" + , visibility = VisibleEditProjectVisibility + , sharing = RestrictedProjectSharing + , knowledgeModelPackageId = germanyKmPackage.pId + , selectedQuestionTagUuids = [] + , projectTags = [] + , documentTemplateId = Just $ wizardDocumentTemplate.tId + , formatUuid = Just $ formatJson.uuid + , creatorUuid = Nothing + , permissions = [] + , isTemplate = False + , squashed = True + , tenantUuid = defaultTenant.uuid + , createdAt = dt' 2018 1 20 + , updatedAt = dt' 2018 1 28 + } + +project3Events :: [ProjectEvent] +project3Events = fEvents project3Uuid + +project3Versions :: [ProjectVersion] +project3Versions = qVersions project3Uuid + +project3Ctn :: ProjectContent +project3Ctn = + ProjectContent + { phaseUuid = Just $ phase1.uuid + , replies = fReplies + , labels = fLabels + } + +project3EventsEdited :: [ProjectEvent] +project3EventsEdited = fEventsEdited project3Uuid + +project3Dto :: ProjectDTO +project3Dto = toSimpleDTO project3 germanyKmPackage DefaultProjectState [] + +-- ------------------------------------------------------------------------ +-- ------------------------------------------------------------------------ +project4Uuid :: U.UUID +project4Uuid = u' "57250a07-a663-4ff3-ac1f-16530f2c1bfe" + +project4 :: Project +project4 = + Project + { uuid = project4Uuid + , name = "Outdated Project" + , description = Just "Some description" + , visibility = PrivateProjectVisibility + , sharing = RestrictedProjectSharing + , knowledgeModelPackageId = netherlandsKmPackage.pId + , selectedQuestionTagUuids = [] + , projectTags = [] + , documentTemplateId = Just $ wizardDocumentTemplate.tId + , formatUuid = Just $ formatJson.uuid + , creatorUuid = Nothing + , permissions = [] + , isTemplate = False + , squashed = True + , tenantUuid = defaultTenant.uuid + , createdAt = dt' 2018 1 20 + , updatedAt = dt' 2018 1 25 + } + +project4Events :: [ProjectEvent] +project4Events = [sphse_2' project4Uuid] + +project4Versions :: [ProjectVersion] +project4Versions = [] + +project4Ctn :: ProjectContent +project4Ctn = + ProjectContent + { phaseUuid = Just $ phase2.uuid + , replies = M.empty + , labels = M.empty + } + +project4VisibleView :: Project +project4VisibleView = project4 {visibility = VisibleViewProjectVisibility} + +project4VisibleViewEvents :: [ProjectEvent] +project4VisibleViewEvents = [sphse_2' project4VisibleView.uuid] + +project4VisibleEdit :: Project +project4VisibleEdit = project4 {visibility = VisibleEditProjectVisibility} + +project4VisibleEditEvents :: [ProjectEvent] +project4VisibleEditEvents = [sphse_2' project4VisibleEdit.uuid] + +project4Upgraded :: Project +project4Upgraded = + project4 + { uuid = u' "5deabef8-f526-421c-90e2-dd7aed1a25c5" + , knowledgeModelPackageId = netherlandsKmPackageV2.pId + } + +project4UpgradedEvents :: [ProjectEvent] +project4UpgradedEvents = [sphse_2' project4Upgraded.uuid] + +project4VisibleViewUpgraded :: Project +project4VisibleViewUpgraded = project4Upgraded {visibility = VisibleViewProjectVisibility} + +project4VisibleViewUpgradedEvents :: [ProjectEvent] +project4VisibleViewUpgradedEvents = [sphse_2' project4VisibleViewUpgraded.uuid] + +project4VisibleEditUpgraded :: Project +project4VisibleEditUpgraded = project4Upgraded {visibility = VisibleEditProjectVisibility} + +project4VisibleEditUpgradedEvents :: [ProjectEvent] +project4VisibleEditUpgradedEvents = [sphse_2' project4VisibleEditUpgraded.uuid] + +-- ------------------------------------------------------------------------ +-- ------------------------------------------------------------------------ +project5Uuid :: U.UUID +project5Uuid = u' "506be867-ba92-4e10-8175-187e99613366" + +project5 :: Project +project5 = + project1 + { uuid = project5Uuid + , name = "My Private Project SharedView" + , visibility = PrivateProjectVisibility + , sharing = AnyoneWithLinkViewProjectSharing + , permissions = [project5AlbertEditProjectPerm] + } + +project5Events :: [ProjectEvent] +project5Events = fEvents project5Uuid + +project5EventsEdited :: [ProjectEvent] +project5EventsEdited = fEventsEdited project5Uuid + +project5Versions :: [ProjectVersion] +project5Versions = qVersions project5Uuid + +project5AlbertEditProjectPerm :: ProjectPerm +project5AlbertEditProjectPerm = + ProjectPerm + { projectUuid = project5.uuid + , memberType = UserProjectPermType + , memberUuid = userAlbert.uuid + , perms = ownerPermissions + , tenantUuid = defaultTenant.uuid + } + +-- ------------------------------------------------------------------------ +-- ------------------------------------------------------------------------ +project6Uuid :: U.UUID +project6Uuid = u' "09304abd-2035-4046-8dc8-b3e5ba8c016c" + +project6 :: Project +project6 = + project1 + { uuid = project6Uuid + , name = "My Private Project SharedEdit" + , visibility = PrivateProjectVisibility + , sharing = AnyoneWithLinkEditProjectSharing + , permissions = [project6AlbertEditProjectPerm] + } + +project6Events :: [ProjectEvent] +project6Events = fEvents project6Uuid + +project6Versions :: [ProjectVersion] +project6Versions = qVersions project6Uuid + +project6Ctn :: ProjectContent +project6Ctn = + ProjectContent + { phaseUuid = Just $ phase1.uuid + , replies = fReplies + , labels = fLabels + } + +project6EventsEdited :: [ProjectEvent] +project6EventsEdited = fEventsEdited project6Uuid + +project6Dto :: ProjectDTO +project6Dto = toSimpleDTO project6 germanyKmPackage DefaultProjectState [project6AlbertEditProjectPermDto] + +project6AlbertEditProjectPerm :: ProjectPerm +project6AlbertEditProjectPerm = + ProjectPerm + { projectUuid = project6.uuid + , memberType = UserProjectPermType + , memberUuid = userAlbert.uuid + , perms = ownerPermissions + , tenantUuid = defaultTenant.uuid + } + +project6AlbertEditProjectPermDto :: ProjectPermDTO +project6AlbertEditProjectPermDto = toUserProjectPermDTO project6AlbertEditProjectPerm userAlbert + +-- ------------------------------------------------------------------------ +-- ------------------------------------------------------------------------ +project7Uuid :: U.UUID +project7Uuid = u' "abd22b10-63fd-4cb8-bb23-7997ff32eccc" + +project7 :: Project +project7 = + project2 + { uuid = project7Uuid + , name = "My VisibleView Project SharedView" + , visibility = VisibleViewProjectVisibility + , sharing = AnyoneWithLinkViewProjectSharing + , permissions = [project7AlbertEditProjectPerm] + } + +project7Events :: [ProjectEvent] +project7Events = fEvents project7Uuid + +project7EventsEdited :: [ProjectEvent] +project7EventsEdited = fEventsEdited project8Uuid + +project7Versions :: [ProjectVersion] +project7Versions = qVersions project7Uuid + +project7Ctn :: ProjectContent +project7Ctn = + ProjectContent + { phaseUuid = Just $ phase1.uuid + , replies = fReplies + , labels = fLabels + } + +project7AlbertEditProjectPerm :: ProjectPerm +project7AlbertEditProjectPerm = + ProjectPerm + { projectUuid = project7.uuid + , memberType = UserProjectPermType + , memberUuid = userAlbert.uuid + , perms = ownerPermissions + , tenantUuid = defaultTenant.uuid + } + +project7AlbertEditProjectPermDto :: ProjectPermDTO +project7AlbertEditProjectPermDto = toUserProjectPermDTO project7AlbertEditProjectPerm userAlbert + +-- ------------------------------------------------------------------------ +-- ------------------------------------------------------------------------ +project8Uuid :: U.UUID +project8Uuid = u' "a990f62a-ca1f-4517-82d4-399951b8630b" + +project8 :: Project +project8 = + project2 + { uuid = project8Uuid + , name = "My VisibleView Project SharedEdit" + , visibility = VisibleViewProjectVisibility + , sharing = AnyoneWithLinkEditProjectSharing + , permissions = [project8AlbertEditProjectPerm] + } + +project8Events :: [ProjectEvent] +project8Events = fEvents project8Uuid + +project8EventsEdited :: [ProjectEvent] +project8EventsEdited = fEventsEdited project8Uuid + +project8Versions :: [ProjectVersion] +project8Versions = qVersions project8Uuid + +project8AlbertEditProjectPerm :: ProjectPerm +project8AlbertEditProjectPerm = + ProjectPerm + { projectUuid = project8.uuid + , memberType = UserProjectPermType + , memberUuid = userAlbert.uuid + , perms = ownerPermissions + , tenantUuid = defaultTenant.uuid + } + +-- ------------------------------------------------------------------------ +-- ------------------------------------------------------------------------ +project9Uuid :: U.UUID +project9Uuid = u' "936e852f-4c41-4524-8387-bd87090e9fcc" + +project9 :: Project +project9 = + project2 + { uuid = project9Uuid + , name = "My VisibleEdit Project SharedView" + , visibility = VisibleEditProjectVisibility + , sharing = AnyoneWithLinkViewProjectSharing + , permissions = [project9AlbertEditProjectPerm] + } + +project9Events :: [ProjectEvent] +project9Events = fEvents project9Uuid + +project9EventsEdited :: [ProjectEvent] +project9EventsEdited = fEventsEdited project9Uuid + +project9Versions :: [ProjectVersion] +project9Versions = qVersions project9Uuid + +project9AlbertEditProjectPerm :: ProjectPerm +project9AlbertEditProjectPerm = + ProjectPerm + { projectUuid = project9.uuid + , memberType = UserProjectPermType + , memberUuid = userAlbert.uuid + , perms = ownerPermissions + , tenantUuid = defaultTenant.uuid + } + +-- ------------------------------------------------------------------------ +-- ------------------------------------------------------------------------ +project10Uuid :: U.UUID +project10Uuid = u' "3c8e7ce6-cb5e-4cd1-a4d1-fb9de55f67ed" + +project10 :: Project +project10 = + project3 + { uuid = project10Uuid + , name = "My VisibleEdit Project SharedEdit" + , visibility = VisibleEditProjectVisibility + , sharing = AnyoneWithLinkEditProjectSharing + } + +project10Events :: [ProjectEvent] +project10Events = fEvents project10Uuid + +project10EventsEdited :: [ProjectEvent] +project10EventsEdited = project10Events ++ [setCreatedBy (slble_rQ2' project10Uuid) Nothing] + +project10Versions :: [ProjectVersion] +project10Versions = qVersions project10Uuid + +project10Ctn :: ProjectContent +project10Ctn = + ProjectContent + { phaseUuid = Just $ phase1.uuid + , replies = fReplies + , labels = fLabels + } + +project10EditedShare :: Project +project10EditedShare = project10 {permissions = [project10NikolaEditProjectPerm]} + +project10EditedSettings :: Project +project10EditedSettings = project10 {name = "EDITED: " ++ project10.name} + +project10NikolaEditProjectPerm :: ProjectPerm +project10NikolaEditProjectPerm = + ProjectPerm + { projectUuid = project10.uuid + , memberType = UserProjectPermType + , memberUuid = userNikola.uuid + , perms = ownerPermissions + , tenantUuid = defaultTenant.uuid + } + +project10NikolaEditProjectPermDto :: ProjectPermDTO +project10NikolaEditProjectPermDto = toUserProjectPermDTO project10NikolaEditProjectPerm userNikola + +project10EditedSettingsChange :: ProjectSettingsChangeDTO +project10EditedSettingsChange = + ProjectSettingsChangeDTO + { name = "EDITED: " ++ project10.name + , description = project10.description + , projectTags = project10.projectTags + , documentTemplateId = Nothing + , formatUuid = Nothing + , isTemplate = project10.isTemplate + } + +project10EditedWs :: ProjectDetailWsDTO +project10EditedWs = + ProjectDetailWsDTO + { name = project10EditedSettingsChange.name + , description = project10EditedSettingsChange.description + , visibility = project10.visibility + , sharing = project10.sharing + , projectTags = project10EditedSettingsChange.projectTags + , permissions = [] + , documentTemplateId = Nothing + , documentTemplate = Nothing + , formatUuid = Nothing + , format = Nothing + , isTemplate = project10EditedSettingsChange.isTemplate + , labels = M.empty + , unresolvedCommentCounts = M.empty + , resolvedCommentCounts = M.empty + } + +-- ------------------------------------------------------------------------ +-- ------------------------------------------------------------------------ +project11Uuid :: U.UUID +project11Uuid = u' "ba6b6c0e-2bb7-40e7-9019-feb943756888" + +project11 :: Project +project11 = + project1 + { uuid = project11Uuid + , name = "My Project from project template" + , permissions = [project11AlbertEditProjectPerm] + } + +project11Events :: [ProjectEvent] +project11Events = fEvents project11Uuid + +project11Versions :: [ProjectVersion] +project11Versions = qVersions project11Uuid + +project11Ctn :: ProjectContent +project11Ctn = project1Ctn + +project11Dto :: ProjectDTO +project11Dto = toSimpleDTO project11 germanyKmPackage DefaultProjectState [project11AlbertEditProjectPermDto] + +project11AlbertEditProjectPerm :: ProjectPerm +project11AlbertEditProjectPerm = + ProjectPerm + { projectUuid = project11.uuid + , memberType = UserProjectPermType + , memberUuid = userAlbert.uuid + , perms = ownerPermissions + , tenantUuid = defaultTenant.uuid + } + +project11AlbertEditProjectPermDto :: ProjectPermDTO +project11AlbertEditProjectPermDto = toUserProjectPermDTO project11AlbertEditProjectPerm userAlbert + +-- ------------------------------------------------------------------------ +-- ------------------------------------------------------------------------ +project12Uuid :: U.UUID +project12Uuid = u' "e02bc040-7446-48a2-b557-678e01d66937" + +project12 :: Project +project12 = + project1 + { uuid = project12Uuid + , name = "My Private Project with 2 users" + , visibility = VisibleEditProjectVisibility + , sharing = AnyoneWithLinkEditProjectSharing + , permissions = [project12NikolaEditProjectPerm, project12AlbertEditProjectPerm] + , updatedAt = dt' 2018 1 23 + } + +project12Events :: [ProjectEvent] +project12Events = fEvents project12Uuid + +project12Versions :: [ProjectVersion] +project12Versions = qVersions project12Uuid + +project12Ctn :: ProjectContent +project12Ctn = project1Ctn + +project12Dto :: ProjectDTO +project12Dto = + toSimpleDTO project12 germanyKmPackage DefaultProjectState [project12NikolaEditProjectPermDto, project12AlbertEditProjectPermDto] + +project12AlbertEditProjectPerm :: ProjectPerm +project12AlbertEditProjectPerm = + ProjectPerm + { projectUuid = project12.uuid + , memberType = UserProjectPermType + , memberUuid = userAlbert.uuid + , perms = ownerPermissions + , tenantUuid = defaultTenant.uuid + } + +project12AlbertEditProjectPermDto :: ProjectPermDTO +project12AlbertEditProjectPermDto = toUserProjectPermDTO project12AlbertEditProjectPerm userAlbert + +project12NikolaEditProjectPerm :: ProjectPerm +project12NikolaEditProjectPerm = + ProjectPerm + { projectUuid = project12.uuid + , memberType = UserProjectPermType + , memberUuid = userNikola.uuid + , perms = ownerPermissions + , tenantUuid = defaultTenant.uuid + } + +project12NikolaEditProjectPermDto :: ProjectPermDTO +project12NikolaEditProjectPermDto = toUserProjectPermDTO project12NikolaEditProjectPerm userNikola + +-- ------------------------------------------------------------------------ +-- ------------------------------------------------------------------------ +project13Uuid :: U.UUID +project13Uuid = u' "59b97a8e-aa48-47f7-93a7-646f9df077df" + +project13 :: Project +project13 = + project1 + { uuid = project13Uuid + , name = "My VisibleCommentProjectVisibility Project" + , visibility = VisibleCommentProjectVisibility + , permissions = [project13NikolaCommentProjectPerm] + } + +project13Events :: [ProjectEvent] +project13Events = fEvents project13Uuid + +project13Versions :: [ProjectVersion] +project13Versions = qVersions project13Uuid + +project13Ctn :: ProjectContent +project13Ctn = project1Ctn + +project13Dto :: ProjectDTO +project13Dto = toSimpleDTO project13 germanyKmPackage DefaultProjectState [project13NikolaCommentProjectPermDto] + +project13NikolaCommentProjectPerm :: ProjectPerm +project13NikolaCommentProjectPerm = + ProjectPerm + { projectUuid = project13.uuid + , memberType = UserProjectPermType + , memberUuid = userNikola.uuid + , perms = commentatorPermissions + , tenantUuid = defaultTenant.uuid + } + +project13NikolaCommentProjectPermDto :: ProjectPermDTO +project13NikolaCommentProjectPermDto = toUserProjectPermDTO project13NikolaCommentProjectPerm userNikola + +-- ------------------------------------------------------------------------ +-- ------------------------------------------------------------------------ +project14 :: Project +project14 = + project1 + { uuid = u' "8355fe3c-47b9-4078-b5b6-08aa0188e85f" + , name = "My different KM Project" + , permissions = [project14NikolaEditProjectPerm] + , knowledgeModelPackageId = amsterdamKmPackage.pId + , updatedAt = dt' 2018 1 26 + } + +project14Events :: [ProjectEvent] +project14Events = [] + +project14Ctn :: ProjectContent +project14Ctn = project1Ctn + +project14Dto :: ProjectDTO +project14Dto = toSimpleDTO project14 amsterdamKmPackage DefaultProjectState [project14NikolaEditProjectPermDto] + +project14NikolaEditProjectPerm :: ProjectPerm +project14NikolaEditProjectPerm = + ProjectPerm + { projectUuid = project14.uuid + , memberType = UserProjectPermType + , memberUuid = userNikola.uuid + , perms = ownerPermissions + , tenantUuid = defaultTenant.uuid + } + +project14NikolaEditProjectPermDto :: ProjectPermDTO +project14NikolaEditProjectPermDto = toUserProjectPermDTO project14NikolaEditProjectPerm userNikola + +-- ------------------------------------------------------------------------ +-- ------------------------------------------------------------------------ +project15Uuid :: U.UUID +project15Uuid = u' "d09695f4-638b-472b-9951-a31bd7dc91f7" + +project15 :: Project +project15 = + Project + { uuid = project15Uuid + , name = "My Group Project" + , description = Just "Some description" + , visibility = PrivateProjectVisibility + , sharing = RestrictedProjectSharing + , knowledgeModelPackageId = germanyKmPackage.pId + , selectedQuestionTagUuids = [] + , projectTags = [] + , documentTemplateId = Just wizardDocumentTemplate.tId + , formatUuid = Just formatJson.uuid + , creatorUuid = Nothing + , permissions = [project15GroupEditProjectPerm] + , isTemplate = False + , squashed = True + , tenantUuid = defaultTenant.uuid + , createdAt = dt' 2018 1 20 + , updatedAt = dt' 2018 1 29 + } + +project15AnonymousEdit :: Project +project15AnonymousEdit = + project15 + { sharing = AnyoneWithLinkEditProjectSharing + } + +project15AnonymousComment :: Project +project15AnonymousComment = + project15 + { sharing = AnyoneWithLinkCommentProjectSharing + } + +project15NoPerms :: Project +project15NoPerms = + project15 + { permissions = [] + } + +project15Events :: [ProjectEvent] +project15Events = fEvents project15Uuid + +project15Versions :: [ProjectVersion] +project15Versions = qVersions project15Uuid + +project15Dto :: ProjectDTO +project15Dto = toSimpleDTO project15 germanyKmPackage DefaultProjectState [project15GroupEditProjectPermDto] + +project15GroupEditProjectPerm :: ProjectPerm +project15GroupEditProjectPerm = + ProjectPerm + { projectUuid = project15.uuid + , memberType = UserGroupProjectPermType + , memberUuid = bioGroup.uuid + , perms = ownerPermissions + , tenantUuid = defaultTenant.uuid + } + +project15GroupEditProjectPermDto :: ProjectPermDTO +project15GroupEditProjectPermDto = toUserGroupProjectPermDTO project15GroupEditProjectPerm bioGroup + +-- ------------------------------------------------------------------------ +-- ------------------------------------------------------------------------ +differentProject :: Project +differentProject = + Project + { uuid = u' "7bf4a83e-1687-4e99-b1df-9221977d7b4f" + , name = "My Different Project" + , description = Just "Some description" + , visibility = PrivateProjectVisibility + , sharing = RestrictedProjectSharing + , knowledgeModelPackageId = differentPackage.pId + , selectedQuestionTagUuids = [] + , projectTags = [] + , documentTemplateId = Just $ anotherWizardDocumentTemplate.tId + , formatUuid = Just $ formatJson.uuid + , creatorUuid = Just $ userCharles.uuid + , permissions = [differentCharlesOwnerProjectPerm] + , isTemplate = True + , squashed = True + , tenantUuid = differentTenant.uuid + , createdAt = dt' 2018 1 20 + , updatedAt = dt' 2018 1 25 + } + +differentProjectEvents :: [ProjectEvent] +differentProjectEvents = [] + +differentProjectVersions :: [ProjectVersion] +differentProjectVersions = [] + +differentCharlesOwnerProjectPerm :: ProjectPerm +differentCharlesOwnerProjectPerm = + ProjectPerm + { projectUuid = differentProject.uuid + , memberType = UserProjectPermType + , memberUuid = userCharles.uuid + , perms = ownerPermissions + , tenantUuid = differentTenant.uuid + } + +-- ------------------------------------------------------------------------ +-- ------------------------------------------------------------------------ +contentChangeDTO :: ProjectContentChangeDTO +contentChangeDTO = + ProjectContentChangeDTO + { events = fmap toEventChangeDTO (fEvents U.nil) + } + +-- ------------------------------------------------------------------------ +-- ------------------------------------------------------------------------ +bioGroupEditProjectPerm :: ProjectPerm +bioGroupEditProjectPerm = + ProjectPerm + { projectUuid = project1.uuid + , memberType = UserGroupProjectPermType + , memberUuid = bioGroup.uuid + , perms = ownerPermissions + , tenantUuid = defaultTenant.uuid + } + +bioGroupEditProjectPermDto :: ProjectPermDTO +bioGroupEditProjectPermDto = toUserGroupProjectPermDTO bioGroupEditProjectPerm bioGroup diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Project/ProjectActionMigration.hs b/wizard-server/src/Wizard/Database/Migration/Development/Project/ProjectActionMigration.hs new file mode 100644 index 000000000..41a417e7d --- /dev/null +++ b/wizard-server/src/Wizard/Database/Migration/Development/Project/ProjectActionMigration.hs @@ -0,0 +1,19 @@ +module Wizard.Database.Migration.Development.Project.ProjectActionMigration where + +import Shared.Common.Constant.Component +import Shared.Common.Util.Logger +import Wizard.Database.DAO.Project.ProjectActionDAO +import Wizard.Database.Migration.Development.Project.Data.ProjectActions +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.ContextLenses () + +runMigration :: AppContextM () +runMigration = do + logInfo _CMP_MIGRATION "(ProjectAction/ProjectAction) started" + deleteProjectActions + insertProjectAction projectActionFtp1 + insertProjectAction projectActionFtp2 + insertProjectAction projectActionFtp3 + insertProjectAction projectActionMail1 + insertProjectAction projectActionScp1 + logInfo _CMP_MIGRATION "(ProjectAction/ProjectAction) ended" diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Project/ProjectActionSchemaMigration.hs b/wizard-server/src/Wizard/Database/Migration/Development/Project/ProjectActionSchemaMigration.hs new file mode 100644 index 000000000..efd83ec5e --- /dev/null +++ b/wizard-server/src/Wizard/Database/Migration/Development/Project/ProjectActionSchemaMigration.hs @@ -0,0 +1,44 @@ +module Wizard.Database.Migration.Development.Project.ProjectActionSchemaMigration where + +import Database.PostgreSQL.Simple +import GHC.Int + +import Shared.Common.Util.Logger +import Wizard.Database.DAO.Common +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.ContextLenses () + +dropTables :: AppContextM Int64 +dropTables = do + logInfo _CMP_MIGRATION "(Table/ProjectAction) drop tables" + let sql = "DROP TABLE IF EXISTS project_action CASCADE;" + let action conn = execute_ conn sql + runDB action + +createTables :: AppContextM Int64 +createTables = do + logInfo _CMP_MIGRATION "(Table/ProjectAction) create table" + let sql = + "CREATE TABLE project_action \ + \( \ + \ id varchar NOT NULL, \ + \ name varchar NOT NULL, \ + \ organization_id varchar NOT NULL, \ + \ action_id varchar NOT NULL, \ + \ version varchar NOT NULL, \ + \ metamodel_version integer NOT NULL, \ + \ description varchar NOT NULL, \ + \ readme varchar NOT NULL, \ + \ license varchar NOT NULL, \ + \ allowed_packages jsonb NOT NULL, \ + \ url varchar, \ + \ config jsonb NOT NULL, \ + \ enabled bool NOT NULL, \ + \ tenant_uuid uuid NOT NULL, \ + \ created_at timestamptz NOT NULL, \ + \ updated_at timestamptz NOT NULL, \ + \ CONSTRAINT project_action_pk PRIMARY KEY (id, tenant_uuid), \ + \ CONSTRAINT project_action_tenant_uuid_fk FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) ON DELETE CASCADE \ + \);" + let action conn = execute_ conn sql + runDB action diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Project/ProjectImporterMigration.hs b/wizard-server/src/Wizard/Database/Migration/Development/Project/ProjectImporterMigration.hs new file mode 100644 index 000000000..9986a6687 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Migration/Development/Project/ProjectImporterMigration.hs @@ -0,0 +1,19 @@ +module Wizard.Database.Migration.Development.Project.ProjectImporterMigration where + +import Shared.Common.Constant.Component +import Shared.Common.Util.Logger +import Wizard.Database.DAO.Project.ProjectImporterDAO +import Wizard.Database.Migration.Development.Project.Data.ProjectImporters +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.ContextLenses () + +runMigration :: AppContextM () +runMigration = do + logInfo _CMP_MIGRATION "(ProjectImporter/ProjectImporter) started" + deleteProjectImporters + insertProjectImporter projectImporterBio1 + insertProjectImporter projectImporterBio2 + insertProjectImporter projectImporterBio3 + insertProjectImporter projectImporterExt1 + insertProjectImporter projectImporterOnto1 + logInfo _CMP_MIGRATION "(ProjectImporter/ProjectImporter) ended" diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Project/ProjectImporterSchemaMigration.hs b/wizard-server/src/Wizard/Database/Migration/Development/Project/ProjectImporterSchemaMigration.hs new file mode 100644 index 000000000..865d89619 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Migration/Development/Project/ProjectImporterSchemaMigration.hs @@ -0,0 +1,43 @@ +module Wizard.Database.Migration.Development.Project.ProjectImporterSchemaMigration where + +import Database.PostgreSQL.Simple +import GHC.Int + +import Shared.Common.Util.Logger +import Wizard.Database.DAO.Common +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.ContextLenses () + +dropTables :: AppContextM Int64 +dropTables = do + logInfo _CMP_MIGRATION "(Table/ProjectImporter) drop tables" + let sql = "DROP TABLE IF EXISTS project_importer CASCADE;" + let action conn = execute_ conn sql + runDB action + +createTables :: AppContextM Int64 +createTables = do + logInfo _CMP_MIGRATION "(Table/ProjectImporter) create table" + let sql = + "CREATE TABLE project_importer \ + \( \ + \ id varchar NOT NULL, \ + \ name varchar NOT NULL, \ + \ organization_id varchar NOT NULL, \ + \ importer_id varchar NOT NULL, \ + \ version varchar NOT NULL, \ + \ metamodel_version integer NOT NULL, \ + \ description varchar NOT NULL, \ + \ readme varchar NOT NULL, \ + \ license varchar NOT NULL, \ + \ allowed_packages jsonb NOT NULL, \ + \ url varchar, \ + \ enabled bool NOT NULL, \ + \ tenant_uuid uuid NOT NULL, \ + \ created_at timestamptz NOT NULL, \ + \ updated_at timestamptz NOT NULL, \ + \ CONSTRAINT project_importer_pk PRIMARY KEY (id, tenant_uuid), \ + \ CONSTRAINT project_importer_tenant_uuid_fk FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) ON DELETE CASCADE \ + \);" + let action conn = execute_ conn sql + runDB action diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Project/ProjectMigration.hs b/wizard-server/src/Wizard/Database/Migration/Development/Project/ProjectMigration.hs new file mode 100644 index 000000000..c068767e7 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Migration/Development/Project/ProjectMigration.hs @@ -0,0 +1,46 @@ +module Wizard.Database.Migration.Development.Project.ProjectMigration where + +import Data.Foldable (traverse_) + +import Shared.Common.Constant.Component +import Shared.Common.Util.Logger +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Database.DAO.Project.ProjectCommentDAO +import Wizard.Database.DAO.Project.ProjectCommentThreadDAO +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectEventDAO +import Wizard.Database.DAO.Project.ProjectFileDAO +import Wizard.Database.DAO.Project.ProjectPermDAO +import Wizard.Database.DAO.Project.ProjectVersionDAO +import Wizard.Database.Migration.Development.Project.Data.ProjectComments +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.S3.Project.ProjectFileS3 + +runMigration = do + logInfo _CMP_MIGRATION "(Project/Project) started" + deleteProjectFiles + purgeBucket + deleteProjectComments + deleteProjectCommentThreads + deleteProjectPerms + deleteProjectEvents + deleteProjects + insertPackage germanyKmPackage + insertProject project1 + insertProjectEvents (fEvents project1Uuid) + traverse_ insertProjectVersion project1Versions + insertProject project2 + insertProjectEvents (fEvents project2Uuid) + traverse_ insertProjectVersion project2Versions + insertProject project3 + insertProjectEvents (fEvents project3Uuid) + traverse_ insertProjectVersion project3Versions + insertProject differentProject + insertProjectCommentThread cmtQ1_t1 + insertProjectComment cmtQ1_t1_1 + insertProjectComment cmtQ1_t1_2 + insertProjectCommentThread cmtQ2_t1 + insertProjectComment cmtQ2_t1_1 + logInfo _CMP_MIGRATION "(Project/Project) ended" diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Project/ProjectMigrationMigration.hs b/wizard-server/src/Wizard/Database/Migration/Development/Project/ProjectMigrationMigration.hs new file mode 100644 index 000000000..0c3dcee6d --- /dev/null +++ b/wizard-server/src/Wizard/Database/Migration/Development/Project/ProjectMigrationMigration.hs @@ -0,0 +1,12 @@ +module Wizard.Database.Migration.Development.Project.ProjectMigrationMigration where + +import Shared.Common.Constant.Component +import Shared.Common.Util.Logger +import Wizard.Database.DAO.Project.ProjectMigrationDAO +import Wizard.Database.Migration.Development.Project.Data.ProjectMigrations + +runMigration = do + logInfo _CMP_MIGRATION "(Migration/Project) started" + deleteProjectMigrations + insertProjectMigration differentProjectMigration + logInfo _CMP_MIGRATION "(Migration/Project) ended" diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Project/ProjectMigrationSchemaMigration.hs b/wizard-server/src/Wizard/Database/Migration/Development/Project/ProjectMigrationSchemaMigration.hs new file mode 100644 index 000000000..07cbb522e --- /dev/null +++ b/wizard-server/src/Wizard/Database/Migration/Development/Project/ProjectMigrationSchemaMigration.hs @@ -0,0 +1,34 @@ +module Wizard.Database.Migration.Development.Project.ProjectMigrationSchemaMigration where + +import Database.PostgreSQL.Simple +import GHC.Int + +import Shared.Common.Util.Logger +import Wizard.Database.DAO.Common +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.ContextLenses () + +dropTables :: AppContextM Int64 +dropTables = do + logInfo _CMP_MIGRATION "(Table/Migration/Project) drop tables" + let sql = "DROP TABLE IF EXISTS project_migration;" + let action conn = execute_ conn sql + runDB action + +createTables :: AppContextM Int64 +createTables = do + logInfo _CMP_MIGRATION "(Table/Migration/Project) create table" + let sql = + "CREATE TABLE project_migration \ + \( \ + \ old_project_uuid uuid NOT NULL, \ + \ new_project_uuid uuid NOT NULL, \ + \ resolved_question_uuids uuid[] NOT NULL, \ + \ tenant_uuid uuid NOT NULL, \ + \ CONSTRAINT project_migration_pk PRIMARY KEY (old_project_uuid, new_project_uuid), \ + \ CONSTRAINT project_migration_old_project_uuid_fk FOREIGN KEY (old_project_uuid) REFERENCES project (uuid) ON DELETE CASCADE, \ + \ CONSTRAINT project_migration_new_project_uuid_fk FOREIGN KEY (new_project_uuid) REFERENCES project (uuid) ON DELETE CASCADE, \ + \ CONSTRAINT project_migration_tenant_uuid_fk FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) ON DELETE CASCADE \ + \);" + let action conn = execute_ conn sql + runDB action diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Project/ProjectSchemaMigration.hs b/wizard-server/src/Wizard/Database/Migration/Development/Project/ProjectSchemaMigration.hs new file mode 100644 index 000000000..d6f91fa3d --- /dev/null +++ b/wizard-server/src/Wizard/Database/Migration/Development/Project/ProjectSchemaMigration.hs @@ -0,0 +1,273 @@ +module Wizard.Database.Migration.Development.Project.ProjectSchemaMigration where + +import Control.Monad.Except (catchError) +import Database.PostgreSQL.Simple +import GHC.Int + +import Shared.Common.Util.Logger +import Wizard.Database.DAO.Common +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.ContextLenses () +import Wizard.S3.Project.ProjectFileS3 + +dropTables :: AppContextM Int64 +dropTables = do + logInfo _CMP_MIGRATION "(Table/Project) drop tables" + let sql = + "DROP TABLE IF EXISTS project_file CASCADE; \ + \DROP TABLE IF EXISTS project_version CASCADE; \ + \DROP TABLE IF EXISTS project_comment CASCADE; \ + \DROP TABLE IF EXISTS project_comment_thread CASCADE; \ + \DROP TABLE IF EXISTS project_perm_group CASCADE; \ + \DROP TABLE IF EXISTS project_perm_user CASCADE; \ + \DROP TABLE IF EXISTS project_event; \ + \DROP TYPE IF EXISTS project_event_type; \ + \DROP TYPE IF EXISTS value_type; \ + \DROP TABLE IF EXISTS project CASCADE; " + let action conn = execute_ conn sql + runDB action + +dropBucket :: AppContextM () +dropBucket = do + catchError purgeBucket (\e -> return ()) + catchError removeBucket (\e -> return ()) + +dropFunctions :: AppContextM Int64 +dropFunctions = do + logInfo _CMP_MIGRATION "(Function/Project) drop functions" + let sql = "DROP FUNCTION IF EXISTS create_persistent_command_from_project_file_delete;" + let action conn = execute_ conn sql + runDB action + +dropTriggers :: AppContextM Int64 +dropTriggers = do + logInfo _CMP_MIGRATION "(Trigger/Project) drop tables" + let sql = "DROP TRIGGER IF EXISTS trigger_on_after_project_file_delete ON project_file;" + let action conn = execute_ conn sql + runDB action + +createTables :: AppContextM () +createTables = do + createProjectTable + createProjectEventTable + createProjectPermUserTable + createProjectPermGroupTable + createProjectCommentThreadTable + createProjectCommentTable + createProjectVersionTable + createProjectFileTable + createPersistentCommandFromProjectFileDeleteFunction + makeBucket + +createProjectTable = do + logInfo _CMP_MIGRATION "(Table/Project) create table" + let sql = + "CREATE TABLE project \ + \( \ + \ uuid uuid NOT NULL, \ + \ name varchar NOT NULL, \ + \ visibility varchar NOT NULL, \ + \ sharing varchar NOT NULL, \ + \ knowledge_model_package_id varchar NOT NULL, \ + \ selected_question_tag_uuids uuid[] NOT NULL, \ + \ document_template_id varchar, \ + \ format_uuid uuid, \ + \ created_by uuid, \ + \ created_at timestamptz NOT NULL, \ + \ updated_at timestamptz NOT NULL, \ + \ description varchar, \ + \ is_template boolean NOT NULL, \ + \ squashed boolean NOT NULL, \ + \ tenant_uuid uuid NOT NULL, \ + \ project_tags text[] NOT NULL, \ + \ CONSTRAINT project_pk PRIMARY KEY (uuid), \ + \ CONSTRAINT project_knowledge_model_package_id_fk FOREIGN KEY (knowledge_model_package_id, tenant_uuid) REFERENCES knowledge_model_package (id, tenant_uuid) ON DELETE CASCADE, \ + \ CONSTRAINT project_document_template_id_fk FOREIGN KEY (document_template_id, tenant_uuid) REFERENCES document_template (id, tenant_uuid) ON DELETE CASCADE, \ + \ CONSTRAINT project_created_by_fk FOREIGN KEY (created_by) REFERENCES user_entity (uuid) ON DELETE SET NULL, \ + \ CONSTRAINT project_tenant_uuid_fk FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) ON DELETE CASCADE \ + \);" + let action conn = execute_ conn sql + runDB action + +createProjectEventTable = do + logInfo _CMP_MIGRATION "(Table/ProjectEvent) create table" + let sql = + "CREATE TYPE project_event_type AS ENUM ('ClearReplyEvent', 'SetReplyEvent', 'SetLabelsEvent', 'SetPhaseEvent'); \ + \CREATE TYPE value_type AS ENUM ('IntegrationReply', 'AnswerReply', 'MultiChoiceReply', 'ItemListReply', 'StringReply', 'ItemSelectReply', 'FileReply'); \ + \CREATE TABLE IF NOT EXISTS project_event \ + \( \ + \ uuid uuid NOT NULL, \ + \ event_type project_event_type NOT NULL, \ + \ path text, \ + \ created_at timestamptz NOT NULL, \ + \ created_by uuid, \ + \ project_uuid uuid NOT NULL, \ + \ tenant_uuid uuid NOT NULL, \ + \ value_type value_type, \ + \ value text[], \ + \ value_id text, \ + \ value_raw jsonb, \ + \ CONSTRAINT project_event_pk PRIMARY KEY (uuid), \ + \ CONSTRAINT project_event_created_by_fk FOREIGN KEY (created_by) REFERENCES user_entity(uuid) ON DELETE SET NULL, \ + \ CONSTRAINT project_event_project_uuid_fk FOREIGN KEY (project_uuid) REFERENCES project(uuid) ON DELETE CASCADE, \ + \ CONSTRAINT project_event_tenant_uuid_fk FOREIGN KEY (tenant_uuid) REFERENCES tenant(uuid) ON DELETE CASCADE \ + \);" + let action conn = execute_ conn sql + runDB action + +createProjectPermUserTable = do + logInfo _CMP_MIGRATION "(Table/ProjectPermUser) create table" + let sql = + "CREATE TABLE project_perm_user \ + \( \ + \ project_uuid uuid NOT NULL, \ + \ user_uuid uuid NOT NULL, \ + \ perms text[] NOT NULL, \ + \ tenant_uuid uuid NOT NULL, \ + \ CONSTRAINT project_perm_user_pk PRIMARY KEY (user_uuid, project_uuid), \ + \ CONSTRAINT project_perm_user_project_uuid_fk FOREIGN KEY (project_uuid) REFERENCES project (uuid) ON DELETE CASCADE, \ + \ CONSTRAINT project_perm_user_user_uuid_fk FOREIGN KEY (user_uuid) REFERENCES user_entity (uuid) ON DELETE CASCADE, \ + \ CONSTRAINT project_perm_user_tenant_uuid_fk FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) ON DELETE CASCADE \ + \);" + let action conn = execute_ conn sql + runDB action + +createProjectPermGroupTable = do + logInfo _CMP_MIGRATION "(Table/ProjectPermGroup) create table" + let sql = + "CREATE TABLE project_perm_group \ + \( \ + \ project_uuid uuid NOT NULL, \ + \ user_group_uuid uuid NOT NULL, \ + \ perms text[] NOT NULL, \ + \ tenant_uuid uuid NOT NULL, \ + \ CONSTRAINT project_perm_group_pk PRIMARY KEY (user_group_uuid, project_uuid), \ + \ CONSTRAINT project_perm_group_project_uuid_fk FOREIGN KEY (project_uuid) REFERENCES project (uuid) ON DELETE CASCADE, \ + \ CONSTRAINT project_perm_group_user_group_uuid_fk FOREIGN KEY (user_group_uuid) REFERENCES user_group (uuid) ON DELETE CASCADE, \ + \ CONSTRAINT project_perm_group_tenant_uuid_fk FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) ON DELETE CASCADE \ + \);" + let action conn = execute_ conn sql + runDB action + +createProjectCommentThreadTable = do + logInfo _CMP_MIGRATION "(Table/ProjectCommentThread) create table" + let sql = + "CREATE TABLE project_comment_thread \ + \( \ + \ uuid uuid NOT NULL, \ + \ path text NOT NULL, \ + \ resolved bool NOT NULL, \ + \ private bool NOT NULL, \ + \ project_uuid uuid NOT NULL, \ + \ created_by uuid, \ + \ created_at timestamptz NOT NULL, \ + \ updated_at timestamptz NOT NULL, \ + \ tenant_uuid uuid NOT NULL, \ + \ assigned_to uuid, \ + \ assigned_by uuid, \ + \ notification_required bool NOT NULL DEFAULT false, \ + \ CONSTRAINT project_comment_thread_pk PRIMARY KEY (uuid), \ + \ CONSTRAINT project_comment_thread_project_uuid FOREIGN KEY (project_uuid) REFERENCES project (uuid) ON DELETE CASCADE, \ + \ CONSTRAINT project_comment_thread_assigned_to FOREIGN KEY (assigned_to) REFERENCES user_entity (uuid) ON DELETE SET NULL, \ + \ CONSTRAINT project_comment_thread_assigned_by FOREIGN KEY (assigned_by) REFERENCES user_entity (uuid) ON DELETE SET NULL, \ + \ CONSTRAINT project_comment_thread_tenant_uuid FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) ON DELETE CASCADE \ + \);" + let action conn = execute_ conn sql + runDB action + +createProjectCommentTable = do + logInfo _CMP_MIGRATION "(Table/ProjectComment) create table" + let sql = + "CREATE TABLE project_comment \ + \( \ + \ uuid uuid NOT NULL, \ + \ text text NOT NULL, \ + \ comment_thread_uuid uuid, \ + \ created_by uuid, \ + \ created_at timestamptz NOT NULL, \ + \ updated_at timestamptz NOT NULL, \ + \ tenant_uuid uuid NOT NULL, \ + \ CONSTRAINT project_comment_pk PRIMARY KEY (uuid), \ + \ CONSTRAINT project_comment_comment_thread_uuid FOREIGN KEY (comment_thread_uuid) REFERENCES project_comment_thread (uuid) ON DELETE CASCADE, \ + \ CONSTRAINT project_comment_tenant_uuid FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) ON DELETE CASCADE \ + \);" + let action conn = execute_ conn sql + runDB action + +createProjectVersionTable = do + logInfo _CMP_MIGRATION "(Table/ProjectVersion) create table" + let sql = + "CREATE TABLE project_version \ + \( \ + \ uuid uuid NOT NULL, \ + \ name varchar NOT NULL, \ + \ description varchar, \ + \ event_uuid uuid NOT NULL, \ + \ project_uuid uuid NOT NULL, \ + \ tenant_uuid uuid NOT NULL, \ + \ created_by uuid, \ + \ created_at timestamptz NOT NULL, \ + \ updated_at timestamptz NOT NULL, \ + \ CONSTRAINT project_version_pk PRIMARY KEY (uuid), \ + \ CONSTRAINT project_version_event_uuid_fk FOREIGN KEY (event_uuid) REFERENCES project_event (uuid) ON DELETE CASCADE, \ + \ CONSTRAINT project_version_project_uuid_fk FOREIGN KEY (project_uuid) REFERENCES project (uuid) ON DELETE CASCADE, \ + \ CONSTRAINT project_version_tenant_uuid_fk FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) ON DELETE CASCADE, \ + \ CONSTRAINT project_version_created_by_fk FOREIGN KEY (created_by) REFERENCES user_entity (uuid) ON DELETE SET NULL \ + \);" + let action conn = execute_ conn sql + runDB action + +createProjectFileTable = do + logInfo _CMP_MIGRATION "(Table/ProjectFile) create table" + let sql = + "CREATE TABLE project_file \ + \( \ + \ uuid uuid NOT NULL, \ + \ file_name varchar NOT NULL, \ + \ content_type varchar NOT NULL, \ + \ file_size bigint NOT NULL, \ + \ project_uuid uuid NOT NULL, \ + \ created_by uuid, \ + \ tenant_uuid uuid NOT NULL, \ + \ created_at timestamptz NOT NULL, \ + \ CONSTRAINT project_file_pk PRIMARY KEY (uuid), \ + \ CONSTRAINT project_file_project_uuid_fk FOREIGN KEY (project_uuid) REFERENCES project (uuid) ON DELETE CASCADE, \ + \ CONSTRAINT project_file_created_by_fk FOREIGN KEY (created_by) REFERENCES user_entity (uuid) ON DELETE SET NULL, \ + \ CONSTRAINT project_file_tenant_uuid_fk FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) ON DELETE CASCADE \ + \);" + let action conn = execute_ conn sql + runDB action + +createFunctions :: AppContextM Int64 +createFunctions = do + logInfo _CMP_MIGRATION "(Function/Project) create functions" + createPersistentCommandFromProjectFileDeleteFunction + +createPersistentCommandFromProjectFileDeleteFunction = do + let sql = + "CREATE OR REPLACE FUNCTION create_persistent_command_from_project_file_delete() \ + \ RETURNS TRIGGER AS \ + \$$ \ + \BEGIN \ + \ PERFORM create_persistent_command( \ + \ 'project_file', \ + \ 'deleteFromS3', \ + \ jsonb_build_object('projectUuid', OLD.project_uuid, 'fileUuid', OLD.uuid), \ + \ OLD.tenant_uuid); \ + \ RETURN OLD; \ + \END; \ + \$$ LANGUAGE plpgsql;" + let action conn = execute_ conn sql + runDB action + +createTriggers :: AppContextM Int64 +createTriggers = do + logInfo _CMP_MIGRATION "(Trigger/Project) create triggers" + let sql = + "CREATE OR REPLACE TRIGGER trigger_on_after_project_file_delete \ + \ AFTER DELETE \ + \ ON project_file \ + \ FOR EACH ROW \ + \EXECUTE FUNCTION create_persistent_command_from_project_file_delete();" + let action conn = execute_ conn sql + runDB action diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/MigratorStates.hs b/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/MigratorStates.hs deleted file mode 100644 index 7f01dfd40..000000000 --- a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/MigratorStates.hs +++ /dev/null @@ -1,135 +0,0 @@ -module Wizard.Database.Migration.Development.Questionnaire.Data.MigratorStates where - -import qualified Data.Map.Strict as M - -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.KnowledgeModels -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Questions -import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel -import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackage -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateChangeDTO -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateCreateDTO -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailQuestionnaireDTO -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Database.Migration.Development.Tenant.Data.Tenants -import Wizard.Model.Questionnaire.MigratorState -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireContent -import Wizard.Model.Tenant.Tenant -import Wizard.Service.Questionnaire.QuestionnaireMapper - -nlQtnMigrationState :: MigratorState -nlQtnMigrationState = - MigratorState - { oldQuestionnaireUuid = nlQtnMigrationStateDto.oldQuestionnaire.uuid - , newQuestionnaireUuid = nlQtnMigrationStateDto.newQuestionnaire.uuid - , resolvedQuestionUuids = [question2.uuid] - , tenantUuid = defaultTenant.uuid - } - -nlQtnMigrationStateDto :: MigratorStateDTO -nlQtnMigrationStateDto = - MigratorStateDTO - { oldQuestionnaire = - toDetailQuestionnaireDTO - (toDetailQuestionnaire questionnaire4 (Just questionnaire4Upgraded.uuid) [] 0 0) - M.empty - M.empty - km1Netherlands - questionnaire4Ctn.phaseUuid - questionnaire4Ctn.replies - questionnaire4Ctn.labels - , newQuestionnaire = - toDetailQuestionnaireDTO - (toDetailQuestionnaire questionnaire4Upgraded Nothing [] 0 0) - M.empty - M.empty - km1NetherlandsV2 - questionnaire4Ctn.phaseUuid - questionnaire4Ctn.replies - questionnaire4Ctn.labels - , resolvedQuestionUuids = [question2.uuid] - , tenantUuid = defaultTenant.uuid - } - -nlQtnMigrationStateVisibleViewDto :: MigratorStateDTO -nlQtnMigrationStateVisibleViewDto = - MigratorStateDTO - { oldQuestionnaire = - toDetailQuestionnaireDTO - (toDetailQuestionnaire questionnaire4VisibleView (Just questionnaire4Upgraded.uuid) [] 0 0) - M.empty - M.empty - km1Netherlands - questionnaire4Ctn.phaseUuid - questionnaire4Ctn.replies - questionnaire4Ctn.labels - , newQuestionnaire = - toDetailQuestionnaireDTO - (toDetailQuestionnaire questionnaire4VisibleViewUpgraded Nothing [] 0 0) - M.empty - M.empty - km1NetherlandsV2 - questionnaire4Ctn.phaseUuid - questionnaire4Ctn.replies - questionnaire4Ctn.labels - , resolvedQuestionUuids = nlQtnMigrationStateDto.resolvedQuestionUuids - , tenantUuid = defaultTenant.uuid - } - -nlQtnMigrationStateVisibleEditDto :: MigratorStateDTO -nlQtnMigrationStateVisibleEditDto = - MigratorStateDTO - { oldQuestionnaire = - toDetailQuestionnaireDTO - (toDetailQuestionnaire questionnaire4VisibleEdit (Just questionnaire4Upgraded.uuid) [] 0 0) - M.empty - M.empty - km1Netherlands - questionnaire4Ctn.phaseUuid - questionnaire4Ctn.replies - questionnaire4Ctn.labels - , newQuestionnaire = - toDetailQuestionnaireDTO - (toDetailQuestionnaire questionnaire4VisibleEditUpgraded Nothing [] 0 0) - M.empty - M.empty - km1NetherlandsV2 - questionnaire4Ctn.phaseUuid - questionnaire4Ctn.replies - questionnaire4Ctn.labels - , resolvedQuestionUuids = nlQtnMigrationStateDto.resolvedQuestionUuids - , tenantUuid = defaultTenant.uuid - } - -nlQtnMigrationStateDtoEdited :: MigratorStateDTO -nlQtnMigrationStateDtoEdited = - MigratorStateDTO - { oldQuestionnaire = nlQtnMigrationStateDto.oldQuestionnaire - , newQuestionnaire = nlQtnMigrationStateDto.newQuestionnaire - , resolvedQuestionUuids = [question2.uuid, question3.uuid] - , tenantUuid = nlQtnMigrationStateDto.tenantUuid - } - -migratorStateCreate :: MigratorStateCreateDTO -migratorStateCreate = - MigratorStateCreateDTO - { targetKnowledgeModelPackageId = netherlandsKmPackageV2.pId - , targetTagUuids = questionnaire4Upgraded.selectedQuestionTagUuids - } - -migratorStateChange :: MigratorStateChangeDTO -migratorStateChange = - MigratorStateChangeDTO - { resolvedQuestionUuids = nlQtnMigrationStateDtoEdited.resolvedQuestionUuids - } - -differentQtnMigrationState :: MigratorState -differentQtnMigrationState = - MigratorState - { oldQuestionnaireUuid = differentQuestionnaire.uuid - , newQuestionnaireUuid = differentQuestionnaire.uuid - , resolvedQuestionUuids = [question2.uuid] - , tenantUuid = differentTenant.uuid - } diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/QuestionnaireActions.hs b/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/QuestionnaireActions.hs deleted file mode 100644 index 13fc2660f..000000000 --- a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/QuestionnaireActions.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireActions where - -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventChangeDTO -import Wizard.Api.Resource.Websocket.QuestionnaireActionDTO -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Database.Migration.Development.User.Data.Users -import Wizard.Service.Questionnaire.Event.QuestionnaireEventMapper - -ensureOnlineUserAction :: ClientQuestionnaireActionDTO -ensureOnlineUserAction = - SetContent_ClientQuestionnaireActionDTO . SetReplyEventChangeDTO' $ - toSetReplyEventChangeDTO (sre_rQ1 questionnaire1Uuid) - -setUserListAction :: ServerQuestionnaireActionDTO -setUserListAction = SetUserList_ServerQuestionnaireActionDTO [userAlbertOnlineInfo] diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/QuestionnaireCommands.hs b/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/QuestionnaireCommands.hs deleted file mode 100644 index f241ca6de..000000000 --- a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/QuestionnaireCommands.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireCommands where - -import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplates -import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplate -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackage -import Wizard.Database.Migration.Development.User.Data.Users -import Wizard.Model.User.User -import WizardLib.Public.Model.PersistentCommand.Questionnaire.CreateQuestionnaireCommand - -command1 :: CreateQuestionnaireCommand -command1 = - CreateQuestionnaireCommand - { name = "Questionnaire 1" - , emails = - [ userAlbert.email - , userNikola.email - ] - , knowledgeModelPackageId = netherlandsKmPackageV2.pId - , documentTemplateId = Just wizardDocumentTemplate.tId - } - -command2 :: CreateQuestionnaireCommand -command2 = - CreateQuestionnaireCommand - { name = "Questionnaire 2" - , emails = - [ userAlbert.email - , userIsaac.email - ] - , knowledgeModelPackageId = netherlandsKmPackageV2.pId - , documentTemplateId = Nothing - } diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/QuestionnaireComments.hs b/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/QuestionnaireComments.hs deleted file mode 100644 index 6fa09362f..000000000 --- a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/QuestionnaireComments.hs +++ /dev/null @@ -1,192 +0,0 @@ -module Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireComments where - -import Control.Monad.Reader (liftIO) -import qualified Data.Map.Strict as M -import Data.Maybe (fromJust) -import Data.Time -import qualified Data.UUID as U - -import Shared.Common.Constant.Tenant -import Shared.Common.Util.Date -import Shared.Common.Util.Uuid -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Chapters -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Questions -import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel -import Wizard.Database.Migration.Development.User.Data.Users -import Wizard.Model.Questionnaire.QuestionnaireComment -import Wizard.Model.Questionnaire.QuestionnaireCommentList -import Wizard.Model.Questionnaire.QuestionnaireCommentThreadAssigned -import Wizard.Model.Questionnaire.QuestionnaireUtil -import Wizard.Model.User.User -import Wizard.Service.Questionnaire.Comment.QuestionnaireCommentMapper -import Wizard.Service.User.UserMapper - -qtnThreadsDto :: M.Map String [QuestionnaireCommentThreadList] -qtnThreadsDto = M.fromList [(cmtQ1_path, [cmtQ1_t1Dto]), (cmtQ2_path, [cmtQ2_t1Dto])] - -cmtQ1_path :: String -cmtQ1_path = createReplyKey [chapter1.uuid, question1.uuid] - -cmtQ1_t1 :: QuestionnaireCommentThread -cmtQ1_t1 = - QuestionnaireCommentThread - { uuid = u' "f1de85a9-7f22-4d0c-bc23-3315cc4c85d7" - , path = cmtQ1_path - , resolved = False - , comments = [cmtQ1_t1_1, cmtQ1_t1_2] - , private = False - , questionnaireUuid = u' "af984a75-56e3-49f8-b16f-d6b99599910a" - , tenantUuid = defaultTenantUuid - , assignedTo = Nothing - , assignedBy = Nothing - , notificationRequired = False - , createdBy = Just userAlbert.uuid - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 - , updatedAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 - } - -create_cmtQ1_t1 :: U.UUID -> IO QuestionnaireCommentThread -create_cmtQ1_t1 qtnUuid = do - threadUuid <- liftIO generateUuid - return $ - QuestionnaireCommentThread - { uuid = threadUuid - , path = cmtQ1_path - , resolved = False - , comments = [] - , private = False - , questionnaireUuid = qtnUuid - , tenantUuid = defaultTenantUuid - , assignedTo = Nothing - , assignedBy = Nothing - , notificationRequired = False - , createdBy = Just userAlbert.uuid - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 - , updatedAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 - } - -cmtQ1_t1Dto :: QuestionnaireCommentThreadList -cmtQ1_t1Dto = toCommentThreadList cmtQ1_t1 Nothing (Just userAlbert) [cmtQ1_t1_1Dto, cmtQ1_t1_2Dto] - -cmtQ1_t1WithEditedCmt :: QuestionnaireCommentThread -cmtQ1_t1WithEditedCmt = cmtQ1_t1 {comments = [cmtQ1_t1_1Edited, cmtQ1_t1_2]} - -cmtQ1_t1WithDeletedCmt :: QuestionnaireCommentThread -cmtQ1_t1WithDeletedCmt = cmtQ1_t1 {comments = [cmtQ1_t1_2]} - -cmtQ1_t1Resolved :: QuestionnaireCommentThread -cmtQ1_t1Resolved = cmtQ1_t1 {resolved = True} - -cmtQ1_t1_1 :: QuestionnaireComment -cmtQ1_t1_1 = - QuestionnaireComment - { uuid = u' "a2d4a1f6-6148-43a0-98d1-158176863a3c" - , text = "1st comment to 1st question" - , threadUuid = cmtQ1_t1.uuid - , tenantUuid = defaultTenantUuid - , createdBy = Just userAlbert.uuid - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 - , updatedAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 - } - -create_cmtQ1_t1_1 :: U.UUID -> IO QuestionnaireComment -create_cmtQ1_t1_1 threadUuid = do - commentUuid <- liftIO generateUuid - return $ - QuestionnaireComment - { uuid = commentUuid - , text = "1st comment to 1st question" - , threadUuid = threadUuid - , tenantUuid = defaultTenantUuid - , createdBy = Just userAlbert.uuid - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 - , updatedAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 - } - -cmtQ1_t1_1Dto :: QuestionnaireCommentList -cmtQ1_t1_1Dto = toCommentList cmtQ1_t1_1 (Just userAlbert) - -cmtQ1_t1_1Edited :: QuestionnaireComment -cmtQ1_t1_1Edited = cmtQ1_t1_1 {text = "EDITED: 1st comment to 1st question"} - -cmtQ1_t1_2 :: QuestionnaireComment -cmtQ1_t1_2 = - QuestionnaireComment - { uuid = u' "a9861528-7ca9-48d8-917c-3bf9f240bdf3" - , text = "2nd comment to 1st question" - , threadUuid = cmtQ1_t1.uuid - , tenantUuid = defaultTenantUuid - , createdBy = Just userAlbert.uuid - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 - , updatedAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 - } - -create_cmtQ1_t1_2 :: U.UUID -> IO QuestionnaireComment -create_cmtQ1_t1_2 threadUuid = do - commentUuid <- liftIO generateUuid - return $ - QuestionnaireComment - { uuid = commentUuid - , text = "2nd comment to 1st question" - , threadUuid = threadUuid - , tenantUuid = defaultTenantUuid - , createdBy = Just userAlbert.uuid - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 - , updatedAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 - } - -cmtQ1_t1_2Dto :: QuestionnaireCommentList -cmtQ1_t1_2Dto = toCommentList cmtQ1_t1_2 (Just userAlbert) - -cmtQ2_path :: String -cmtQ2_path = createReplyKey [chapter1.uuid, question2.uuid] - -cmtQ2_t1 :: QuestionnaireCommentThread -cmtQ2_t1 = - QuestionnaireCommentThread - { uuid = u' "2b8681dc-54b5-4bc4-bf9f-a1ec6ad37823" - , path = cmtQ2_path - , resolved = False - , comments = [cmtQ2_t1_1] - , private = False - , questionnaireUuid = u' "af984a75-56e3-49f8-b16f-d6b99599910a" - , tenantUuid = defaultTenantUuid - , assignedTo = Nothing - , assignedBy = Nothing - , notificationRequired = False - , createdBy = Just userAlbert.uuid - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 - , updatedAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 - } - -cmtQ2_t1Dto :: QuestionnaireCommentThreadList -cmtQ2_t1Dto = toCommentThreadList cmtQ2_t1 Nothing (Just userAlbert) [cmtQ2_t1_1Dto] - -cmtQ2_t1_1 :: QuestionnaireComment -cmtQ2_t1_1 = - QuestionnaireComment - { uuid = u' "e9827a92-ecfd-4410-8809-ea761fe03bd3" - , text = "1nd comment to 2st question" - , threadUuid = cmtQ2_t1.uuid - , tenantUuid = defaultTenantUuid - , createdBy = Just userAlbert.uuid - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 - , updatedAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 - } - -cmtQ2_t1_1Dto :: QuestionnaireCommentList -cmtQ2_t1_1Dto = toCommentList cmtQ2_t1_1 (Just userAlbert) - -cmtAssigned :: QuestionnaireCommentThreadAssigned -cmtAssigned = - QuestionnaireCommentThreadAssigned - { questionnaireUuid = u' "af984a75-56e3-49f8-b16f-d6b99599910a" - , questionnaireName = "My Private Questionnaire" - , commentThreadUuid = cmtQ1_t1.uuid - , path = cmtQ1_t1.path - , resolved = cmtQ1_t1.resolved - , private = cmtQ1_t1.private - , text = cmtQ1_t1_1.text - , createdBy = Just . toSuggestion . toSimple $ userAlbert - , updatedAt = dt' 2018 1 21 - } diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/QuestionnaireEvents.hs b/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/QuestionnaireEvents.hs deleted file mode 100644 index e1f41e626..000000000 --- a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/QuestionnaireEvents.hs +++ /dev/null @@ -1,606 +0,0 @@ -module Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents where - -import qualified Data.List as L -import Data.Maybe (fromJust) -import Data.Time -import qualified Data.UUID as U - -import Shared.Common.Constant.Tenant -import Shared.Common.Util.String -import Shared.Common.Util.Uuid -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Phases -import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventChangeDTO -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventDTO -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireComments -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireLabels -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireReplies -import Wizard.Database.Migration.Development.User.Data.Users -import Wizard.Model.Questionnaire.QuestionnaireComment -import Wizard.Model.Questionnaire.QuestionnaireEvent -import Wizard.Model.Questionnaire.QuestionnaireEventList -import Wizard.Model.Questionnaire.QuestionnaireReply -import Wizard.Model.User.User -import Wizard.Service.Questionnaire.Event.QuestionnaireEventMapper -import Wizard.Service.User.UserMapper -import WizardLib.Public.Model.User.UserSuggestion - -fEvents :: U.UUID -> [QuestionnaireEvent] -fEvents qtnUuid = - [ sre_rQ1' qtnUuid - , sre_rQ2' qtnUuid - , sre_rQ2_aYes_fuQ1' qtnUuid - , sre_rQ3' qtnUuid - , sre_rQ4' qtnUuid - , sre_rQ4_it1_q5' qtnUuid - , sre_rQ4_it1_q5_it1_question7' qtnUuid - , sre_rQ4_it1_q5_it1_question8' qtnUuid - , sre_rQ4_it1_q6' qtnUuid - , sre_rQ4_it2_q5' qtnUuid - , sre_rQ4_it2_q6' qtnUuid - , sre_rQ9' qtnUuid - , sre_rQ10' qtnUuid - , sre_rQ11' qtnUuid - , sphse_1' qtnUuid - , slble_rQ1' qtnUuid - ] - -fEventsDto :: U.UUID -> [QuestionnaireEventDTO] -fEventsDto qtnUuid = fmap (\event -> toEventDTO event (Just userAlbert)) (fEvents qtnUuid) - -fEventsList :: U.UUID -> [QuestionnaireEventList] -fEventsList qtnUuid = fmap (\event -> toEventList event (Just userAlbert)) (fEvents qtnUuid) - -fEventsWithUpdated :: U.UUID -> [QuestionnaireEvent] -fEventsWithUpdated qtnUuid = fEvents qtnUuid ++ [sre_rQ1Updated' qtnUuid] - -fEventsWithDeleted :: U.UUID -> [QuestionnaireEvent] -fEventsWithDeleted qtnUuid = fEvents qtnUuid ++ [cre_rQ1' qtnUuid] - -fEventsEdited :: U.UUID -> [QuestionnaireEvent] -fEventsEdited qtnUuid = fEvents qtnUuid ++ [slble_rQ2' qtnUuid] - -sre_rQ1' :: U.UUID -> QuestionnaireEvent -sre_rQ1' = SetReplyEvent' . sre_rQ1 - -sre_rQ1 :: U.UUID -> SetReplyEvent -sre_rQ1 qtnUuid = - SetReplyEvent - { uuid = createEventUuid qtnUuid "12bc42247314" - , path = fst rQ1 - , value = (snd rQ1).value - , questionnaireUuid = qtnUuid - , tenantUuid = defaultTenantUuid - , createdBy = fmap (.uuid) $ (snd rQ1).createdBy - , createdAt = (snd rQ1).createdAt - } - -sre_rQ1Updated' :: U.UUID -> QuestionnaireEvent -sre_rQ1Updated' = SetReplyEvent' . sre_rQ1Updated - -sre_rQ1Updated :: U.UUID -> SetReplyEvent -sre_rQ1Updated qtnUuid = - SetReplyEvent - { uuid = createEventUuid qtnUuid "ede0aa4d6c5a" - , path = fst rQ1Updated - , value = (snd rQ1Updated).value - , questionnaireUuid = qtnUuid - , tenantUuid = defaultTenantUuid - , createdBy = fmap (.uuid) $ (snd rQ1Updated).createdBy - , createdAt = (snd rQ1Updated).createdAt - } - -sre_rQ1Dto' :: U.UUID -> QuestionnaireEventDTO -sre_rQ1Dto' qtnUuid = toEventDTO (sre_rQ1' qtnUuid) (Just userAlbert) - -sre_rQ2' :: U.UUID -> QuestionnaireEvent -sre_rQ2' = SetReplyEvent' . sre_rQ2 - -sre_rQ2 :: U.UUID -> SetReplyEvent -sre_rQ2 qtnUuid = - SetReplyEvent - { uuid = createEventUuid qtnUuid "5dc60233046e" - , path = fst rQ2 - , value = (snd rQ2).value - , questionnaireUuid = qtnUuid - , tenantUuid = defaultTenantUuid - , createdBy = fmap (.uuid) $ (snd rQ2).createdBy - , createdAt = (snd rQ2).createdAt - } - -sre_rQ2_aYes_fuQ1' :: U.UUID -> QuestionnaireEvent -sre_rQ2_aYes_fuQ1' = SetReplyEvent' . sre_rQ2_aYes_fuQ1 - -sre_rQ2_aYes_fuQ1 :: U.UUID -> SetReplyEvent -sre_rQ2_aYes_fuQ1 qtnUuid = - SetReplyEvent - { uuid = createEventUuid qtnUuid "c4db3ec5fadd" - , path = fst rQ2_aYes_fuQ1 - , value = (snd rQ2_aYes_fuQ1).value - , questionnaireUuid = qtnUuid - , tenantUuid = defaultTenantUuid - , createdBy = fmap (.uuid) $ (snd rQ2_aYes_fuQ1).createdBy - , createdAt = (snd rQ2_aYes_fuQ1).createdAt - } - -sre_rQ3' :: U.UUID -> QuestionnaireEvent -sre_rQ3' = SetReplyEvent' . sre_rQ3 - -sre_rQ3 :: U.UUID -> SetReplyEvent -sre_rQ3 qtnUuid = - SetReplyEvent - { uuid = createEventUuid qtnUuid "cf42760517d7" - , path = fst rQ3 - , value = (snd rQ3).value - , questionnaireUuid = qtnUuid - , tenantUuid = defaultTenantUuid - , createdBy = fmap (.uuid) $ (snd rQ3).createdBy - , createdAt = (snd rQ3).createdAt - } - -sre_rQ4' :: U.UUID -> QuestionnaireEvent -sre_rQ4' = SetReplyEvent' . sre_rQ4 - -sre_rQ4 :: U.UUID -> SetReplyEvent -sre_rQ4 qtnUuid = - SetReplyEvent - { uuid = createEventUuid qtnUuid "52d6816a471c" - , path = fst rQ4 - , value = (snd rQ4).value - , questionnaireUuid = qtnUuid - , tenantUuid = defaultTenantUuid - , createdBy = fmap (.uuid) $ (snd rQ4).createdBy - , createdAt = (snd rQ4).createdAt - } - -sre_rQ4_it1_q5' :: U.UUID -> QuestionnaireEvent -sre_rQ4_it1_q5' = SetReplyEvent' . sre_rQ4_it1_q5 - -sre_rQ4_it1_q5 :: U.UUID -> SetReplyEvent -sre_rQ4_it1_q5 qtnUuid = - SetReplyEvent - { uuid = createEventUuid qtnUuid "51954a9feb0b" - , path = fst rQ4_it1_q5 - , value = (snd rQ4_it1_q5).value - , questionnaireUuid = qtnUuid - , tenantUuid = defaultTenantUuid - , createdBy = fmap (.uuid) $ (snd rQ4_it1_q5).createdBy - , createdAt = (snd rQ4_it1_q5).createdAt - } - -sre_rQ4_it1_q5_it1_question7' :: U.UUID -> QuestionnaireEvent -sre_rQ4_it1_q5_it1_question7' = SetReplyEvent' . sre_rQ4_it1_q5_it1_question7 - -sre_rQ4_it1_q5_it1_question7 :: U.UUID -> SetReplyEvent -sre_rQ4_it1_q5_it1_question7 qtnUuid = - SetReplyEvent - { uuid = createEventUuid qtnUuid "7927b71393bc" - , path = fst rQ4_it1_q5_it1_question7 - , value = (snd rQ4_it1_q5_it1_question7).value - , questionnaireUuid = qtnUuid - , tenantUuid = defaultTenantUuid - , createdBy = fmap (.uuid) $ (snd rQ4_it1_q5_it1_question7).createdBy - , createdAt = (snd rQ4_it1_q5_it1_question7).createdAt - } - -sre_rQ4_it1_q5_it1_question8' :: U.UUID -> QuestionnaireEvent -sre_rQ4_it1_q5_it1_question8' = SetReplyEvent' . sre_rQ4_it1_q5_it1_question8 - -sre_rQ4_it1_q5_it1_question8 :: U.UUID -> SetReplyEvent -sre_rQ4_it1_q5_it1_question8 qtnUuid = - SetReplyEvent - { uuid = createEventUuid qtnUuid "a8b3312ce8be" - , path = fst rQ4_it1_q5_it1_question8 - , value = (snd rQ4_it1_q5_it1_question8).value - , questionnaireUuid = qtnUuid - , tenantUuid = defaultTenantUuid - , createdBy = fmap (.uuid) $ (snd rQ4_it1_q5_it1_question8).createdBy - , createdAt = (snd rQ4_it1_q5_it1_question8).createdAt - } - -sre_rQ4_it1_q6' :: U.UUID -> QuestionnaireEvent -sre_rQ4_it1_q6' = SetReplyEvent' . sre_rQ4_it1_q6 - -sre_rQ4_it1_q6 :: U.UUID -> SetReplyEvent -sre_rQ4_it1_q6 qtnUuid = - SetReplyEvent - { uuid = createEventUuid qtnUuid "d270a461c2bb" - , path = fst rQ4_it1_q6 - , value = (snd rQ4_it1_q6).value - , questionnaireUuid = qtnUuid - , tenantUuid = defaultTenantUuid - , createdBy = fmap (.uuid) $ (snd rQ4_it1_q6).createdBy - , createdAt = (snd rQ4_it1_q6).createdAt - } - -sre_rQ4_it2_q5' :: U.UUID -> QuestionnaireEvent -sre_rQ4_it2_q5' = SetReplyEvent' . sre_rQ4_it2_q5 - -sre_rQ4_it2_q5 :: U.UUID -> SetReplyEvent -sre_rQ4_it2_q5 qtnUuid = - SetReplyEvent - { uuid = createEventUuid qtnUuid "e30b5086cea2" - , path = fst rQ4_it2_q5 - , value = (snd rQ4_it2_q5).value - , questionnaireUuid = qtnUuid - , tenantUuid = defaultTenantUuid - , createdBy = fmap (.uuid) $ (snd rQ4_it2_q5).createdBy - , createdAt = (snd rQ4_it2_q5).createdAt - } - -sre_rQ4_it2_q6' :: U.UUID -> QuestionnaireEvent -sre_rQ4_it2_q6' = SetReplyEvent' . sre_rQ4_it2_q6 - -sre_rQ4_it2_q6 :: U.UUID -> SetReplyEvent -sre_rQ4_it2_q6 qtnUuid = - SetReplyEvent - { uuid = createEventUuid qtnUuid "8a83232defb2" - , path = fst rQ4_it2_q6 - , value = (snd rQ4_it2_q6).value - , questionnaireUuid = qtnUuid - , tenantUuid = defaultTenantUuid - , createdBy = fmap (.uuid) $ (snd rQ4_it2_q6).createdBy - , createdAt = (snd rQ4_it2_q6).createdAt - } - -sre_rQ9' :: U.UUID -> QuestionnaireEvent -sre_rQ9' = SetReplyEvent' . sre_rQ9 - -sre_rQ9 :: U.UUID -> SetReplyEvent -sre_rQ9 qtnUuid = - SetReplyEvent - { uuid = createEventUuid qtnUuid "064a51dfe89a" - , path = fst rQ9 - , value = (snd rQ9).value - , questionnaireUuid = qtnUuid - , tenantUuid = defaultTenantUuid - , createdBy = fmap (.uuid) $ (snd rQ9).createdBy - , createdAt = (snd rQ9).createdAt - } - -sre_rQ10' :: U.UUID -> QuestionnaireEvent -sre_rQ10' = SetReplyEvent' . sre_rQ10 - -sre_rQ10 :: U.UUID -> SetReplyEvent -sre_rQ10 qtnUuid = - SetReplyEvent - { uuid = createEventUuid qtnUuid "40df71a81b92" - , path = fst rQ10 - , value = (snd rQ10).value - , questionnaireUuid = qtnUuid - , tenantUuid = defaultTenantUuid - , createdBy = fmap (.uuid) $ (snd rQ10).createdBy - , createdAt = (snd rQ10).createdAt - } - -sre_rQ11' :: U.UUID -> QuestionnaireEvent -sre_rQ11' = SetReplyEvent' . sre_rQ11 - -sre_rQ11 :: U.UUID -> SetReplyEvent -sre_rQ11 qtnUuid = - SetReplyEvent - { uuid = createEventUuid qtnUuid "c4f4481d5670" - , path = fst rQ11 - , value = (snd rQ11).value - , questionnaireUuid = qtnUuid - , tenantUuid = defaultTenantUuid - , createdBy = fmap (.uuid) $ (snd rQ11).createdBy - , createdAt = (snd rQ11).createdAt - } - -cre_rQ1' :: U.UUID -> QuestionnaireEvent -cre_rQ1' = ClearReplyEvent' . cre_rQ1 - -cre_rQ1 :: U.UUID -> ClearReplyEvent -cre_rQ1 qtnUuid = - ClearReplyEvent - { uuid = createEventUuid qtnUuid "c513e14de55e" - , path = fst rQ1 - , questionnaireUuid = qtnUuid - , tenantUuid = defaultTenantUuid - , createdBy = Just userAlbert.uuid - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 17 - } - -sphse_1' :: U.UUID -> QuestionnaireEvent -sphse_1' = SetPhaseEvent' . sphse_1 - -sphse_1 :: U.UUID -> SetPhaseEvent -sphse_1 qtnUuid = - SetPhaseEvent - { uuid = createEventUuid qtnUuid "ee411f0005d3" - , phaseUuid = Just $ phase1.uuid - , questionnaireUuid = qtnUuid - , tenantUuid = defaultTenantUuid - , createdBy = Just userAlbert.uuid - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 18 - } - -sphse_2' :: U.UUID -> QuestionnaireEvent -sphse_2' = SetPhaseEvent' . sphse_2 - -sphse_2 :: U.UUID -> SetPhaseEvent -sphse_2 qtnUuid = - SetPhaseEvent - { uuid = createEventUuid qtnUuid "43eae0986894" - , phaseUuid = Just $ phase2.uuid - , questionnaireUuid = qtnUuid - , tenantUuid = defaultTenantUuid - , createdBy = Just userAlbert.uuid - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 19 - } - -sphse_3' :: U.UUID -> QuestionnaireEvent -sphse_3' = SetPhaseEvent' . sphse_3 - -sphse_3 :: U.UUID -> SetPhaseEvent -sphse_3 qtnUuid = - SetPhaseEvent - { uuid = createEventUuid qtnUuid "dacc8f77de05" - , phaseUuid = Just $ phase3.uuid - , questionnaireUuid = qtnUuid - , tenantUuid = defaultTenantUuid - , createdBy = Just userAlbert.uuid - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 20 - } - -slble_rQ1' :: U.UUID -> QuestionnaireEvent -slble_rQ1' = SetLabelsEvent' . slble_rQ1 - -slble_rQ1 :: U.UUID -> SetLabelsEvent -slble_rQ1 qtnUuid = - SetLabelsEvent - { uuid = createEventUuid qtnUuid "dd016270ce7e" - , path = fst rQ1 - , value = [fLabel1] - , questionnaireUuid = qtnUuid - , tenantUuid = defaultTenantUuid - , createdBy = Just userAlbert.uuid - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 21 - } - -slble_rQ2' :: U.UUID -> QuestionnaireEvent -slble_rQ2' = SetLabelsEvent' . slble_rQ2 - -slble_rQ2 :: U.UUID -> SetLabelsEvent -slble_rQ2 qtnUuid = - SetLabelsEvent - { uuid = createEventUuid qtnUuid "e2acc52bf8db" - , path = fst rQ2 - , value = [fLabel1] - , questionnaireUuid = qtnUuid - , tenantUuid = defaultTenantUuid - , createdBy = Just userAlbert.uuid - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 22 - } - -rte_rQ1_t1' :: QuestionnaireEventDTO -rte_rQ1_t1' = ResolveCommentThreadEventDTO' rte_rQ1_t1 - -rte_rQ1_t1 :: ResolveCommentThreadEventDTO -rte_rQ1_t1 = - ResolveCommentThreadEventDTO - { uuid = u' "ad5ffe15-d895-4452-af31-3b952db0b8a8" - , path = cmtQ1_path - , threadUuid = cmtQ1_t1.uuid - , commentCount = 1 - , createdBy = Just . toSuggestion . toSimple $ userAlbert - , createdAt = cmtQ1_t1Resolved.createdAt - } - -rtche_rQ1_t1' :: QuestionnaireEventChangeDTO -rtche_rQ1_t1' = ResolveCommentThreadEventChangeDTO' rtche_rQ1_t1 - -rtche_rQ1_t1 :: ResolveCommentThreadEventChangeDTO -rtche_rQ1_t1 = - ResolveCommentThreadEventChangeDTO - { uuid = rte_rQ1_t1.uuid - , path = rte_rQ1_t1.path - , threadUuid = rte_rQ1_t1.threadUuid - , private = False - , commentCount = 1 - } - -ote_rQ1_t1' :: QuestionnaireEventDTO -ote_rQ1_t1' = ReopenCommentThreadEventDTO' ote_rQ1_t1 - -ote_rQ1_t1 :: ReopenCommentThreadEventDTO -ote_rQ1_t1 = - ReopenCommentThreadEventDTO - { uuid = u' "444c89c8-ead9-44c7-9621-0c0c43ff5f9f" - , path = cmtQ1_path - , threadUuid = cmtQ1_t1.uuid - , commentCount = 1 - , createdBy = Just . toSuggestion . toSimple $ userAlbert - , createdAt = cmtQ1_t1.createdAt - } - -otche_rQ1_t1' :: QuestionnaireEventChangeDTO -otche_rQ1_t1' = ReopenCommentThreadEventChangeDTO' otche_rQ1_t1 - -otche_rQ1_t1 :: ReopenCommentThreadEventChangeDTO -otche_rQ1_t1 = - ReopenCommentThreadEventChangeDTO - { uuid = ote_rQ1_t1.uuid - , path = ote_rQ1_t1.path - , threadUuid = ote_rQ1_t1.threadUuid - , commentCount = 1 - , private = False - } - -aste_rQ1_t1' :: QuestionnaireEventDTO -aste_rQ1_t1' = AssignCommentThreadEventDTO' aste_rQ1_t1 - -aste_rQ1_t1 :: AssignCommentThreadEventDTO -aste_rQ1_t1 = - AssignCommentThreadEventDTO - { uuid = u' "444c89c8-ead9-44c7-9621-0c0c43ff5f9f" - , path = cmtQ1_path - , threadUuid = cmtQ1_t1.uuid - , private = False - , assignedTo = Just . toSuggestion . toSimple $ userAlbert - , createdBy = Just . toSuggestion . toSimple $ userAlbert - , createdAt = cmtQ1_t1.createdAt - } - -asche_rQ1_t1' :: QuestionnaireEventChangeDTO -asche_rQ1_t1' = AssignCommentThreadEventChangeDTO' asche_rQ1_t1 - -asche_rQ1_t1 :: AssignCommentThreadEventChangeDTO -asche_rQ1_t1 = - AssignCommentThreadEventChangeDTO - { uuid = aste_rQ1_t1.uuid - , path = aste_rQ1_t1.path - , threadUuid = aste_rQ1_t1.threadUuid - , private = aste_rQ1_t1.private - , assignedTo = aste_rQ1_t1.assignedTo - } - -dte_rQ1_t1' :: QuestionnaireEventDTO -dte_rQ1_t1' = DeleteCommentThreadEventDTO' dte_rQ1_t1 - -dte_rQ1_t1 :: DeleteCommentThreadEventDTO -dte_rQ1_t1 = - DeleteCommentThreadEventDTO - { uuid = u' "0e8a5812-90da-43b1-bb20-dbf8a95aa00d" - , path = cmtQ1_path - , threadUuid = cmtQ1_t1.uuid - , createdBy = Just . toSuggestion . toSimple $ userAlbert - , createdAt = cmtQ1_t1.createdAt - } - -dtche_rQ1_t1' :: QuestionnaireEventChangeDTO -dtche_rQ1_t1' = DeleteCommentThreadEventChangeDTO' dtche_rQ1_t1 - -dtche_rQ1_t1 :: DeleteCommentThreadEventChangeDTO -dtche_rQ1_t1 = - DeleteCommentThreadEventChangeDTO - { uuid = dte_rQ1_t1.uuid - , path = dte_rQ1_t1.path - , threadUuid = dte_rQ1_t1.threadUuid - , private = False - } - -ace_rQ1_t1_1' :: QuestionnaireEventDTO -ace_rQ1_t1_1' = AddCommentEventDTO' ace_rQ1_t1_1 - -ace_rQ1_t1_1 :: AddCommentEventDTO -ace_rQ1_t1_1 = - AddCommentEventDTO - { uuid = u' "471ef7d8-5164-44ba-9d28-8aad036458fd" - , path = cmtQ1_path - , threadUuid = cmtQ1_t1.uuid - , commentUuid = cmtQ1_t1_1.uuid - , text = cmtQ1_t1_1.text - , private = cmtQ1_t1.private - , createdBy = Just . toSuggestion . toSimple $ userAlbert - , createdAt = cmtQ1_t1_1.createdAt - } - -ace_rQ1_t1_2' :: QuestionnaireEventDTO -ace_rQ1_t1_2' = AddCommentEventDTO' ace_rQ1_t1_2 - -ace_rQ1_t1_2 :: AddCommentEventDTO -ace_rQ1_t1_2 = - AddCommentEventDTO - { uuid = u' "3450c5ca-a267-4be0-b112-92f5c0d2e2a8" - , path = cmtQ1_path - , threadUuid = cmtQ1_t1.uuid - , commentUuid = cmtQ1_t1_2.uuid - , text = cmtQ1_t1_2.text - , private = cmtQ1_t1.private - , createdBy = Just . toSuggestion . toSimple $ userAlbert - , createdAt = cmtQ1_t1_2.createdAt - } - -ace_rQ2_t1_1' :: QuestionnaireEventDTO -ace_rQ2_t1_1' = AddCommentEventDTO' ace_rQ2_t1_1 - -ace_rQ2_t1_1 :: AddCommentEventDTO -ace_rQ2_t1_1 = - AddCommentEventDTO - { uuid = u' "b46c4ff7-8af2-4164-8e94-841b4f8c312b" - , path = cmtQ2_path - , threadUuid = cmtQ2_t1.uuid - , commentUuid = cmtQ2_t1_1.uuid - , text = cmtQ2_t1_1.text - , private = cmtQ2_t1.private - , createdBy = Just . toSuggestion . toSimple $ userAlbert - , createdAt = cmtQ2_t1_1.createdAt - } - -acche_rQ2_t1_1' :: QuestionnaireEventChangeDTO -acche_rQ2_t1_1' = AddCommentEventChangeDTO' acche_rQ2_t1_1 - -acche_rQ2_t1_1 :: AddCommentEventChangeDTO -acche_rQ2_t1_1 = - AddCommentEventChangeDTO - { uuid = ace_rQ2_t1_1.uuid - , path = ace_rQ2_t1_1.path - , threadUuid = ace_rQ2_t1_1.threadUuid - , commentUuid = ace_rQ2_t1_1.commentUuid - , text = ace_rQ2_t1_1.text - , private = False - , newThread = True - } - -ece_rQ1_t1_1' :: QuestionnaireEventDTO -ece_rQ1_t1_1' = EditCommentEventDTO' ece_rQ1_t1_1 - -ece_rQ1_t1_1 :: EditCommentEventDTO -ece_rQ1_t1_1 = - EditCommentEventDTO - { uuid = u' "6a598663-4bce-48e9-83d0-422ae753f60d" - , path = cmtQ1_path - , threadUuid = cmtQ1_t1.uuid - , commentUuid = cmtQ1_t1_1Edited.uuid - , text = cmtQ1_t1_1Edited.text - , createdBy = Just . toSuggestion . toSimple $ userAlbert - , createdAt = cmtQ1_t1_1Edited.updatedAt - } - -ecche_rQ1_t1_1' :: QuestionnaireEventChangeDTO -ecche_rQ1_t1_1' = EditCommentEventChangeDTO' ecche_rQ1_t1_1 - -ecche_rQ1_t1_1 :: EditCommentEventChangeDTO -ecche_rQ1_t1_1 = - EditCommentEventChangeDTO - { uuid = ece_rQ1_t1_1.uuid - , path = ece_rQ1_t1_1.path - , threadUuid = ece_rQ1_t1_1.threadUuid - , commentUuid = ece_rQ1_t1_1.commentUuid - , text = ece_rQ1_t1_1.text - , private = False - } - -dce_rQ1_t1_1' :: QuestionnaireEventDTO -dce_rQ1_t1_1' = DeleteCommentEventDTO' dce_rQ1_t1_1 - -dce_rQ1_t1_1 :: DeleteCommentEventDTO -dce_rQ1_t1_1 = - DeleteCommentEventDTO - { uuid = u' "0e8a5812-90da-43b1-bb20-dbf8a95aa00d" - , path = cmtQ1_path - , threadUuid = cmtQ1_t1.uuid - , commentUuid = cmtQ1_t1_1.uuid - , createdBy = Just . toSuggestion . toSimple $ userAlbert - , createdAt = cmtQ1_t1_1.createdAt - } - -dcche_rQ1_t1_1' :: QuestionnaireEventChangeDTO -dcche_rQ1_t1_1' = DeleteCommentEventChangeDTO' dcche_rQ1_t1_1 - -dcche_rQ1_t1_1 :: DeleteCommentEventChangeDTO -dcche_rQ1_t1_1 = - DeleteCommentEventChangeDTO - { uuid = dce_rQ1_t1_1.uuid - , path = dce_rQ1_t1_1.path - , threadUuid = dce_rQ1_t1_1.threadUuid - , commentUuid = dce_rQ1_t1_1.commentUuid - , private = False - } - -createEventUuid :: U.UUID -> String -> U.UUID -createEventUuid questionnaireUuid eventSuffix = - let parts = splitOn "-" . U.toString $ questionnaireUuid - in u' . L.intercalate "-" $ [head parts, parts !! 1, parts !! 2, parts !! 3, eventSuffix] diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/QuestionnaireFiles.hs b/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/QuestionnaireFiles.hs deleted file mode 100644 index fc76c0200..000000000 --- a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/QuestionnaireFiles.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireFiles where - -import Shared.Common.Util.Date -import Shared.Common.Util.Uuid -import Wizard.Database.Migration.Development.User.Data.Users -import Wizard.Model.Questionnaire.QuestionnaireFileList -import Wizard.Model.Questionnaire.QuestionnaireFileSimple -import Wizard.Model.Questionnaire.QuestionnaireSimple - -questionnaireFileList :: QuestionnaireFileList -questionnaireFileList = - QuestionnaireFileList - { uuid = u' "e3726571-f81e-4e34-a17a-2f5714b7aade" - , fileName = "my_file.txt" - , contentType = "application/json" - , fileSize = 123456 - , questionnaire = - QuestionnaireSimple - { uuid = u' "af984a75-56e3-49f8-b16f-d6b99599910a" - , name = "My Private Questionnaire" - } - , createdBy = Just userAlbertSuggestion - , createdAt = dt' 2018 01 21 - } - -questionnaireFileSimple :: QuestionnaireFileSimple -questionnaireFileSimple = - QuestionnaireFileSimple - { uuid = questionnaireFileList.uuid - , fileName = questionnaireFileList.fileName - , contentType = questionnaireFileList.contentType - , fileSize = questionnaireFileList.fileSize - } diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/QuestionnaireLabels.hs b/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/QuestionnaireLabels.hs deleted file mode 100644 index bbf91817a..000000000 --- a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/QuestionnaireLabels.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireLabels where - -import qualified Data.Map.Strict as M -import qualified Data.UUID as U - -import Shared.Common.Util.Uuid -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireReplies - -fLabel1 = u' "3268ae3b-8c1a-44ea-ba69-ad759b3ef2ae" - -fLabels :: M.Map String [U.UUID] -fLabels = M.fromList [(fst rQ1, [fLabel1])] - -fLabelsEdited :: M.Map String [U.UUID] -fLabelsEdited = M.fromList [(fst rQ1, [fLabel1]), (fst rQ2, [fLabel1])] diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/QuestionnaireReplies.hs b/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/QuestionnaireReplies.hs deleted file mode 100644 index 7ff5a5e41..000000000 --- a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/QuestionnaireReplies.hs +++ /dev/null @@ -1,287 +0,0 @@ -module Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireReplies where - -import qualified Data.Map.Strict as M -import Data.Maybe (fromJust) -import Data.Time -import qualified Data.UUID as U - -import Shared.Common.Util.Uuid -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.AnswersAndFollowUpQuestions -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Chapters -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Choices -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Questions -import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel -import Wizard.Database.Migration.Development.User.Data.Users -import Wizard.Model.Questionnaire.QuestionnaireReply -import Wizard.Model.Questionnaire.QuestionnaireUtil -import qualified Wizard.Service.User.UserMapper as UM - -fReplies :: M.Map String Reply -fReplies = - M.fromList - [ rQ1 - , rQ2 - , rQ2_aYes_fuQ1 - , rQ3 - , rQ4 - , rQ4_it1_q5 - , rQ4_it1_q5_it1_question7 - , rQ4_it1_q5_it1_question8 - , rQ4_it1_q6 - , rQ4_it2_q5 - , rQ4_it2_q6 - , rQ9 - , rQ10 - , rQ11 - ] - -fRepliesWithUpdated :: M.Map String Reply -fRepliesWithUpdated = - M.fromList - [ rQ1Updated - , rQ2 - , rQ2_aYes_fuQ1 - , rQ3 - , rQ4 - , rQ4_it1_q5 - , rQ4_it1_q5_it1_question7 - , rQ4_it1_q5_it1_question8 - , rQ4_it1_q6 - , rQ4_it2_q5 - , rQ4_it2_q6 - , rQ9 - , rQ10 - , rQ11 - ] - -fRepliesWithDeleted :: M.Map String Reply -fRepliesWithDeleted = - M.fromList - [ rQ2 - , rQ2_aYes_fuQ1 - , rQ3 - , rQ4 - , rQ4_it1_q5 - , rQ4_it1_q5_it1_question7 - , rQ4_it1_q5_it1_question8 - , rQ4_it1_q6 - , rQ4_it2_q5 - , rQ4_it2_q6 - , rQ9 - , rQ10 - , rQ11 - ] - -fRepliesEdited :: M.Map String Reply -fRepliesEdited = M.fromList [rQ1, rQ2, rQ2_aYes_fuQ1, rQ3, rQ9, rQ10, rQ11] - -rQ1 :: ReplyTuple -rQ1 = - ( createReplyKey [chapter1.uuid, question1.uuid] - , Reply - { value = StringReply {sValue = "Reply to 1st question"} - , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 - } - ) - -rQ1Updated :: ReplyTuple -rQ1Updated = - ( createReplyKey [chapter1.uuid, question1.uuid] - , Reply - { value = StringReply {sValue = "Updated Reply to 1st question"} - , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 1 - } - ) - -rQ2 :: ReplyTuple -rQ2 = - ( createReplyKey [chapter1.uuid, question2.uuid] - , Reply - { value = AnswerReply {aValue = q2_answerYes.uuid} - , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 2 - } - ) - -rQ2_aYes_fuQ1 :: ReplyTuple -rQ2_aYes_fuQ1 = - ( createReplyKey [chapter1.uuid, question2.uuid, q2_answerYes.uuid, q2_aYes_fuQuestion1.uuid] - , Reply - { value = AnswerReply {aValue = q2_aYes_fuq1_answerNo.uuid} - , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 3 - } - ) - -unused_rQ2_aYes_fuQ1_aYes_fuq2 :: ReplyTuple -unused_rQ2_aYes_fuQ1_aYes_fuq2 = - ( createReplyKey - [ chapter1.uuid - , question2.uuid - , q2_answerYes.uuid - , q2_aYes_fuQuestion1.uuid - , q2_aYes_fuq1_answerYes.uuid - , q2_aYes_fuq1_aYes_fuQuestion2.uuid - ] - , Reply - { value = AnswerReply {aValue = q2_aYes_fuq1_aYes_fuq2_answerNo.uuid} - , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 4 - } - ) - -rQ3 :: ReplyTuple -rQ3 = - ( createReplyKey [chapter2.uuid, question3.uuid] - , Reply - { value = AnswerReply {aValue = q3_answerNo.uuid} - , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 5 - } - ) - --- ------------------------------------------------------------ -rQ4 :: ReplyTuple -rQ4 = - ( createReplyKey [chapter2.uuid, question4.uuid] - , Reply - { value = ItemListReply {ilValue = [rQ4_it1, rQ4_it2]} - , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 6 - } - ) - -rQ4_it1 :: U.UUID -rQ4_it1 = u' "97e42df3-f0f6-40f8-83ab-375a1340e8ab" - -rQ4_it1_q5 :: ReplyTuple -rQ4_it1_q5 = - ( createReplyKey [chapter2.uuid, question4.uuid, rQ4_it1, q4_it1_question5.uuid] - , Reply - { value = ItemListReply {ilValue = [rQ4_it1_q5_it1]} - , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 7 - } - ) - -rQ4_it1_q5_it1 :: U.UUID -rQ4_it1_q5_it1 = u' "12c243e0-f300-4178-ae4e-0b30d01c6f73" - -rQ4_it1_q5_it1_question7 :: ReplyTuple -rQ4_it1_q5_it1_question7 = - ( createReplyKey - [ chapter2.uuid - , question4.uuid - , rQ4_it1 - , q4_it1_question5.uuid - , rQ4_it1_q5_it1 - , q4_it1_q5_it2_question7.uuid - ] - , Reply - { value = StringReply {sValue = "Ai1: q5: Ai1: Reply to 7th question"} - , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 8 - } - ) - -rQ4_it1_q5_it1_question8 :: ReplyTuple -rQ4_it1_q5_it1_question8 = - ( createReplyKey - [ chapter2.uuid - , question4.uuid - , rQ4_it1 - , q4_it1_question5.uuid - , rQ4_it1_q5_it1 - , q4_it1_q5_it2_question8.uuid - ] - , Reply - { value = StringReply {sValue = "Ai1: q5: Ai1: Reply to 8th question"} - , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 9 - } - ) - -rQ4_it1_q6 :: ReplyTuple -rQ4_it1_q6 = - ( createReplyKey [chapter2.uuid, question4.uuid, rQ4_it1, q4_it1_question6.uuid] - , Reply - { value = AnswerReply {aValue = q4_it1_q6_answerNo.uuid} - , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 10 - } - ) - --- ------------------------------------------------------------ -rQ4_it2 :: U.UUID -rQ4_it2 = u' "aed4bcbc-0c63-4bf6-b954-4561e92babfa" - -rQ4_it2_q5 :: ReplyTuple -rQ4_it2_q5 = - ( createReplyKey [chapter2.uuid, question4.uuid, rQ4_it2, q4_it1_question5.uuid] - , Reply - { value = ItemListReply {ilValue = []} - , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 11 - } - ) - -rQ4_it2_q6 :: ReplyTuple -rQ4_it2_q6 = - ( createReplyKey [chapter2.uuid, question4.uuid, rQ4_it2, q4_it1_question6.uuid] - , Reply - { value = AnswerReply {aValue = q4_it1_q6_answerNo.uuid} - , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 12 - } - ) - --- ------------------------------------------------------------ -rQ9 :: ReplyTuple -rQ9 = - ( createReplyKey [chapter3.uuid, question9.uuid] - , Reply - { value = IntegrationReply {iValue = PlainType rQ9Value} - , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 13 - } - ) - -rQ9Value :: String -rQ9Value = "Plain reply to 9st question" - -rQ9WithNewType :: ReplyTuple -rQ9WithNewType = - ( createReplyKey [chapter3.uuid, question9.uuid] - , Reply - { value = StringReply {sValue = rQ9Value} - , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 14 - } - ) - -rQ10 :: ReplyTuple -rQ10 = - ( createReplyKey [chapter3.uuid, question10.uuid] - , Reply - { value = IntegrationReply {iValue = rQ10IntValue} - , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 15 - } - ) - -rQ10IntValue :: IntegrationReplyType -rQ10IntValue = - IntegrationLegacyType {intId = Just "bsg-p000007", value = "Integration reply to 9st question"} - --- ------------------------------------------------------------------------ -rQ11 :: ReplyTuple -rQ11 = - ( createReplyKey [chapter3.uuid, question11.uuid] - , Reply - { value = MultiChoiceReply {mcValue = [q11_choice2.uuid]} - , createdBy = Just . UM.toSuggestion . UM.toSimple $ userAlbert - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 16 - } - ) diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/QuestionnaireVersions.hs b/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/QuestionnaireVersions.hs deleted file mode 100644 index fab0886fc..000000000 --- a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/QuestionnaireVersions.hs +++ /dev/null @@ -1,80 +0,0 @@ -module Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireVersions where - -import qualified Data.List as L -import Data.Maybe (fromJust) -import Data.Time -import qualified Data.UUID as U - -import Shared.Common.Constant.Tenant (defaultTenantUuid) -import Shared.Common.Util.String -import Shared.Common.Util.Uuid -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionChangeDTO -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionRevertDTO -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.User.Data.Users -import Wizard.Model.Questionnaire.QuestionnaireEvent -import Wizard.Model.Questionnaire.QuestionnaireVersion -import Wizard.Model.Questionnaire.QuestionnaireVersionList -import Wizard.Model.User.User -import Wizard.Service.Questionnaire.Version.QuestionnaireVersionMapper - -qVersions :: U.UUID -> [QuestionnaireVersion] -qVersions qtnUuid = [questionnaireVersion1 qtnUuid] - -qVersionsList :: U.UUID -> [QuestionnaireVersionList] -qVersionsList qtnUuid = [questionnaireVersion1List qtnUuid] - -questionnaireVersion1 :: U.UUID -> QuestionnaireVersion -questionnaireVersion1 qtnUuid = - QuestionnaireVersion - { uuid = createVersionUuid qtnUuid "dd016270ce7e" - , name = "Version 1" - , description = Just "Version 1 description" - , eventUuid = (slble_rQ1 qtnUuid).uuid - , questionnaireUuid = qtnUuid - , tenantUuid = defaultTenantUuid - , createdBy = Just userAlbert.uuid - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 - , updatedAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 - } - -questionnaireVersion1List :: U.UUID -> QuestionnaireVersionList -questionnaireVersion1List qtnUuid = toVersionList (questionnaireVersion1 qtnUuid) (Just userAlbertDto) - -questionnaireVersion1Edited :: U.UUID -> QuestionnaireVersion -questionnaireVersion1Edited qtnUuid = - (questionnaireVersion1 qtnUuid) - { name = "EDITED: " ++ (questionnaireVersion1 qtnUuid).name - , description = fmap ("EDITED: " ++) (questionnaireVersion1 qtnUuid).description - , eventUuid = (sre_rQ11 qtnUuid).uuid - } - -questionnaireVersion1EditedList :: U.UUID -> QuestionnaireVersionList -questionnaireVersion1EditedList qtnUuid = toVersionList (questionnaireVersion1Edited qtnUuid) (Just userAlbertDto) - -questionnaireVersion1EditedChangeDto :: U.UUID -> QuestionnaireVersionChangeDTO -questionnaireVersion1EditedChangeDto qtnUuid = toVersionChangeDTO (questionnaireVersion1Edited qtnUuid) - -questionnaireVersion1RevertDto :: U.UUID -> QuestionnaireVersionRevertDTO -questionnaireVersion1RevertDto qtnUuid = toVersionRevertDTO (sre_rQ2 qtnUuid).uuid - -questionnaireVersion2 :: U.UUID -> QuestionnaireVersion -questionnaireVersion2 qtnUuid = - QuestionnaireVersion - { uuid = createVersionUuid qtnUuid "515f1d45b24f" - , name = "Version 2" - , description = Just "Version 2 description" - , eventUuid = (sre_rQ11 qtnUuid).uuid - , questionnaireUuid = qtnUuid - , tenantUuid = defaultTenantUuid - , createdBy = Just userAlbert.uuid - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 - , updatedAt = UTCTime (fromJust $ fromGregorianValid 2018 1 21) 0 - } -questionnaireVersion2ChangeDto :: U.UUID -> QuestionnaireVersionChangeDTO -questionnaireVersion2ChangeDto qtnUuid = toVersionChangeDTO (questionnaireVersion2 qtnUuid) - -createVersionUuid :: U.UUID -> String -> U.UUID -createVersionUuid questionnaireUuid eventSuffix = - let parts = splitOn "-" . U.toString $ questionnaireUuid - in u' . L.intercalate "-" $ [head parts, parts !! 1, parts !! 2, parts !! 3, eventSuffix] diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/Questionnaires.hs b/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/Questionnaires.hs deleted file mode 100644 index 435406476..000000000 --- a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/Data/Questionnaires.hs +++ /dev/null @@ -1,977 +0,0 @@ -module Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires where - -import qualified Data.Map.Strict as M -import qualified Data.UUID as U - -import Shared.Common.Model.Common.Lens -import Shared.Common.Util.Date -import Shared.Common.Util.Uuid -import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplateFormats -import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplates -import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplate -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Phases -import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel -import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackage -import Wizard.Api.Resource.Questionnaire.QuestionnaireContentChangeDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireContentDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireCreateDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailWsDTO -import Wizard.Api.Resource.Questionnaire.QuestionnairePermDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireSettingsChangeDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireShareChangeDTO -import Wizard.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireComments -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireLabels -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireReplies -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireVersions -import Wizard.Database.Migration.Development.Tenant.Data.Tenants -import Wizard.Database.Migration.Development.User.Data.Users -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireContent -import Wizard.Model.Questionnaire.QuestionnaireEvent -import Wizard.Model.Questionnaire.QuestionnaireEventLenses () -import Wizard.Model.Questionnaire.QuestionnairePerm -import Wizard.Model.Questionnaire.QuestionnaireState -import Wizard.Model.Questionnaire.QuestionnaireVersion -import Wizard.Model.Tenant.Tenant -import Wizard.Model.User.User -import Wizard.Service.Questionnaire.Event.QuestionnaireEventMapper -import Wizard.Service.Questionnaire.QuestionnaireMapper -import WizardLib.Public.Database.Migration.Development.User.Data.UserGroups -import WizardLib.Public.Model.User.UserGroup - -_QUESTIONNAIRE_PROJECT_TAG_1 = "projectTag1" - -_QUESTIONNAIRE_PROJECT_TAG_2 = "projectTag2" - -questionnaire1Uuid :: U.UUID -questionnaire1Uuid = u' "af984a75-56e3-49f8-b16f-d6b99599910a" - -questionnaire1 :: Questionnaire -questionnaire1 = - Questionnaire - { uuid = questionnaire1Uuid - , name = "My Private Questionnaire" - , description = Just "Some description" - , visibility = PrivateQuestionnaire - , sharing = RestrictedQuestionnaire - , knowledgeModelPackageId = germanyKmPackage.pId - , selectedQuestionTagUuids = [] - , projectTags = [_QUESTIONNAIRE_PROJECT_TAG_1] - , documentTemplateId = Just $ wizardDocumentTemplate.tId - , formatUuid = Just $ formatJson.uuid - , creatorUuid = Just $ userAlbert.uuid - , permissions = [qtn1AlbertEditQtnPerm] - , isTemplate = True - , squashed = True - , tenantUuid = defaultTenant.uuid - , createdAt = dt' 2018 1 20 - , updatedAt = dt' 2018 1 25 - } - -questionnaire1Events :: [QuestionnaireEvent] -questionnaire1Events = fEvents questionnaire1Uuid - -questionnaire1Edited :: Questionnaire -questionnaire1Edited = - questionnaire1 - { name = "EDITED: " ++ questionnaire1.name - , visibility = VisibleEditQuestionnaire - , sharing = RestrictedQuestionnaire - , projectTags = [_QUESTIONNAIRE_PROJECT_TAG_1, _QUESTIONNAIRE_PROJECT_TAG_2] - , permissions = [] - } - -questionnaire1ShareEdited :: Questionnaire -questionnaire1ShareEdited = - questionnaire1 - { visibility = VisibleEditQuestionnaire - , sharing = RestrictedQuestionnaire - , permissions = [] - } - -questionnaire1SettingsEdited :: Questionnaire -questionnaire1SettingsEdited = - questionnaire1 - { name = "EDITED: " ++ questionnaire1.name - , projectTags = [_QUESTIONNAIRE_PROJECT_TAG_1, _QUESTIONNAIRE_PROJECT_TAG_2] - } - -questionnaire1EventsEdited :: [QuestionnaireEvent] -questionnaire1EventsEdited = fEventsEdited questionnaire1Uuid - -questionnaire1Versions :: [QuestionnaireVersion] -questionnaire1Versions = qVersions questionnaire1Uuid - -questionnaire1Ctn :: QuestionnaireContent -questionnaire1Ctn = - QuestionnaireContent - { phaseUuid = Just $ phase1.uuid - , replies = fReplies - , labels = fLabels - } - -questionnaire1CtnRevertedDto :: QuestionnaireContentDTO -questionnaire1CtnRevertedDto = - QuestionnaireContentDTO - { phaseUuid = Nothing - , replies = M.fromList [rQ1, rQ2] - , commentThreadsMap = qtnThreadsDto - , labels = M.empty - , events = [toEventList (sre_rQ1' questionnaire1Uuid) (Just userAlbert), toEventList (sre_rQ2' questionnaire1Uuid) (Just userAlbert)] - , versions = [] - } - -questionnaire1Dto :: QuestionnaireDTO -questionnaire1Dto = toSimpleDTO questionnaire1 germanyKmPackage QSDefault [qtn1AlbertEditQtnPermDto] - -questionnaire1Create :: QuestionnaireCreateDTO -questionnaire1Create = - QuestionnaireCreateDTO - { name = questionnaire1.name - , knowledgeModelPackageId = questionnaire1.knowledgeModelPackageId - , visibility = questionnaire1.visibility - , sharing = questionnaire1.sharing - , questionTagUuids = [] - , documentTemplateId = questionnaire1.documentTemplateId - , formatUuid = questionnaire1.formatUuid - } - -questionnaire1EditedShareChange :: QuestionnaireShareChangeDTO -questionnaire1EditedShareChange = - QuestionnaireShareChangeDTO - { visibility = questionnaire1ShareEdited.visibility - , sharing = questionnaire1ShareEdited.sharing - , permissions = fmap toQuestionnairePermChangeDTO questionnaire1ShareEdited.permissions - } - -questionnaire1SettingsChange :: QuestionnaireSettingsChangeDTO -questionnaire1SettingsChange = - QuestionnaireSettingsChangeDTO - { name = questionnaire1SettingsEdited.name - , description = questionnaire1SettingsEdited.description - , projectTags = questionnaire1SettingsEdited.projectTags - , documentTemplateId = Nothing - , formatUuid = Nothing - , isTemplate = questionnaire1SettingsEdited.isTemplate - } - -qtn1AlbertEditQtnPerm :: QuestionnairePerm -qtn1AlbertEditQtnPerm = - QuestionnairePerm - { questionnaireUuid = questionnaire1.uuid - , memberType = UserQuestionnairePermType - , memberUuid = userAlbert.uuid - , perms = ownerPermissions - , tenantUuid = defaultTenant.uuid - } - -qtn1AlbertEditQtnPermDto :: QuestionnairePermDTO -qtn1AlbertEditQtnPermDto = toUserQuestionnairePermDTO qtn1AlbertEditQtnPerm userAlbert - --- ------------------------------------------------------------------------ --- ------------------------------------------------------------------------ -questionnaire2Uuid :: U.UUID -questionnaire2Uuid = u' "d57520b4-5a70-4d40-8623-af2bfbbdfdfe" - -questionnaire2 :: Questionnaire -questionnaire2 = - Questionnaire - { uuid = questionnaire2Uuid - , name = "My VisibleView Questionnaire" - , description = Just "Some description" - , visibility = VisibleViewQuestionnaire - , sharing = RestrictedQuestionnaire - , knowledgeModelPackageId = germanyKmPackage.pId - , selectedQuestionTagUuids = [] - , projectTags = [_QUESTIONNAIRE_PROJECT_TAG_1, _QUESTIONNAIRE_PROJECT_TAG_2] - , documentTemplateId = Just $ wizardDocumentTemplate.tId - , formatUuid = Just $ formatJson.uuid - , creatorUuid = Just $ userAlbert.uuid - , permissions = [qtn2AlbertEditQtnPerm] - , isTemplate = False - , squashed = True - , tenantUuid = defaultTenant.uuid - , createdAt = dt' 2018 1 20 - , updatedAt = dt' 2018 1 22 - } - -questionnaire2Edited :: Questionnaire -questionnaire2Edited = - Questionnaire - { uuid = questionnaire2.uuid - , name = "EDITED: " ++ questionnaire2.name - , description = Just "EDITED: Some description" - , visibility = VisibleEditQuestionnaire - , sharing = RestrictedQuestionnaire - , knowledgeModelPackageId = questionnaire2.knowledgeModelPackageId - , selectedQuestionTagUuids = questionnaire2.selectedQuestionTagUuids - , projectTags = questionnaire2.projectTags - , documentTemplateId = Just $ wizardDocumentTemplate.tId - , formatUuid = Just $ formatJson.uuid - , creatorUuid = Just $ userAlbert.uuid - , permissions = [] - , isTemplate = False - , squashed = True - , tenantUuid = defaultTenant.uuid - , createdAt = questionnaire2.createdAt - , updatedAt = questionnaire2.updatedAt - } - -questionnaire2Events :: [QuestionnaireEvent] -questionnaire2Events = fEvents questionnaire2Uuid - -questionnaire2Versions :: [QuestionnaireVersion] -questionnaire2Versions = qVersions questionnaire2Uuid - -questionnaire2ShareEdited :: Questionnaire -questionnaire2ShareEdited = - questionnaire2 - { visibility = VisibleEditQuestionnaire - , sharing = RestrictedQuestionnaire - , permissions = [] - } - -questionnaire2SettingsEdited :: Questionnaire -questionnaire2SettingsEdited = - questionnaire2 - { name = "EDITED: " ++ questionnaire2.name - , description = Just "EDITED: Some description" - , documentTemplateId = Just $ wizardDocumentTemplate.tId - , formatUuid = Just $ formatJson.uuid - , creatorUuid = Just $ userAlbert.uuid - , isTemplate = False - } - -questionnaire2Ctn :: QuestionnaireContent -questionnaire2Ctn = - QuestionnaireContent - { phaseUuid = Just $ phase1.uuid - , replies = fReplies - , labels = fLabels - } - -questionnaire2EventsEdited :: [QuestionnaireEvent] -questionnaire2EventsEdited = fEventsEdited questionnaire2Uuid - -questionnaire2Dto :: QuestionnaireDTO -questionnaire2Dto = toSimpleDTO questionnaire2 germanyKmPackage QSDefault [qtn2AlbertEditQtnPermDto] - -qtn2AlbertEditQtnPerm :: QuestionnairePerm -qtn2AlbertEditQtnPerm = - QuestionnairePerm - { questionnaireUuid = questionnaire2.uuid - , memberType = UserQuestionnairePermType - , memberUuid = userAlbert.uuid - , perms = ownerPermissions - , tenantUuid = defaultTenant.uuid - } - -qtn2AlbertEditQtnPermDto :: QuestionnairePermDTO -qtn2AlbertEditQtnPermDto = toUserQuestionnairePermDTO qtn2AlbertEditQtnPerm userAlbert - --- ------------------------------------------------------------------------ --- ------------------------------------------------------------------------ -questionnaire3Uuid :: U.UUID -questionnaire3Uuid = u' "16530a07-e673-4ff3-ac1f-57250f2c1bfe" - -questionnaire3 :: Questionnaire -questionnaire3 = - Questionnaire - { uuid = questionnaire3Uuid - , name = "My VisibleEdit Questionnaire" - , description = Just "Some description" - , visibility = VisibleEditQuestionnaire - , sharing = RestrictedQuestionnaire - , knowledgeModelPackageId = germanyKmPackage.pId - , selectedQuestionTagUuids = [] - , projectTags = [] - , documentTemplateId = Just $ wizardDocumentTemplate.tId - , formatUuid = Just $ formatJson.uuid - , creatorUuid = Nothing - , permissions = [] - , isTemplate = False - , squashed = True - , tenantUuid = defaultTenant.uuid - , createdAt = dt' 2018 1 20 - , updatedAt = dt' 2018 1 28 - } - -questionnaire3Events :: [QuestionnaireEvent] -questionnaire3Events = fEvents questionnaire3Uuid - -questionnaire3Versions :: [QuestionnaireVersion] -questionnaire3Versions = qVersions questionnaire3Uuid - -questionnaire3Ctn :: QuestionnaireContent -questionnaire3Ctn = - QuestionnaireContent - { phaseUuid = Just $ phase1.uuid - , replies = fReplies - , labels = fLabels - } - -questionnaire3EventsEdited :: [QuestionnaireEvent] -questionnaire3EventsEdited = fEventsEdited questionnaire3Uuid - -questionnaire3Dto :: QuestionnaireDTO -questionnaire3Dto = toSimpleDTO questionnaire3 germanyKmPackage QSDefault [] - --- ------------------------------------------------------------------------ --- ------------------------------------------------------------------------ -questionnaire4Uuid :: U.UUID -questionnaire4Uuid = u' "57250a07-a663-4ff3-ac1f-16530f2c1bfe" - -questionnaire4 :: Questionnaire -questionnaire4 = - Questionnaire - { uuid = questionnaire4Uuid - , name = "Outdated Questionnaire" - , description = Just "Some description" - , visibility = PrivateQuestionnaire - , sharing = RestrictedQuestionnaire - , knowledgeModelPackageId = netherlandsKmPackage.pId - , selectedQuestionTagUuids = [] - , projectTags = [] - , documentTemplateId = Just $ wizardDocumentTemplate.tId - , formatUuid = Just $ formatJson.uuid - , creatorUuid = Nothing - , permissions = [] - , isTemplate = False - , squashed = True - , tenantUuid = defaultTenant.uuid - , createdAt = dt' 2018 1 20 - , updatedAt = dt' 2018 1 25 - } - -questionnaire4Events :: [QuestionnaireEvent] -questionnaire4Events = [sphse_2' questionnaire4Uuid] - -questionnaire4Versions :: [QuestionnaireVersion] -questionnaire4Versions = [] - -questionnaire4Ctn :: QuestionnaireContent -questionnaire4Ctn = - QuestionnaireContent - { phaseUuid = Just $ phase2.uuid - , replies = M.empty - , labels = M.empty - } - -questionnaire4VisibleView :: Questionnaire -questionnaire4VisibleView = questionnaire4 {visibility = VisibleViewQuestionnaire} - -questionnaire4VisibleViewEvents :: [QuestionnaireEvent] -questionnaire4VisibleViewEvents = [sphse_2' questionnaire4VisibleView.uuid] - -questionnaire4VisibleEdit :: Questionnaire -questionnaire4VisibleEdit = questionnaire4 {visibility = VisibleEditQuestionnaire} - -questionnaire4VisibleEditEvents :: [QuestionnaireEvent] -questionnaire4VisibleEditEvents = [sphse_2' questionnaire4VisibleEdit.uuid] - -questionnaire4Upgraded :: Questionnaire -questionnaire4Upgraded = - questionnaire4 - { uuid = u' "5deabef8-f526-421c-90e2-dd7aed1a25c5" - , knowledgeModelPackageId = netherlandsKmPackageV2.pId - } - -questionnaire4UpgradedEvents :: [QuestionnaireEvent] -questionnaire4UpgradedEvents = [sphse_2' questionnaire4Upgraded.uuid] - -questionnaire4VisibleViewUpgraded :: Questionnaire -questionnaire4VisibleViewUpgraded = questionnaire4Upgraded {visibility = VisibleViewQuestionnaire} - -questionnaire4VisibleViewUpgradedEvents :: [QuestionnaireEvent] -questionnaire4VisibleViewUpgradedEvents = [sphse_2' questionnaire4VisibleViewUpgraded.uuid] - -questionnaire4VisibleEditUpgraded :: Questionnaire -questionnaire4VisibleEditUpgraded = questionnaire4Upgraded {visibility = VisibleEditQuestionnaire} - -questionnaire4VisibleEditUpgradedEvents :: [QuestionnaireEvent] -questionnaire4VisibleEditUpgradedEvents = [sphse_2' questionnaire4VisibleEditUpgraded.uuid] - --- ------------------------------------------------------------------------ --- ------------------------------------------------------------------------ -questionnaire5Uuid :: U.UUID -questionnaire5Uuid = u' "506be867-ba92-4e10-8175-187e99613366" - -questionnaire5 :: Questionnaire -questionnaire5 = - questionnaire1 - { uuid = questionnaire5Uuid - , name = "My Private Questionnaire SharedView" - , visibility = PrivateQuestionnaire - , sharing = AnyoneWithLinkViewQuestionnaire - , permissions = [qtn5AlbertEditQtnPerm] - } - -questionnaire5Events :: [QuestionnaireEvent] -questionnaire5Events = fEvents questionnaire5Uuid - -questionnaire5EventsEdited :: [QuestionnaireEvent] -questionnaire5EventsEdited = fEventsEdited questionnaire5Uuid - -questionnaire5Versions :: [QuestionnaireVersion] -questionnaire5Versions = qVersions questionnaire5Uuid - -qtn5AlbertEditQtnPerm :: QuestionnairePerm -qtn5AlbertEditQtnPerm = - QuestionnairePerm - { questionnaireUuid = questionnaire5.uuid - , memberType = UserQuestionnairePermType - , memberUuid = userAlbert.uuid - , perms = ownerPermissions - , tenantUuid = defaultTenant.uuid - } - --- ------------------------------------------------------------------------ --- ------------------------------------------------------------------------ -questionnaire6Uuid :: U.UUID -questionnaire6Uuid = u' "09304abd-2035-4046-8dc8-b3e5ba8c016c" - -questionnaire6 :: Questionnaire -questionnaire6 = - questionnaire1 - { uuid = questionnaire6Uuid - , name = "My Private Questionnaire SharedEdit" - , visibility = PrivateQuestionnaire - , sharing = AnyoneWithLinkEditQuestionnaire - , permissions = [qtn6AlbertEditQtnPerm] - } - -questionnaire6Events :: [QuestionnaireEvent] -questionnaire6Events = fEvents questionnaire6Uuid - -questionnaire6Versions :: [QuestionnaireVersion] -questionnaire6Versions = qVersions questionnaire6Uuid - -questionnaire6Ctn :: QuestionnaireContent -questionnaire6Ctn = - QuestionnaireContent - { phaseUuid = Just $ phase1.uuid - , replies = fReplies - , labels = fLabels - } - -questionnaire6EventsEdited :: [QuestionnaireEvent] -questionnaire6EventsEdited = fEventsEdited questionnaire6Uuid - -questionnaire6Dto :: QuestionnaireDTO -questionnaire6Dto = toSimpleDTO questionnaire6 germanyKmPackage QSDefault [qtn6AlbertEditQtnPermDto] - -qtn6AlbertEditQtnPerm :: QuestionnairePerm -qtn6AlbertEditQtnPerm = - QuestionnairePerm - { questionnaireUuid = questionnaire6.uuid - , memberType = UserQuestionnairePermType - , memberUuid = userAlbert.uuid - , perms = ownerPermissions - , tenantUuid = defaultTenant.uuid - } - -qtn6AlbertEditQtnPermDto :: QuestionnairePermDTO -qtn6AlbertEditQtnPermDto = toUserQuestionnairePermDTO qtn6AlbertEditQtnPerm userAlbert - --- ------------------------------------------------------------------------ --- ------------------------------------------------------------------------ -questionnaire7Uuid :: U.UUID -questionnaire7Uuid = u' "abd22b10-63fd-4cb8-bb23-7997ff32eccc" - -questionnaire7 :: Questionnaire -questionnaire7 = - questionnaire2 - { uuid = questionnaire7Uuid - , name = "My VisibleView Questionnaire SharedView" - , visibility = VisibleViewQuestionnaire - , sharing = AnyoneWithLinkViewQuestionnaire - , permissions = [qtn7AlbertEditQtnPerm] - } - -questionnaire7Events :: [QuestionnaireEvent] -questionnaire7Events = fEvents questionnaire7Uuid - -questionnaire7EventsEdited :: [QuestionnaireEvent] -questionnaire7EventsEdited = fEventsEdited questionnaire8Uuid - -questionnaire7Versions :: [QuestionnaireVersion] -questionnaire7Versions = qVersions questionnaire7Uuid - -questionnaire7Ctn :: QuestionnaireContent -questionnaire7Ctn = - QuestionnaireContent - { phaseUuid = Just $ phase1.uuid - , replies = fReplies - , labels = fLabels - } - -qtn7AlbertEditQtnPerm :: QuestionnairePerm -qtn7AlbertEditQtnPerm = - QuestionnairePerm - { questionnaireUuid = questionnaire7.uuid - , memberType = UserQuestionnairePermType - , memberUuid = userAlbert.uuid - , perms = ownerPermissions - , tenantUuid = defaultTenant.uuid - } - -qtn7AlbertEditQtnPermDto :: QuestionnairePermDTO -qtn7AlbertEditQtnPermDto = toUserQuestionnairePermDTO qtn7AlbertEditQtnPerm userAlbert - --- ------------------------------------------------------------------------ --- ------------------------------------------------------------------------ -questionnaire8Uuid :: U.UUID -questionnaire8Uuid = u' "a990f62a-ca1f-4517-82d4-399951b8630b" - -questionnaire8 :: Questionnaire -questionnaire8 = - questionnaire2 - { uuid = questionnaire8Uuid - , name = "My VisibleView Questionnaire SharedEdit" - , visibility = VisibleViewQuestionnaire - , sharing = AnyoneWithLinkEditQuestionnaire - , permissions = [qtn8AlbertEditQtnPerm] - } - -questionnaire8Events :: [QuestionnaireEvent] -questionnaire8Events = fEvents questionnaire8Uuid - -questionnaire8EventsEdited :: [QuestionnaireEvent] -questionnaire8EventsEdited = fEventsEdited questionnaire8Uuid - -questionnaire8Versions :: [QuestionnaireVersion] -questionnaire8Versions = qVersions questionnaire8Uuid - -qtn8AlbertEditQtnPerm :: QuestionnairePerm -qtn8AlbertEditQtnPerm = - QuestionnairePerm - { questionnaireUuid = questionnaire8.uuid - , memberType = UserQuestionnairePermType - , memberUuid = userAlbert.uuid - , perms = ownerPermissions - , tenantUuid = defaultTenant.uuid - } - --- ------------------------------------------------------------------------ --- ------------------------------------------------------------------------ -questionnaire9Uuid :: U.UUID -questionnaire9Uuid = u' "936e852f-4c41-4524-8387-bd87090e9fcc" - -questionnaire9 :: Questionnaire -questionnaire9 = - questionnaire2 - { uuid = questionnaire9Uuid - , name = "My VisibleEdit Questionnaire SharedView" - , visibility = VisibleEditQuestionnaire - , sharing = AnyoneWithLinkViewQuestionnaire - , permissions = [qtn9AlbertEditQtnPerm] - } - -questionnaire9Events :: [QuestionnaireEvent] -questionnaire9Events = fEvents questionnaire9Uuid - -questionnaire9EventsEdited :: [QuestionnaireEvent] -questionnaire9EventsEdited = fEventsEdited questionnaire9Uuid - -questionnaire9Versions :: [QuestionnaireVersion] -questionnaire9Versions = qVersions questionnaire9Uuid - -qtn9AlbertEditQtnPerm :: QuestionnairePerm -qtn9AlbertEditQtnPerm = - QuestionnairePerm - { questionnaireUuid = questionnaire9.uuid - , memberType = UserQuestionnairePermType - , memberUuid = userAlbert.uuid - , perms = ownerPermissions - , tenantUuid = defaultTenant.uuid - } - --- ------------------------------------------------------------------------ --- ------------------------------------------------------------------------ -questionnaire10Uuid :: U.UUID -questionnaire10Uuid = u' "3c8e7ce6-cb5e-4cd1-a4d1-fb9de55f67ed" - -questionnaire10 :: Questionnaire -questionnaire10 = - questionnaire3 - { uuid = questionnaire10Uuid - , name = "My VisibleEdit Questionnaire SharedEdit" - , visibility = VisibleEditQuestionnaire - , sharing = AnyoneWithLinkEditQuestionnaire - } - -questionnaire10Events :: [QuestionnaireEvent] -questionnaire10Events = fEvents questionnaire10Uuid - -questionnaire10EventsEdited :: [QuestionnaireEvent] -questionnaire10EventsEdited = questionnaire10Events ++ [setCreatedBy (slble_rQ2' questionnaire10Uuid) Nothing] - -questionnaire10Versions :: [QuestionnaireVersion] -questionnaire10Versions = qVersions questionnaire10Uuid - -questionnaire10Ctn :: QuestionnaireContent -questionnaire10Ctn = - QuestionnaireContent - { phaseUuid = Just $ phase1.uuid - , replies = fReplies - , labels = fLabels - } - -questionnaire10EditedShare :: Questionnaire -questionnaire10EditedShare = questionnaire10 {permissions = [qtn10NikolaEditQtnPerm]} - -questionnaire10EditedSettings :: Questionnaire -questionnaire10EditedSettings = questionnaire10 {name = "EDITED: " ++ questionnaire10.name} - -qtn10NikolaEditQtnPerm :: QuestionnairePerm -qtn10NikolaEditQtnPerm = - QuestionnairePerm - { questionnaireUuid = questionnaire10.uuid - , memberType = UserQuestionnairePermType - , memberUuid = userNikola.uuid - , perms = ownerPermissions - , tenantUuid = defaultTenant.uuid - } - -qtn10NikolaEditQtnPermDto :: QuestionnairePermDTO -qtn10NikolaEditQtnPermDto = toUserQuestionnairePermDTO qtn10NikolaEditQtnPerm userNikola - -questionnaire10EditedSettingsChange :: QuestionnaireSettingsChangeDTO -questionnaire10EditedSettingsChange = - QuestionnaireSettingsChangeDTO - { name = "EDITED: " ++ questionnaire10.name - , description = questionnaire10.description - , projectTags = questionnaire10.projectTags - , documentTemplateId = Nothing - , formatUuid = Nothing - , isTemplate = questionnaire10.isTemplate - } - -questionnaire10EditedWs :: QuestionnaireDetailWsDTO -questionnaire10EditedWs = - QuestionnaireDetailWsDTO - { name = questionnaire10EditedSettingsChange.name - , description = questionnaire10EditedSettingsChange.description - , visibility = questionnaire10.visibility - , sharing = questionnaire10.sharing - , projectTags = questionnaire10EditedSettingsChange.projectTags - , permissions = [] - , documentTemplateId = Nothing - , documentTemplate = Nothing - , formatUuid = Nothing - , format = Nothing - , isTemplate = questionnaire10EditedSettingsChange.isTemplate - , labels = M.empty - , unresolvedCommentCounts = M.empty - , resolvedCommentCounts = M.empty - } - --- ------------------------------------------------------------------------ --- ------------------------------------------------------------------------ -questionnaire11Uuid :: U.UUID -questionnaire11Uuid = u' "ba6b6c0e-2bb7-40e7-9019-feb943756888" - -questionnaire11 :: Questionnaire -questionnaire11 = - questionnaire1 - { uuid = questionnaire11Uuid - , name = "My Questionnaire from project template" - , permissions = [qtn11AlbertEditQtnPerm] - } - -questionnaire11Events :: [QuestionnaireEvent] -questionnaire11Events = fEvents questionnaire11Uuid - -questionnaire11Versions :: [QuestionnaireVersion] -questionnaire11Versions = qVersions questionnaire11Uuid - -questionnaire11Ctn :: QuestionnaireContent -questionnaire11Ctn = questionnaire1Ctn - -questionnaire11Dto :: QuestionnaireDTO -questionnaire11Dto = toSimpleDTO questionnaire11 germanyKmPackage QSDefault [qtn11AlbertEditQtnPermDto] - -qtn11AlbertEditQtnPerm :: QuestionnairePerm -qtn11AlbertEditQtnPerm = - QuestionnairePerm - { questionnaireUuid = questionnaire11.uuid - , memberType = UserQuestionnairePermType - , memberUuid = userAlbert.uuid - , perms = ownerPermissions - , tenantUuid = defaultTenant.uuid - } - -qtn11AlbertEditQtnPermDto :: QuestionnairePermDTO -qtn11AlbertEditQtnPermDto = toUserQuestionnairePermDTO qtn11AlbertEditQtnPerm userAlbert - --- ------------------------------------------------------------------------ --- ------------------------------------------------------------------------ -questionnaire12Uuid :: U.UUID -questionnaire12Uuid = u' "e02bc040-7446-48a2-b557-678e01d66937" - -questionnaire12 :: Questionnaire -questionnaire12 = - questionnaire1 - { uuid = questionnaire12Uuid - , name = "My Private Questionnaire with 2 users" - , visibility = VisibleEditQuestionnaire - , sharing = AnyoneWithLinkEditQuestionnaire - , permissions = [qtn12NikolaEditQtnPerm, qtn12AlbertEditQtnPerm] - , updatedAt = dt' 2018 1 23 - } - -questionnaire12Events :: [QuestionnaireEvent] -questionnaire12Events = fEvents questionnaire12Uuid - -questionnaire12Versions :: [QuestionnaireVersion] -questionnaire12Versions = qVersions questionnaire12Uuid - -questionnaire12Ctn :: QuestionnaireContent -questionnaire12Ctn = questionnaire1Ctn - -questionnaire12Dto :: QuestionnaireDTO -questionnaire12Dto = - toSimpleDTO questionnaire12 germanyKmPackage QSDefault [qtn12NikolaEditQtnPermDto, qtn12AlbertEditQtnPermDto] - -qtn12AlbertEditQtnPerm :: QuestionnairePerm -qtn12AlbertEditQtnPerm = - QuestionnairePerm - { questionnaireUuid = questionnaire12.uuid - , memberType = UserQuestionnairePermType - , memberUuid = userAlbert.uuid - , perms = ownerPermissions - , tenantUuid = defaultTenant.uuid - } - -qtn12AlbertEditQtnPermDto :: QuestionnairePermDTO -qtn12AlbertEditQtnPermDto = toUserQuestionnairePermDTO qtn12AlbertEditQtnPerm userAlbert - -qtn12NikolaEditQtnPerm :: QuestionnairePerm -qtn12NikolaEditQtnPerm = - QuestionnairePerm - { questionnaireUuid = questionnaire12.uuid - , memberType = UserQuestionnairePermType - , memberUuid = userNikola.uuid - , perms = ownerPermissions - , tenantUuid = defaultTenant.uuid - } - -qtn12NikolaEditQtnPermDto :: QuestionnairePermDTO -qtn12NikolaEditQtnPermDto = toUserQuestionnairePermDTO qtn12NikolaEditQtnPerm userNikola - --- ------------------------------------------------------------------------ --- ------------------------------------------------------------------------ -questionnaire13Uuid :: U.UUID -questionnaire13Uuid = u' "59b97a8e-aa48-47f7-93a7-646f9df077df" - -questionnaire13 :: Questionnaire -questionnaire13 = - questionnaire1 - { uuid = questionnaire13Uuid - , name = "My VisibleCommentQuestionnaire Questionnaire" - , visibility = VisibleCommentQuestionnaire - , permissions = [qtn13NikolaCommentQtnPerm] - } - -questionnaire13Events :: [QuestionnaireEvent] -questionnaire13Events = fEvents questionnaire13Uuid - -questionnaire13Versions :: [QuestionnaireVersion] -questionnaire13Versions = qVersions questionnaire13Uuid - -questionnaire13Ctn :: QuestionnaireContent -questionnaire13Ctn = questionnaire1Ctn - -questionnaire13Dto :: QuestionnaireDTO -questionnaire13Dto = toSimpleDTO questionnaire13 germanyKmPackage QSDefault [qtn13NikolaCommentQtnPermDto] - -qtn13NikolaCommentQtnPerm :: QuestionnairePerm -qtn13NikolaCommentQtnPerm = - QuestionnairePerm - { questionnaireUuid = questionnaire13.uuid - , memberType = UserQuestionnairePermType - , memberUuid = userNikola.uuid - , perms = commentatorPermissions - , tenantUuid = defaultTenant.uuid - } - -qtn13NikolaCommentQtnPermDto :: QuestionnairePermDTO -qtn13NikolaCommentQtnPermDto = toUserQuestionnairePermDTO qtn13NikolaCommentQtnPerm userNikola - --- ------------------------------------------------------------------------ --- ------------------------------------------------------------------------ -questionnaire14 :: Questionnaire -questionnaire14 = - questionnaire1 - { uuid = u' "8355fe3c-47b9-4078-b5b6-08aa0188e85f" - , name = "My different KM Questionnaire" - , permissions = [qtn14NikolaEditQtnPerm] - , knowledgeModelPackageId = amsterdamKmPackage.pId - , updatedAt = dt' 2018 1 26 - } - -questionnaire14Events :: [QuestionnaireEvent] -questionnaire14Events = [] - -questionnaire14Ctn :: QuestionnaireContent -questionnaire14Ctn = questionnaire1Ctn - -questionnaire14Dto :: QuestionnaireDTO -questionnaire14Dto = toSimpleDTO questionnaire14 amsterdamKmPackage QSDefault [qtn14NikolaEditQtnPermDto] - -qtn14NikolaEditQtnPerm :: QuestionnairePerm -qtn14NikolaEditQtnPerm = - QuestionnairePerm - { questionnaireUuid = questionnaire14.uuid - , memberType = UserQuestionnairePermType - , memberUuid = userNikola.uuid - , perms = ownerPermissions - , tenantUuid = defaultTenant.uuid - } - -qtn14NikolaEditQtnPermDto :: QuestionnairePermDTO -qtn14NikolaEditQtnPermDto = toUserQuestionnairePermDTO qtn14NikolaEditQtnPerm userNikola - --- ------------------------------------------------------------------------ --- ------------------------------------------------------------------------ -questionnaire15Uuid :: U.UUID -questionnaire15Uuid = u' "d09695f4-638b-472b-9951-a31bd7dc91f7" - -questionnaire15 :: Questionnaire -questionnaire15 = - Questionnaire - { uuid = questionnaire15Uuid - , name = "My Group Questionnaire" - , description = Just "Some description" - , visibility = PrivateQuestionnaire - , sharing = RestrictedQuestionnaire - , knowledgeModelPackageId = germanyKmPackage.pId - , selectedQuestionTagUuids = [] - , projectTags = [] - , documentTemplateId = Just wizardDocumentTemplate.tId - , formatUuid = Just formatJson.uuid - , creatorUuid = Nothing - , permissions = [qtn15GroupEditQtnPerm] - , isTemplate = False - , squashed = True - , tenantUuid = defaultTenant.uuid - , createdAt = dt' 2018 1 20 - , updatedAt = dt' 2018 1 29 - } - -questionnaire15AnonymousEdit :: Questionnaire -questionnaire15AnonymousEdit = - questionnaire15 - { sharing = AnyoneWithLinkEditQuestionnaire - } - -questionnaire15AnonymousComment :: Questionnaire -questionnaire15AnonymousComment = - questionnaire15 - { sharing = AnyoneWithLinkCommentQuestionnaire - } - -questionnaire15NoPerms :: Questionnaire -questionnaire15NoPerms = - questionnaire15 - { permissions = [] - } - -questionnaire15Events :: [QuestionnaireEvent] -questionnaire15Events = fEvents questionnaire15Uuid - -questionnaire15Versions :: [QuestionnaireVersion] -questionnaire15Versions = qVersions questionnaire15Uuid - -questionnaire15Dto :: QuestionnaireDTO -questionnaire15Dto = toSimpleDTO questionnaire15 germanyKmPackage QSDefault [qtn15GroupEditQtnPermDto] - -qtn15GroupEditQtnPerm :: QuestionnairePerm -qtn15GroupEditQtnPerm = - QuestionnairePerm - { questionnaireUuid = questionnaire15.uuid - , memberType = UserGroupQuestionnairePermType - , memberUuid = bioGroup.uuid - , perms = ownerPermissions - , tenantUuid = defaultTenant.uuid - } - -qtn15GroupViewQtnPerm :: QuestionnairePerm -qtn15GroupViewQtnPerm = - QuestionnairePerm - { questionnaireUuid = questionnaire15.uuid - , memberType = UserGroupQuestionnairePermType - , memberUuid = animalGroup.uuid - , perms = viewerPermissions - , tenantUuid = defaultTenant.uuid - } - -qtn15GroupEditQtnPermDto :: QuestionnairePermDTO -qtn15GroupEditQtnPermDto = toUserGroupQuestionnairePermDTO qtn15GroupEditQtnPerm bioGroup - --- ------------------------------------------------------------------------ --- ------------------------------------------------------------------------ -differentQuestionnaire :: Questionnaire -differentQuestionnaire = - Questionnaire - { uuid = u' "7bf4a83e-1687-4e99-b1df-9221977d7b4f" - , name = "My Different Questionnaire" - , description = Just "Some description" - , visibility = PrivateQuestionnaire - , sharing = RestrictedQuestionnaire - , knowledgeModelPackageId = differentPackage.pId - , selectedQuestionTagUuids = [] - , projectTags = [] - , documentTemplateId = Just $ anotherWizardDocumentTemplate.tId - , formatUuid = Just $ formatJson.uuid - , creatorUuid = Just $ userCharles.uuid - , permissions = [differentCharlesOwnerQtnPerm] - , isTemplate = True - , squashed = True - , tenantUuid = differentTenant.uuid - , createdAt = dt' 2018 1 20 - , updatedAt = dt' 2018 1 25 - } - -differentQuestionnaireEvents :: [QuestionnaireEvent] -differentQuestionnaireEvents = [] - -differentQuestionnaireVersions :: [QuestionnaireVersion] -differentQuestionnaireVersions = [] - -differentCharlesOwnerQtnPerm :: QuestionnairePerm -differentCharlesOwnerQtnPerm = - QuestionnairePerm - { questionnaireUuid = differentQuestionnaire.uuid - , memberType = UserQuestionnairePermType - , memberUuid = userCharles.uuid - , perms = ownerPermissions - , tenantUuid = differentTenant.uuid - } - --- ------------------------------------------------------------------------ --- ------------------------------------------------------------------------ -contentChangeDTO :: QuestionnaireContentChangeDTO -contentChangeDTO = - QuestionnaireContentChangeDTO - { events = fmap toEventChangeDTO (fEvents U.nil) - } - --- ------------------------------------------------------------------------ --- ------------------------------------------------------------------------ -bioGroupEditQtnPerm :: QuestionnairePerm -bioGroupEditQtnPerm = - QuestionnairePerm - { questionnaireUuid = questionnaire1.uuid - , memberType = UserGroupQuestionnairePermType - , memberUuid = bioGroup.uuid - , perms = ownerPermissions - , tenantUuid = defaultTenant.uuid - } - -bioGroupEditQtnPermDto :: QuestionnairePermDTO -bioGroupEditQtnPermDto = toUserGroupQuestionnairePermDTO bioGroupEditQtnPerm bioGroup diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/MigratorMigration.hs b/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/MigratorMigration.hs deleted file mode 100644 index 688c5ec2e..000000000 --- a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/MigratorMigration.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Database.Migration.Development.Questionnaire.MigratorMigration where - -import Shared.Common.Constant.Component -import Shared.Common.Util.Logger -import Wizard.Database.DAO.Questionnaire.MigratorDAO -import Wizard.Database.Migration.Development.Questionnaire.Data.MigratorStates - -runMigration = do - logInfo _CMP_MIGRATION "(Migration/Questionnaire) started" - deleteMigratorStates - insertMigratorState differentQtnMigrationState - logInfo _CMP_MIGRATION "(Migration/Questionnaire) ended" diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/MigratorSchemaMigration.hs b/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/MigratorSchemaMigration.hs deleted file mode 100644 index bee6f352f..000000000 --- a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/MigratorSchemaMigration.hs +++ /dev/null @@ -1,34 +0,0 @@ -module Wizard.Database.Migration.Development.Questionnaire.MigratorSchemaMigration where - -import Database.PostgreSQL.Simple -import GHC.Int - -import Shared.Common.Util.Logger -import Wizard.Database.DAO.Common -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.ContextLenses () - -dropTables :: AppContextM Int64 -dropTables = do - logInfo _CMP_MIGRATION "(Table/Migration/Questionnaire) drop tables" - let sql = "DROP TABLE IF EXISTS questionnaire_migration;" - let action conn = execute_ conn sql - runDB action - -createTables :: AppContextM Int64 -createTables = do - logInfo _CMP_MIGRATION "(Table/Migration/Questionnaire) create table" - let sql = - "CREATE TABLE questionnaire_migration \ - \( \ - \ old_questionnaire_uuid uuid NOT NULL, \ - \ new_questionnaire_uuid uuid NOT NULL, \ - \ resolved_question_uuids uuid[] NOT NULL, \ - \ tenant_uuid uuid NOT NULL, \ - \ CONSTRAINT questionnaire_migration_pk PRIMARY KEY (old_questionnaire_uuid, new_questionnaire_uuid), \ - \ CONSTRAINT questionnaire_migration_old_questionnaire_uuid_fk FOREIGN KEY (old_questionnaire_uuid) REFERENCES questionnaire (uuid) ON DELETE CASCADE, \ - \ CONSTRAINT questionnaire_migration_new_questionnaire_uuid_fk FOREIGN KEY (new_questionnaire_uuid) REFERENCES questionnaire (uuid) ON DELETE CASCADE, \ - \ CONSTRAINT questionnaire_migration_tenant_uuid_fk FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) ON DELETE CASCADE \ - \);" - let action conn = execute_ conn sql - runDB action diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/QuestionnaireMigration.hs b/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/QuestionnaireMigration.hs deleted file mode 100644 index b0e24d675..000000000 --- a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/QuestionnaireMigration.hs +++ /dev/null @@ -1,46 +0,0 @@ -module Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration where - -import Data.Foldable (traverse_) - -import Shared.Common.Constant.Component -import Shared.Common.Util.Logger -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Database.DAO.Questionnaire.QuestionnaireCommentDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireCommentThreadDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireEventDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireFileDAO -import Wizard.Database.DAO.Questionnaire.QuestionnairePermDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireVersionDAO -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireComments -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.S3.Questionnaire.QuestionnaireFileS3 - -runMigration = do - logInfo _CMP_MIGRATION "(Questionnaire/Questionnaire) started" - deleteQuestionnaireFiles - purgeBucket - deleteQuestionnaireComments - deleteQuestionnaireCommentThreads - deleteQuestionnairePerms - deleteQuestionnaireEvents - deleteQuestionnaires - insertPackage germanyKmPackage - insertQuestionnaire questionnaire1 - insertQuestionnaireEvents (fEvents questionnaire1Uuid) - traverse_ insertQuestionnaireVersion questionnaire1Versions - insertQuestionnaire questionnaire2 - insertQuestionnaireEvents (fEvents questionnaire2Uuid) - traverse_ insertQuestionnaireVersion questionnaire2Versions - insertQuestionnaire questionnaire3 - insertQuestionnaireEvents (fEvents questionnaire3Uuid) - traverse_ insertQuestionnaireVersion questionnaire3Versions - insertQuestionnaire differentQuestionnaire - insertQuestionnaireCommentThread cmtQ1_t1 - insertQuestionnaireComment cmtQ1_t1_1 - insertQuestionnaireComment cmtQ1_t1_2 - insertQuestionnaireCommentThread cmtQ2_t1 - insertQuestionnaireComment cmtQ2_t1_1 - logInfo _CMP_MIGRATION "(Questionnaire/Questionnaire) ended" diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/QuestionnaireSchemaMigration.hs b/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/QuestionnaireSchemaMigration.hs deleted file mode 100644 index 9f1eb6305..000000000 --- a/wizard-server/src/Wizard/Database/Migration/Development/Questionnaire/QuestionnaireSchemaMigration.hs +++ /dev/null @@ -1,275 +0,0 @@ -module Wizard.Database.Migration.Development.Questionnaire.QuestionnaireSchemaMigration where - -import Control.Monad.Except (catchError) -import Database.PostgreSQL.Simple -import GHC.Int - -import Shared.Common.Util.Logger -import Wizard.Database.DAO.Common -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.ContextLenses () -import Wizard.S3.Questionnaire.QuestionnaireFileS3 - -dropTables :: AppContextM Int64 -dropTables = do - logInfo _CMP_MIGRATION "(Table/Questionnaire) drop tables" - let sql = - "DROP TRIGGER IF EXISTS trigger_on_after_questionnaire_file_delete ON questionnaire_file; \ - \DROP FUNCTION IF EXISTS create_persistent_command_from_questionnaire_file_delete; \ - \DROP TABLE IF EXISTS questionnaire_file CASCADE; \ - \DROP TABLE IF EXISTS questionnaire_version CASCADE; \ - \DROP TABLE IF EXISTS questionnaire_comment CASCADE; \ - \DROP TABLE IF EXISTS questionnaire_comment_thread CASCADE; \ - \DROP TABLE IF EXISTS questionnaire_perm_group CASCADE; \ - \DROP TABLE IF EXISTS questionnaire_perm_user CASCADE; \ - \DROP TABLE IF EXISTS questionnaire_event; \ - \DROP TYPE IF EXISTS questionnaire_event_type; \ - \DROP TYPE IF EXISTS value_type; \ - \DROP TABLE IF EXISTS questionnaire CASCADE; " - let action conn = execute_ conn sql - runDB action - -dropBucket :: AppContextM () -dropBucket = do - catchError purgeBucket (\e -> return ()) - catchError removeBucket (\e -> return ()) - -dropFunctions :: AppContextM Int64 -dropFunctions = do - logInfo _CMP_MIGRATION "(Function/Questionnaire) drop functions" - let sql = "DROP FUNCTION IF EXISTS create_persistent_command_from_questionnaire_file_delete;" - let action conn = execute_ conn sql - runDB action - -dropTriggers :: AppContextM Int64 -dropTriggers = do - logInfo _CMP_MIGRATION "(Trigger/Questionnaire) drop tables" - let sql = "DROP TRIGGER IF EXISTS trigger_on_after_questionnaire_file_delete ON questionnaire_file;" - let action conn = execute_ conn sql - runDB action - -createTables :: AppContextM () -createTables = do - createQtnTable - createQtnEventTable - createQtnAclUserTable - createQtnAclGroupTable - createQtnCommentThreadTable - createQtnCommentTable - createQtnVersionTable - createQtnFileTable - createPersistentCommandFromQuestionnaireFileDeleteFunction - makeBucket - -createQtnTable = do - logInfo _CMP_MIGRATION "(Table/Questionnaire) create table" - let sql = - "CREATE TABLE questionnaire \ - \( \ - \ uuid uuid NOT NULL, \ - \ name varchar NOT NULL, \ - \ visibility varchar NOT NULL, \ - \ sharing varchar NOT NULL, \ - \ knowledge_model_package_id varchar NOT NULL, \ - \ selected_question_tag_uuids uuid[] NOT NULL, \ - \ document_template_id varchar, \ - \ format_uuid uuid, \ - \ created_by uuid, \ - \ created_at timestamptz NOT NULL, \ - \ updated_at timestamptz NOT NULL, \ - \ description varchar, \ - \ is_template boolean NOT NULL, \ - \ squashed boolean NOT NULL, \ - \ tenant_uuid uuid NOT NULL, \ - \ project_tags text[] NOT NULL, \ - \ CONSTRAINT questionnaire_pk PRIMARY KEY (uuid), \ - \ CONSTRAINT questionnaire_knowledge_model_package_id_fk FOREIGN KEY (knowledge_model_package_id, tenant_uuid) REFERENCES knowledge_model_package (id, tenant_uuid) ON DELETE CASCADE, \ - \ CONSTRAINT questionnaire_document_template_id_fk FOREIGN KEY (document_template_id, tenant_uuid) REFERENCES document_template (id, tenant_uuid) ON DELETE CASCADE, \ - \ CONSTRAINT questionnaire_created_by_fk FOREIGN KEY (created_by) REFERENCES user_entity (uuid) ON DELETE SET NULL, \ - \ CONSTRAINT questionnaire_tenant_uuid_fk FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) ON DELETE CASCADE \ - \);" - let action conn = execute_ conn sql - runDB action - -createQtnEventTable = do - logInfo _CMP_MIGRATION "(Table/QuestionnaireEvent) create table" - let sql = - "CREATE TYPE questionnaire_event_type AS ENUM ('ClearReplyEvent', 'SetReplyEvent', 'SetLabelsEvent', 'SetPhaseEvent'); \ - \CREATE TYPE value_type AS ENUM ('IntegrationReply', 'AnswerReply', 'MultiChoiceReply', 'ItemListReply', 'StringReply', 'ItemSelectReply', 'FileReply'); \ - \CREATE TABLE IF NOT EXISTS questionnaire_event \ - \( \ - \ uuid uuid NOT NULL, \ - \ event_type questionnaire_event_type NOT NULL, \ - \ path text, \ - \ created_at timestamptz NOT NULL, \ - \ created_by uuid, \ - \ questionnaire_uuid uuid NOT NULL, \ - \ tenant_uuid uuid NOT NULL, \ - \ value_type value_type, \ - \ value text[], \ - \ value_id text, \ - \ value_raw jsonb, \ - \ CONSTRAINT questionnaire_event_pk PRIMARY KEY (uuid), \ - \ CONSTRAINT questionnaire_event_created_by_fk FOREIGN KEY (created_by) REFERENCES user_entity(uuid) ON DELETE SET NULL, \ - \ CONSTRAINT questionnaire_event_questionnaire_uuid_fk FOREIGN KEY (questionnaire_uuid) REFERENCES questionnaire(uuid) ON DELETE CASCADE, \ - \ CONSTRAINT questionnaire_event_tenant_uuid_fk FOREIGN KEY (tenant_uuid) REFERENCES tenant(uuid) ON DELETE CASCADE \ - \);" - let action conn = execute_ conn sql - runDB action - -createQtnAclUserTable = do - logInfo _CMP_MIGRATION "(Table/QuestionnaireAclUser) create table" - let sql = - "CREATE TABLE questionnaire_perm_user \ - \( \ - \ questionnaire_uuid uuid NOT NULL, \ - \ user_uuid uuid NOT NULL, \ - \ perms text[] NOT NULL, \ - \ tenant_uuid uuid NOT NULL, \ - \ CONSTRAINT questionnaire_perm_user_pk PRIMARY KEY (user_uuid, questionnaire_uuid), \ - \ CONSTRAINT questionnaire_perm_user_questionnaire_uuid_fk FOREIGN KEY (questionnaire_uuid) REFERENCES questionnaire (uuid) ON DELETE CASCADE, \ - \ CONSTRAINT questionnaire_perm_user_user_uuid_fk FOREIGN KEY (user_uuid) REFERENCES user_entity (uuid) ON DELETE CASCADE, \ - \ CONSTRAINT questionnaire_perm_user_tenant_uuid_fk FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) ON DELETE CASCADE \ - \);" - let action conn = execute_ conn sql - runDB action - -createQtnAclGroupTable = do - logInfo _CMP_MIGRATION "(Table/QuestionnaireAclGroup) create table" - let sql = - "CREATE TABLE questionnaire_perm_group \ - \( \ - \ questionnaire_uuid uuid NOT NULL, \ - \ user_group_uuid uuid NOT NULL, \ - \ perms text[] NOT NULL, \ - \ tenant_uuid uuid NOT NULL, \ - \ CONSTRAINT questionnaire_perm_group_pk PRIMARY KEY (user_group_uuid, questionnaire_uuid), \ - \ CONSTRAINT questionnaire_perm_group_questionnaire_uuid_fk FOREIGN KEY (questionnaire_uuid) REFERENCES questionnaire (uuid) ON DELETE CASCADE, \ - \ CONSTRAINT questionnaire_perm_group_user_group_uuid_fk FOREIGN KEY (user_group_uuid) REFERENCES user_group (uuid) ON DELETE CASCADE, \ - \ CONSTRAINT questionnaire_perm_group_tenant_uuid_fk FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) ON DELETE CASCADE \ - \);" - let action conn = execute_ conn sql - runDB action - -createQtnCommentThreadTable = do - logInfo _CMP_MIGRATION "(Table/QuestionnaireCommentThread) create table" - let sql = - "CREATE TABLE questionnaire_comment_thread \ - \( \ - \ uuid uuid NOT NULL, \ - \ path text NOT NULL, \ - \ resolved bool NOT NULL, \ - \ private bool NOT NULL, \ - \ questionnaire_uuid uuid NOT NULL, \ - \ created_by uuid, \ - \ created_at timestamptz NOT NULL, \ - \ updated_at timestamptz NOT NULL, \ - \ tenant_uuid uuid NOT NULL, \ - \ assigned_to uuid, \ - \ assigned_by uuid, \ - \ notification_required bool NOT NULL DEFAULT false, \ - \ CONSTRAINT questionnaire_comment_thread_pk PRIMARY KEY (uuid), \ - \ CONSTRAINT questionnaire_comment_thread_questionnaire_uuid FOREIGN KEY (questionnaire_uuid) REFERENCES questionnaire (uuid) ON DELETE CASCADE, \ - \ CONSTRAINT questionnaire_comment_thread_assigned_to FOREIGN KEY (assigned_to) REFERENCES user_entity (uuid) ON DELETE SET NULL, \ - \ CONSTRAINT questionnaire_comment_thread_assigned_by FOREIGN KEY (assigned_by) REFERENCES user_entity (uuid) ON DELETE SET NULL, \ - \ CONSTRAINT questionnaire_comment_thread_tenant_uuid FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) ON DELETE CASCADE \ - \);" - let action conn = execute_ conn sql - runDB action - -createQtnCommentTable = do - logInfo _CMP_MIGRATION "(Table/QuestionnaireComment) create table" - let sql = - "CREATE TABLE questionnaire_comment \ - \( \ - \ uuid uuid NOT NULL, \ - \ text text NOT NULL, \ - \ comment_thread_uuid uuid, \ - \ created_by uuid, \ - \ created_at timestamptz NOT NULL, \ - \ updated_at timestamptz NOT NULL, \ - \ tenant_uuid uuid NOT NULL, \ - \ CONSTRAINT questionnaire_comment_pk PRIMARY KEY (uuid), \ - \ CONSTRAINT questionnaire_comment_comment_thread_uuid FOREIGN KEY (comment_thread_uuid) REFERENCES questionnaire_comment_thread (uuid) ON DELETE CASCADE, \ - \ CONSTRAINT questionnaire_comment_tenant_uuid FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) ON DELETE CASCADE \ - \);" - let action conn = execute_ conn sql - runDB action - -createQtnVersionTable = do - logInfo _CMP_MIGRATION "(Table/QuestionnaireVersion) create table" - let sql = - "CREATE TABLE questionnaire_version \ - \( \ - \ uuid uuid NOT NULL, \ - \ name varchar NOT NULL, \ - \ description varchar, \ - \ event_uuid uuid NOT NULL, \ - \ questionnaire_uuid uuid NOT NULL, \ - \ tenant_uuid uuid NOT NULL, \ - \ created_by uuid, \ - \ created_at timestamptz NOT NULL, \ - \ updated_at timestamptz NOT NULL, \ - \ CONSTRAINT questionnaire_version_pk PRIMARY KEY (uuid), \ - \ CONSTRAINT questionnaire_version_event_uuid_fk FOREIGN KEY (event_uuid) REFERENCES questionnaire_event (uuid) ON DELETE CASCADE, \ - \ CONSTRAINT questionnaire_version_questionnaire_uuid_fk FOREIGN KEY (questionnaire_uuid) REFERENCES questionnaire (uuid) ON DELETE CASCADE, \ - \ CONSTRAINT questionnaire_version_tenant_uuid_fk FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) ON DELETE CASCADE, \ - \ CONSTRAINT questionnaire_version_created_by_fk FOREIGN KEY (created_by) REFERENCES user_entity (uuid) ON DELETE SET NULL \ - \);" - let action conn = execute_ conn sql - runDB action - -createQtnFileTable = do - logInfo _CMP_MIGRATION "(Table/QuestionnaireFile) create table" - let sql = - "CREATE TABLE questionnaire_file \ - \( \ - \ uuid uuid NOT NULL, \ - \ file_name varchar NOT NULL, \ - \ content_type varchar NOT NULL, \ - \ file_size bigint NOT NULL, \ - \ questionnaire_uuid uuid NOT NULL, \ - \ created_by uuid, \ - \ tenant_uuid uuid NOT NULL, \ - \ created_at timestamptz NOT NULL, \ - \ CONSTRAINT questionnaire_file_pk PRIMARY KEY (uuid), \ - \ CONSTRAINT questionnaire_file_questionnaire_uuid_fk FOREIGN KEY (questionnaire_uuid) REFERENCES questionnaire (uuid) ON DELETE CASCADE, \ - \ CONSTRAINT questionnaire_file_created_by_fk FOREIGN KEY (created_by) REFERENCES user_entity (uuid) ON DELETE SET NULL, \ - \ CONSTRAINT questionnaire_file_tenant_uuid_fk FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) ON DELETE CASCADE \ - \);" - let action conn = execute_ conn sql - runDB action - -createFunctions :: AppContextM Int64 -createFunctions = do - logInfo _CMP_MIGRATION "(Function/Questionnaire) create functions" - createPersistentCommandFromQuestionnaireFileDeleteFunction - -createPersistentCommandFromQuestionnaireFileDeleteFunction = do - let sql = - "CREATE OR REPLACE FUNCTION create_persistent_command_from_questionnaire_file_delete() \ - \ RETURNS TRIGGER AS \ - \$$ \ - \BEGIN \ - \ PERFORM create_persistent_command( \ - \ 'questionnaire_file', \ - \ 'deleteFromS3', \ - \ jsonb_build_object('questionnaireUuid', OLD.questionnaire_uuid, 'fileUuid', OLD.uuid), \ - \ OLD.tenant_uuid); \ - \ RETURN OLD; \ - \END; \ - \$$ LANGUAGE plpgsql;" - let action conn = execute_ conn sql - runDB action - -createTriggers :: AppContextM Int64 -createTriggers = do - logInfo _CMP_MIGRATION "(Trigger/Questionnaire) create triggers" - let sql = - "CREATE OR REPLACE TRIGGER trigger_on_after_questionnaire_file_delete \ - \ AFTER DELETE \ - \ ON questionnaire_file \ - \ FOR EACH ROW \ - \EXECUTE FUNCTION create_persistent_command_from_questionnaire_file_delete();" - let action conn = execute_ conn sql - runDB action diff --git a/wizard-server/src/Wizard/Database/Migration/Development/QuestionnaireAction/Data/QuestionnaireActions.hs b/wizard-server/src/Wizard/Database/Migration/Development/QuestionnaireAction/Data/QuestionnaireActions.hs deleted file mode 100644 index da0e97019..000000000 --- a/wizard-server/src/Wizard/Database/Migration/Development/QuestionnaireAction/Data/QuestionnaireActions.hs +++ /dev/null @@ -1,122 +0,0 @@ -module Wizard.Database.Migration.Development.QuestionnaireAction.Data.QuestionnaireActions where - -import qualified Data.Aeson.KeyMap as KM - -import Shared.Common.Constant.Tenant -import Shared.Common.Util.Date -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionDTO -import Wizard.Constant.QuestionnaireAction -import Wizard.Model.QuestionnaireAction.QuestionnaireAction -import Wizard.Service.QuestionnaireAction.QuestionnaireActionMapper - -questionnaireActionFtp1 :: QuestionnaireAction -questionnaireActionFtp1 = - QuestionnaireAction - { qaId = "global:questionnaire-action-ftp:1.0.0" - , name = "Questionnaire Action FTP" - , organizationId = "global" - , actionId = "questionnaire-action-ftp" - , version = "1.0.0" - , metamodelVersion = questionnaireActionMetamodelVersion - , description = "Uploading questionnaire to FTP" - , readme = "# Questionnaire Action FTP" - , license = "Apache-2.0" - , allowedPackages = [kmPackagePatternAll] - , url = "http://example.com/questionnaire-action-ftp" - , config = KM.empty - , enabled = True - , tenantUuid = defaultTenantUuid - , createdAt = dt' 2018 1 21 - , updatedAt = dt' 2018 1 21 - } - -questionnaireActionFtp2 :: QuestionnaireAction -questionnaireActionFtp2 = - QuestionnaireAction - { qaId = "global:questionnaire-action-ftp:2.0.0" - , name = "Questionnaire Action FTP" - , organizationId = "global" - , actionId = "questionnaire-action-ftp" - , version = "2.0.0" - , metamodelVersion = questionnaireActionMetamodelVersion - , description = "Uploading questionnaire to FTP" - , readme = "# Questionnaire Action FTP" - , license = "Apache-2.0" - , allowedPackages = [kmPackagePatternAll] - , url = "http://example.com/questionnaire-action-ftp" - , config = KM.empty - , enabled = True - , tenantUuid = defaultTenantUuid - , createdAt = dt' 2018 1 21 - , updatedAt = dt' 2018 1 21 - } - -questionnaireActionFtp3 :: QuestionnaireAction -questionnaireActionFtp3 = - QuestionnaireAction - { qaId = "global:questionnaire-action-ftp:3.0.0" - , name = "Questionnaire Action FTP" - , organizationId = "global" - , actionId = "questionnaire-action-ftp" - , version = "3.0.0" - , metamodelVersion = questionnaireActionMetamodelVersion - , description = "Uploading questionnaire to FTP" - , readme = "# Questionnaire Action FTP" - , license = "Apache-2.0" - , allowedPackages = [kmPackagePatternAll] - , url = "http://example.com/questionnaire-action-ftp" - , config = KM.empty - , enabled = False - , tenantUuid = defaultTenantUuid - , createdAt = dt' 2018 1 21 - , updatedAt = dt' 2018 1 21 - } - -questionnaireActionFtp3Edited :: QuestionnaireAction -questionnaireActionFtp3Edited = questionnaireActionFtp3 {enabled = True} - -questionnaireActionFtp3Dto :: QuestionnaireActionDTO -questionnaireActionFtp3Dto = toDTO questionnaireActionFtp3 - -questionnaireActionMail1 :: QuestionnaireAction -questionnaireActionMail1 = - QuestionnaireAction - { qaId = "global:questionnaire-action-mail:1.0.0" - , name = "Questionnaire Action Mail" - , organizationId = "global" - , actionId = "questionnaire-action-mail" - , version = "1.0.0" - , metamodelVersion = questionnaireActionMetamodelVersion - , description = "Sending questionnaire via mail" - , readme = "# Questionnaire Action Mail" - , license = "Apache-2.0" - , allowedPackages = [kmPackagePatternGlobal] - , url = "http://example.com/questionnaire-action-mail" - , config = KM.empty - , enabled = True - , tenantUuid = defaultTenantUuid - , createdAt = dt' 2018 1 21 - , updatedAt = dt' 2018 1 21 - } - -questionnaireActionScp1 :: QuestionnaireAction -questionnaireActionScp1 = - QuestionnaireAction - { qaId = "global:questionnaire-action-onto:1.0.0" - , name = "Questionnaire Action SCP" - , organizationId = "global" - , actionId = "questionnaire-action-onto" - , version = "1.0.0" - , metamodelVersion = questionnaireActionMetamodelVersion - , description = "Uploading questionnaire via SCP" - , readme = "# Questionnaire Action SCP" - , license = "Apache-2.0" - , allowedPackages = [kmPackagePatternGlobal] - , url = "http://example.com/questionnaire-action-onto" - , config = KM.empty - , enabled = False - , tenantUuid = defaultTenantUuid - , createdAt = dt' 2018 1 21 - , updatedAt = dt' 2018 1 21 - } diff --git a/wizard-server/src/Wizard/Database/Migration/Development/QuestionnaireAction/QuestionnaireActionMigration.hs b/wizard-server/src/Wizard/Database/Migration/Development/QuestionnaireAction/QuestionnaireActionMigration.hs deleted file mode 100644 index cd52585fc..000000000 --- a/wizard-server/src/Wizard/Database/Migration/Development/QuestionnaireAction/QuestionnaireActionMigration.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Wizard.Database.Migration.Development.QuestionnaireAction.QuestionnaireActionMigration where - -import Shared.Common.Constant.Component -import Shared.Common.Util.Logger -import Wizard.Database.DAO.QuestionnaireAction.QuestionnaireActionDAO -import Wizard.Database.Migration.Development.QuestionnaireAction.Data.QuestionnaireActions -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.ContextLenses () - -runMigration :: AppContextM () -runMigration = do - logInfo _CMP_MIGRATION "(QuestionnaireAction/QuestionnaireAction) started" - deleteQuestionnaireActions - insertQuestionnaireAction questionnaireActionFtp1 - insertQuestionnaireAction questionnaireActionFtp2 - insertQuestionnaireAction questionnaireActionFtp3 - insertQuestionnaireAction questionnaireActionMail1 - insertQuestionnaireAction questionnaireActionScp1 - logInfo _CMP_MIGRATION "(QuestionnaireAction/QuestionnaireAction) ended" diff --git a/wizard-server/src/Wizard/Database/Migration/Development/QuestionnaireAction/QuestionnaireActionSchemaMigration.hs b/wizard-server/src/Wizard/Database/Migration/Development/QuestionnaireAction/QuestionnaireActionSchemaMigration.hs deleted file mode 100644 index 5d2c504aa..000000000 --- a/wizard-server/src/Wizard/Database/Migration/Development/QuestionnaireAction/QuestionnaireActionSchemaMigration.hs +++ /dev/null @@ -1,44 +0,0 @@ -module Wizard.Database.Migration.Development.QuestionnaireAction.QuestionnaireActionSchemaMigration where - -import Database.PostgreSQL.Simple -import GHC.Int - -import Shared.Common.Util.Logger -import Wizard.Database.DAO.Common -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.ContextLenses () - -dropTables :: AppContextM Int64 -dropTables = do - logInfo _CMP_MIGRATION "(Table/QuestionnaireAction) drop tables" - let sql = "DROP TABLE IF EXISTS questionnaire_action CASCADE;" - let action conn = execute_ conn sql - runDB action - -createTables :: AppContextM Int64 -createTables = do - logInfo _CMP_MIGRATION "(Table/QuestionnaireAction) create table" - let sql = - "CREATE TABLE questionnaire_action \ - \( \ - \ id varchar NOT NULL, \ - \ name varchar NOT NULL, \ - \ organization_id varchar NOT NULL, \ - \ action_id varchar NOT NULL, \ - \ version varchar NOT NULL, \ - \ metamodel_version integer NOT NULL, \ - \ description varchar NOT NULL, \ - \ readme varchar NOT NULL, \ - \ license varchar NOT NULL, \ - \ allowed_packages jsonb NOT NULL, \ - \ url varchar, \ - \ config jsonb NOT NULL, \ - \ enabled bool NOT NULL, \ - \ tenant_uuid uuid NOT NULL, \ - \ created_at timestamptz NOT NULL, \ - \ updated_at timestamptz NOT NULL, \ - \ CONSTRAINT questionnaire_action_pk PRIMARY KEY (id, tenant_uuid), \ - \ CONSTRAINT questionnaire_action_tenant_uuid_fk FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) ON DELETE CASCADE \ - \);" - let action conn = execute_ conn sql - runDB action diff --git a/wizard-server/src/Wizard/Database/Migration/Development/QuestionnaireImporter/Data/QuestionnaireImporters.hs b/wizard-server/src/Wizard/Database/Migration/Development/QuestionnaireImporter/Data/QuestionnaireImporters.hs deleted file mode 100644 index 973acbbd6..000000000 --- a/wizard-server/src/Wizard/Database/Migration/Development/QuestionnaireImporter/Data/QuestionnaireImporters.hs +++ /dev/null @@ -1,115 +0,0 @@ -module Wizard.Database.Migration.Development.QuestionnaireImporter.Data.QuestionnaireImporters where - -import Shared.Common.Constant.Tenant -import Shared.Common.Util.Date -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterDTO -import Wizard.Constant.QuestionnaireImporter -import Wizard.Model.QuestionnaireImporter.QuestionnaireImporter -import Wizard.Service.QuestionnaireImporter.QuestionnaireImporterMapper - -questionnaireImporterBio1 :: QuestionnaireImporter -questionnaireImporterBio1 = - QuestionnaireImporter - { qiId = "global:questionnaire-importer-bio:1.0.0" - , name = "QuestionnaireImporterBio" - , organizationId = "global" - , importerId = "questionnaire-importer-bio" - , version = "1.0.0" - , metamodelVersion = questionnaireImporterMetamodelVersion - , description = "Import bio answers from questionnaire" - , readme = "# Default QuestionnaireImporter BIO 1" - , license = "Apache-2.0" - , allowedPackages = [kmPackagePatternAll] - , url = "http://example.com/questionnaire-importer-bio" - , enabled = True - , tenantUuid = defaultTenantUuid - , createdAt = dt' 2018 1 21 - , updatedAt = dt' 2018 1 21 - } - -questionnaireImporterBio2 :: QuestionnaireImporter -questionnaireImporterBio2 = - QuestionnaireImporter - { qiId = "global:questionnaire-importer-bio:2.0.0" - , name = "QuestionnaireImporterBio" - , organizationId = "global" - , importerId = "questionnaire-importer-bio" - , version = "2.0.0" - , metamodelVersion = questionnaireImporterMetamodelVersion - , description = "Import bio answers from questionnaire" - , readme = "# Default QuestionnaireImporter BIO 2" - , license = "Apache-2.0" - , allowedPackages = [kmPackagePatternAll] - , url = "http://example.com/questionnaire-importer-bio" - , enabled = True - , tenantUuid = defaultTenantUuid - , createdAt = dt' 2018 1 21 - , updatedAt = dt' 2018 1 21 - } - -questionnaireImporterBio3 :: QuestionnaireImporter -questionnaireImporterBio3 = - QuestionnaireImporter - { qiId = "global:questionnaire-importer-bio:3.0.0" - , name = "QuestionnaireImporterBio" - , organizationId = "global" - , importerId = "questionnaire-importer-bio" - , version = "3.0.0" - , metamodelVersion = questionnaireImporterMetamodelVersion - , description = "Import bio answers from questionnaire" - , readme = "# Default QuestionnaireImporter BIO 3" - , license = "Apache-2.0" - , allowedPackages = [kmPackagePatternAll] - , url = "http://example.com/questionnaire-importer-bio" - , enabled = False - , tenantUuid = defaultTenantUuid - , createdAt = dt' 2018 1 21 - , updatedAt = dt' 2018 1 21 - } - -questionnaireImporterBio3Edited :: QuestionnaireImporter -questionnaireImporterBio3Edited = questionnaireImporterBio3 {enabled = True} - -questionnaireImporterBio3Dto :: QuestionnaireImporterDTO -questionnaireImporterBio3Dto = toDTO questionnaireImporterBio3 - -questionnaireImporterExt1 :: QuestionnaireImporter -questionnaireImporterExt1 = - QuestionnaireImporter - { qiId = "global:questionnaire-ext-importer:1.0.0" - , name = "QuestionnaireImporterExt" - , organizationId = "global" - , importerId = "questionnaire-ext-importer" - , version = "1.0.0" - , metamodelVersion = questionnaireImporterMetamodelVersion - , description = "Import ext answers from questionnaire" - , readme = "# Default Ext QuestionnaireImporter" - , license = "Apache-2.0" - , allowedPackages = [kmPackagePatternGlobal] - , url = "http://example.com/questionnaire-ext-importer" - , enabled = True - , tenantUuid = defaultTenantUuid - , createdAt = dt' 2018 1 21 - , updatedAt = dt' 2018 1 21 - } - -questionnaireImporterOnto1 :: QuestionnaireImporter -questionnaireImporterOnto1 = - QuestionnaireImporter - { qiId = "global:questionnaire-importer-onto:1.0.0" - , name = "QuestionnaireImporterOnto" - , organizationId = "global" - , importerId = "questionnaire-importer-onto" - , version = "1.0.0" - , metamodelVersion = questionnaireImporterMetamodelVersion - , description = "Import onto answers from questionnaire" - , readme = "# Default Ext QuestionnaireImporter" - , license = "Apache-2.0" - , allowedPackages = [kmPackagePatternGlobal] - , url = "http://example.com/questionnaire-importer-onto" - , enabled = False - , tenantUuid = defaultTenantUuid - , createdAt = dt' 2018 1 21 - , updatedAt = dt' 2018 1 21 - } diff --git a/wizard-server/src/Wizard/Database/Migration/Development/QuestionnaireImporter/QuestionnaireImporterMigration.hs b/wizard-server/src/Wizard/Database/Migration/Development/QuestionnaireImporter/QuestionnaireImporterMigration.hs deleted file mode 100644 index 1bf91f14b..000000000 --- a/wizard-server/src/Wizard/Database/Migration/Development/QuestionnaireImporter/QuestionnaireImporterMigration.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Wizard.Database.Migration.Development.QuestionnaireImporter.QuestionnaireImporterMigration where - -import Shared.Common.Constant.Component -import Shared.Common.Util.Logger -import Wizard.Database.DAO.QuestionnaireImporter.QuestionnaireImporterDAO -import Wizard.Database.Migration.Development.QuestionnaireImporter.Data.QuestionnaireImporters -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.ContextLenses () - -runMigration :: AppContextM () -runMigration = do - logInfo _CMP_MIGRATION "(QuestionnaireImporter/QuestionnaireImporter) started" - deleteQuestionnaireImporters - insertQuestionnaireImporter questionnaireImporterBio1 - insertQuestionnaireImporter questionnaireImporterBio2 - insertQuestionnaireImporter questionnaireImporterBio3 - insertQuestionnaireImporter questionnaireImporterExt1 - insertQuestionnaireImporter questionnaireImporterOnto1 - logInfo _CMP_MIGRATION "(QuestionnaireImporter/QuestionnaireImporter) ended" diff --git a/wizard-server/src/Wizard/Database/Migration/Development/QuestionnaireImporter/QuestionnaireImporterSchemaMigration.hs b/wizard-server/src/Wizard/Database/Migration/Development/QuestionnaireImporter/QuestionnaireImporterSchemaMigration.hs deleted file mode 100644 index 34b11f1b0..000000000 --- a/wizard-server/src/Wizard/Database/Migration/Development/QuestionnaireImporter/QuestionnaireImporterSchemaMigration.hs +++ /dev/null @@ -1,43 +0,0 @@ -module Wizard.Database.Migration.Development.QuestionnaireImporter.QuestionnaireImporterSchemaMigration where - -import Database.PostgreSQL.Simple -import GHC.Int - -import Shared.Common.Util.Logger -import Wizard.Database.DAO.Common -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.ContextLenses () - -dropTables :: AppContextM Int64 -dropTables = do - logInfo _CMP_MIGRATION "(Table/QuestionnaireImporter) drop tables" - let sql = "DROP TABLE IF EXISTS questionnaire_importer CASCADE;" - let action conn = execute_ conn sql - runDB action - -createTables :: AppContextM Int64 -createTables = do - logInfo _CMP_MIGRATION "(Table/QuestionnaireImporter) create table" - let sql = - "CREATE TABLE questionnaire_importer \ - \( \ - \ id varchar NOT NULL, \ - \ name varchar NOT NULL, \ - \ organization_id varchar NOT NULL, \ - \ importer_id varchar NOT NULL, \ - \ version varchar NOT NULL, \ - \ metamodel_version integer NOT NULL, \ - \ description varchar NOT NULL, \ - \ readme varchar NOT NULL, \ - \ license varchar NOT NULL, \ - \ allowed_packages jsonb NOT NULL, \ - \ url varchar, \ - \ enabled bool NOT NULL, \ - \ tenant_uuid uuid NOT NULL, \ - \ created_at timestamptz NOT NULL, \ - \ updated_at timestamptz NOT NULL, \ - \ CONSTRAINT questionnaire_importer_pk PRIMARY KEY (id, tenant_uuid), \ - \ CONSTRAINT questionnaire_importer_tenant_uuid_fk FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) ON DELETE CASCADE \ - \);" - let action conn = execute_ conn sql - runDB action diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Report/Data/Reports.hs b/wizard-server/src/Wizard/Database/Migration/Development/Report/Data/Reports.hs index b40e62844..75ed4fc13 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/Report/Data/Reports.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/Report/Data/Reports.hs @@ -7,7 +7,7 @@ import qualified Data.UUID as U import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Chapters import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Metrics import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel -import Wizard.Api.Resource.Questionnaire.QuestionnaireReportDTO +import Wizard.Api.Resource.Project.ProjectReportDTO import Wizard.Model.Report.Report report1 :: Report @@ -142,9 +142,9 @@ report1_ch3_full = -- ------------------------------------------------------------------------ -- ------------------------------------------------------------------------ -questionnaireReport :: QuestionnaireReportDTO -questionnaireReport = - QuestionnaireReportDTO +projectReport :: ProjectReportDTO +projectReport = + ProjectReportDTO { indications = [ PhasesAnsweredIndication' $ PhasesAnsweredIndication diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Tenant/Data/TenantConfigs.hs b/wizard-server/src/Wizard/Database/Migration/Development/Tenant/Data/TenantConfigs.hs index ef63cb698..c1b72b3ec 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/Tenant/Data/TenantConfigs.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/Tenant/Data/TenantConfigs.hs @@ -13,7 +13,7 @@ import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data. import Shared.OpenId.Database.Migration.Development.OpenId.Data.OpenIds import Wizard.Api.Resource.Tenant.Config.TenantConfigChangeDTO import Wizard.Database.Migration.Development.Tenant.Data.Tenants -import Wizard.Model.Questionnaire.Questionnaire +import Wizard.Model.Project.Project import Wizard.Model.Tenant.Config.TenantConfig import Wizard.Model.Tenant.Config.TenantConfigEM () import Wizard.Model.Tenant.Tenant @@ -34,7 +34,7 @@ defaultTenantConfig = , lookAndFeel = defaultLookAndFeel , registry = defaultRegistry , knowledgeModel = defaultKnowledgeModel - , questionnaire = defaultQuestionnaire + , project = defaultProject , submission = defaultSubmission , owl = defaultOwl , mailConfigUuid = Nothing @@ -44,7 +44,7 @@ defaultTenantConfig = } defaultTenantConfigChangeDto :: TenantConfigChangeDTO -defaultTenantConfigChangeDto = toChangeDTO defaultOrganizationChangeDto defaultAuthenticationChangeDto defaultPrivacyAndSupportChangeDto defaultDashboardAndLoginScreenChangeDto defaultLookAndFeelChangeDto defaultRegistryChangeDto defaultKnowledgeModelChangeDto defaultQuestionnaireChangeDto defaultSubmissionChangeDto defaultFeaturesChangeDto +defaultTenantConfigChangeDto = toChangeDTO defaultOrganizationChangeDto defaultAuthenticationChangeDto defaultPrivacyAndSupportChangeDto defaultDashboardAndLoginScreenChangeDto defaultLookAndFeelChangeDto defaultRegistryChangeDto defaultKnowledgeModelChangeDto defaultProjectChangeDto defaultSubmissionChangeDto defaultFeaturesChangeDto defaultOrganization :: TenantConfigOrganization defaultOrganization = fromOrganizationChangeDTO defaultOrganizationChangeDto defaultTenant.uuid (dt' 2018 1 20) (dt' 2018 1 20) @@ -190,52 +190,52 @@ defaultKnowledgeModelPublicPackagePattern = , updatedAt = dt' 2018 1 20 } -defaultQuestionnaire :: TenantConfigQuestionnaire -defaultQuestionnaire = fromQuestionnaireChangeDTO defaultQuestionnaireChangeDto defaultTenant.uuid (dt' 2018 1 20) (dt' 2018 1 20) +defaultProject :: TenantConfigProject +defaultProject = fromProjectChangeDTO defaultProjectChangeDto defaultTenant.uuid (dt' 2018 1 20) (dt' 2018 1 20) -defaultQuestionnaireEncrypted :: TenantConfigQuestionnaire -defaultQuestionnaireEncrypted = process defaultSecret defaultQuestionnaire +defaultProjectEncrypted :: TenantConfigProject +defaultProjectEncrypted = process defaultSecret defaultProject -defaultQuestionnaireChangeDto :: TenantConfigQuestionnaireChangeDTO -defaultQuestionnaireChangeDto = - TenantConfigQuestionnaireChangeDTO - { questionnaireVisibility = defaultQuestionnaireVisibility - , questionnaireSharing = defaultQuestionnaireSharing - , questionnaireCreation = TemplateAndCustomQuestionnaireCreation - , projectTagging = defaultQuestionnaireProjectTagging +defaultProjectChangeDto :: TenantConfigProjectChangeDTO +defaultProjectChangeDto = + TenantConfigProjectChangeDTO + { projectVisibility = defaultProjectVisibility + , projectSharing = defaultProjectSharing + , projectCreation = TemplateAndCustomProjectCreation + , projectTagging = defaultProjectProjectTagging , summaryReport = SimpleFeature True , feedback = defaultFeedback } -defaultQuestionnaireVisibility :: TenantConfigQuestionnaireVisibility -defaultQuestionnaireVisibility = - TenantConfigQuestionnaireVisibility +defaultProjectVisibility :: TenantConfigProjectVisibility +defaultProjectVisibility = + TenantConfigProjectVisibility { enabled = True - , defaultValue = PrivateQuestionnaire + , defaultValue = PrivateProjectVisibility } -defaultQuestionnaireSharing :: TenantConfigQuestionnaireSharing -defaultQuestionnaireSharing = - TenantConfigQuestionnaireSharing +defaultProjectSharing :: TenantConfigProjectSharing +defaultProjectSharing = + TenantConfigProjectSharing { enabled = True - , defaultValue = RestrictedQuestionnaire + , defaultValue = RestrictedProjectSharing , anonymousEnabled = False } -_SETTINGS_PROJECT_TAG_1 = "settingsProjectTag1" +_SETTINGS__PROJECT_TAG_1 = "settingsProjectTag1" -_SETTINGS_PROJECT_TAG_2 = "settingsProjectTag2" +_SETTINGS__PROJECT_TAG_2 = "settingsProjectTag2" -defaultQuestionnaireProjectTagging :: TenantConfigQuestionnaireProjectTagging -defaultQuestionnaireProjectTagging = - TenantConfigQuestionnaireProjectTagging +defaultProjectProjectTagging :: TenantConfigProjectProjectTagging +defaultProjectProjectTagging = + TenantConfigProjectProjectTagging { enabled = True - , tags = [_SETTINGS_PROJECT_TAG_1, _SETTINGS_PROJECT_TAG_2] + , tags = [_SETTINGS__PROJECT_TAG_1, _SETTINGS__PROJECT_TAG_2] } -defaultFeedback :: TenantConfigQuestionnaireFeedback +defaultFeedback :: TenantConfigProjectFeedback defaultFeedback = - TenantConfigQuestionnaireFeedback + TenantConfigProjectFeedback { enabled = True , token = "" , owner = "DSWGlobal" @@ -334,11 +334,11 @@ defaultOwl = -- ------------------------------------------------------------ -- ------------------------------------------------------------ -editedQuestionnaire :: TenantConfigQuestionnaire -editedQuestionnaire = fromQuestionnaireChangeDTO editedQuestionnaireChangeDto defaultTenant.uuid (dt' 2018 1 20) (dt' 2018 1 20) +editedProject :: TenantConfigProject +editedProject = fromProjectChangeDTO editedProjectChangeDto defaultTenant.uuid (dt' 2018 1 20) (dt' 2018 1 20) -editedQuestionnaireChangeDto :: TenantConfigQuestionnaireChangeDTO -editedQuestionnaireChangeDto = defaultQuestionnaireChangeDto {summaryReport = SimpleFeature False} +editedProjectChangeDto :: TenantConfigProjectChangeDTO +editedProjectChangeDto = defaultProjectChangeDto {summaryReport = SimpleFeature False} -- ------------------------------------------------------------ -- ------------------------------------------------------------ diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Tenant/Data/TenantLimitBundles.hs b/wizard-server/src/Wizard/Database/Migration/Development/Tenant/Data/TenantLimitBundles.hs index 5da209254..ad5f48ce6 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/Tenant/Data/TenantLimitBundles.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/Tenant/Data/TenantLimitBundles.hs @@ -16,7 +16,7 @@ defaultTenantLimitBundle = , knowledgeModelEditors = -1000 , documentTemplates = -1000 , documentTemplateDrafts = -1000 - , questionnaires = -1000 + , projects = -1000 , documents = -1000 , locales = -1000 , storage = -1000 * 5 * 1000 * 1000 @@ -40,7 +40,7 @@ differentTenantLimitBundle = , knowledgeModelEditors = -1000 , documentTemplates = -1000 , documentTemplateDrafts = -1000 - , questionnaires = -1000 + , projects = -1000 , documents = -1000 , locales = -1000 , storage = -1000 * 5 * 1000 * 1000 diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Tenant/TenantMigration.hs b/wizard-server/src/Wizard/Database/Migration/Development/Tenant/TenantMigration.hs index 32b5b31a9..72f500db9 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/Tenant/TenantMigration.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/Tenant/TenantMigration.hs @@ -8,7 +8,7 @@ import Wizard.Database.DAO.Tenant.Config.TenantConfigKnowledgeModelDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigOrganizationDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigOwlDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigPrivacyAndSupportDAO -import Wizard.Database.DAO.Tenant.Config.TenantConfigQuestionnaireDAO +import Wizard.Database.DAO.Tenant.Config.TenantConfigProjectDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigRegistryDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigSubmissionDAO import Wizard.Database.DAO.Tenant.TenantDAO @@ -53,7 +53,7 @@ runConfigMigration = do insertTenantConfigRegistry defaultRegistryEncrypted insertTenantConfigKnowledgeModel defaultKnowledgeModelEncrypted insertTenantConfigKnowledgeModelPublicPackagePattern defaultKnowledgeModelPublicPackagePattern - insertTenantConfigQuestionnaire defaultQuestionnaireEncrypted + insertTenantConfigProject defaultProjectEncrypted insertTenantConfigSubmission (defaultSubmission {services = []}) insertTenantConfigFeatures defaultFeatures insertTenantConfigMail defaultMail diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Tenant/TenantSchemaMigration.hs b/wizard-server/src/Wizard/Database/Migration/Development/Tenant/TenantSchemaMigration.hs index cdd1f542b..629ebd1ad 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/Tenant/TenantSchemaMigration.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/Tenant/TenantSchemaMigration.hs @@ -28,7 +28,7 @@ dropConfigTables = do \DROP TABLE IF EXISTS config_submission_service_request_header;\ \DROP TABLE IF EXISTS config_submission_service;\ \DROP TABLE IF EXISTS config_submission;\ - \DROP TABLE IF EXISTS config_questionnaire;\ + \DROP TABLE IF EXISTS config_project;\ \DROP TABLE IF EXISTS config_knowledge_model_public_package_pattern;\ \DROP TABLE IF EXISTS config_knowledge_model;\ \DROP TABLE IF EXISTS config_registry;\ @@ -89,7 +89,7 @@ createConfigTables = do createTcRegistryTable createTcKnowledgeModelTable createTcKnowledgeModelPublicPackagePatternTable - createTcQuestionnaireTable + createTcProjectTable createTcSubmissionTable createTcFeaturesTable createTcMailTable @@ -301,10 +301,10 @@ createTcKnowledgeModelPublicPackagePatternTable = do let action conn = execute_ conn sql runDB action -createTcQuestionnaireTable = do - logInfo _CMP_MIGRATION "(Table/ConfigQuestionnaire) create tables" +createTcProjectTable = do + logInfo _CMP_MIGRATION "(Table/ConfigProject) create tables" let sql = - "CREATE TABLE config_questionnaire\ + "CREATE TABLE config_project\ \( \ \ tenant_uuid uuid NOT NULL, \ \ visibility_enabled boolean NOT NULL, \ @@ -322,8 +322,8 @@ createTcQuestionnaireTable = do \ feedback_repo TEXT NOT NULL, \ \ created_at timestamptz NOT NULL, \ \ updated_at timestamptz NOT NULL, \ - \ CONSTRAINT config_questionnaire_pk PRIMARY KEY (tenant_uuid), \ - \ CONSTRAINT config_questionnaire_tenant_uuid_fk FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) ON DELETE CASCADE \ + \ CONSTRAINT config_project_pk PRIMARY KEY (tenant_uuid), \ + \ CONSTRAINT config_project_tenant_uuid_fk FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) ON DELETE CASCADE \ \);" let action conn = execute_ conn sql runDB action @@ -445,7 +445,7 @@ createTenantLimitBundleTable = do \ knowledge_models integer NOT NULL, \ \ knowledge_model_editors integer NOT NULL, \ \ document_templates integer NOT NULL, \ - \ questionnaires integer NOT NULL, \ + \ projects integer NOT NULL, \ \ documents integer NOT NULL, \ \ storage bigint NOT NULL, \ \ created_at timestamptz NOT NULL, \ diff --git a/wizard-server/src/Wizard/Database/Migration/Development/TypeHint/Data/TypeHints.hs b/wizard-server/src/Wizard/Database/Migration/Development/TypeHint/Data/TypeHints.hs index 708176792..b4b8590ba 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/TypeHint/Data/TypeHints.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/TypeHint/Data/TypeHints.hs @@ -12,10 +12,10 @@ import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackage import Wizard.Api.Resource.TypeHint.TypeHintRequestDTO import Wizard.Api.Resource.TypeHint.TypeHintTestRequestDTO import Wizard.Database.Migration.Development.KnowledgeModel.Data.Editor.KnowledgeModelEditors -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires +import Wizard.Database.Migration.Development.Project.Data.Projects import Wizard.Integration.Resource.TypeHint.TypeHintIDTO import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditor -import Wizard.Model.Questionnaire.Questionnaire +import Wizard.Model.Project.Project forestDatasetTypeHint :: TypeHintIDTO forestDatasetTypeHint = @@ -77,8 +77,8 @@ kmEditorIntegrationTypeHintRequest = KnowledgeModelEditorIntegrationTypeHintRequ kmEditorQuestionTypeHintRequest :: TypeHintRequestDTO kmEditorQuestionTypeHintRequest = KnowledgeModelEditorQuestionTypeHintRequest' kmEditorQuestionTypeHintRequest' -questionnaireTypeHintRequest :: TypeHintRequestDTO -questionnaireTypeHintRequest = QuestionnaireTypeHintRequest' questionnaireTypeHintRequest' +projectTypeHintRequest :: TypeHintRequestDTO +projectTypeHintRequest = ProjectTypeHintRequest' projectTypeHintRequest' kmEditorIntegrationTypeHintRequest' :: KnowledgeModelEditorIntegrationTypeHintRequest kmEditorIntegrationTypeHintRequest' = @@ -95,10 +95,10 @@ kmEditorQuestionTypeHintRequest' = , q = "dog" } -questionnaireTypeHintRequest' :: QuestionnaireTypeHintRequest -questionnaireTypeHintRequest' = - QuestionnaireTypeHintRequest - { questionnaireUuid = questionnaire15.uuid +projectTypeHintRequest' :: ProjectTypeHintRequest +projectTypeHintRequest' = + ProjectTypeHintRequest + { projectUuid = project15.uuid , questionUuid = question15.uuid , q = "dog" } diff --git a/wizard-server/src/Wizard/Database/Migration/Development/User/Data/AlbertEinstein.hs b/wizard-server/src/Wizard/Database/Migration/Development/User/Data/AlbertEinstein.hs index 17d7aee6c..a39320aa4 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/User/Data/AlbertEinstein.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/User/Data/AlbertEinstein.hs @@ -49,11 +49,11 @@ userAlbert = , "KM_PUBLISH_PERM" , "PM_READ_PERM" , "PM_WRITE_PERM" - , "QTN_PERM" - , "QTN_FILE_PERM" - , "QTN_ACTION_PERM" - , "QTN_IMPORTER_PERM" - , "QTN_TML_PERM" + , "PRJ_PERM" + , "PRJ_FILE_PERM" + , "PRJ_ACTION_PERM" + , "PRJ_IMPORTER_PERM" + , "PJR_TML_PERM" , "DOC_TML_READ_PERM" , "CFG_PERM" , "SUBM_PERM" diff --git a/wizard-server/src/Wizard/Database/Migration/Development/User/Data/CharlesDarwin.hs b/wizard-server/src/Wizard/Database/Migration/Development/User/Data/CharlesDarwin.hs index c8b40b5fe..78d433425 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/User/Data/CharlesDarwin.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/User/Data/CharlesDarwin.hs @@ -18,7 +18,7 @@ userCharles = , affiliation = Nothing , sources = [_USER_SOURCE_INTERNAL] , uRole = _USER_ROLE_RESEARCHER - , permissions = ["PM_READ_PERM", "QTN_PERM", "DOC_TML_READ_PERM", "SUBM_PERM"] + , permissions = ["PM_READ_PERM", "PRJ_PERM", "DOC_TML_READ_PERM", "SUBM_PERM"] , active = True , -- cspell:disable passwordHash = "pbkdf1:sha256|17|awVwfF3h27PrxINtavVgFQ==|iUFbQnZFv+rBXBu1R2OkX+vEjPtohYk5lsyIeOBdEy4=" diff --git a/wizard-server/src/Wizard/Database/Migration/Development/User/Data/GalileoGalilei.hs b/wizard-server/src/Wizard/Database/Migration/Development/User/Data/GalileoGalilei.hs index 085f8233f..29a5fcf80 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/User/Data/GalileoGalilei.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/User/Data/GalileoGalilei.hs @@ -18,7 +18,7 @@ userGalileo = , affiliation = Nothing , sources = [_USER_SOURCE_INTERNAL] , uRole = _USER_ROLE_RESEARCHER - , permissions = ["PM_READ_PERM", "QTN_PERM", "DOC_TML_READ_PERM", "SUBM_PERM"] + , permissions = ["PM_READ_PERM", "PRJ_PERM", "DOC_TML_READ_PERM", "SUBM_PERM"] , active = True , -- cspell:disable passwordHash = "pbkdf1:sha256|17|awVwfF3h27PrxINtavVgFQ==|iUFbQnZFv+rBXBu1R2OkX+vEjPtohYk5lsyIeOBdEy4=" diff --git a/wizard-server/src/Wizard/Database/Migration/Development/User/Data/IsaacNewton.hs b/wizard-server/src/Wizard/Database/Migration/Development/User/Data/IsaacNewton.hs index 66c6a229d..48df9fede 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/User/Data/IsaacNewton.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/User/Data/IsaacNewton.hs @@ -25,7 +25,7 @@ userIsaac = , affiliation = Nothing , sources = [_USER_SOURCE_INTERNAL] , uRole = _USER_ROLE_RESEARCHER - , permissions = ["PM_READ_PERM", "QTN_PERM", "DOC_TML_READ_PERM", "SUBM_PERM"] + , permissions = ["PM_READ_PERM", "PRJ_PERM", "DOC_TML_READ_PERM", "SUBM_PERM"] , active = True , -- cspell:disable passwordHash = "pbkdf1:sha256|17|awVwfF3h27PrxINtavVgFQ==|iUFbQnZFv+rBXBu1R2OkX+vEjPtohYk5lsyIeOBdEy4=" diff --git a/wizard-server/src/Wizard/Database/Migration/Development/User/Data/NicolausCopernicus.hs b/wizard-server/src/Wizard/Database/Migration/Development/User/Data/NicolausCopernicus.hs index b98953559..3c2ac9e98 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/User/Data/NicolausCopernicus.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/User/Data/NicolausCopernicus.hs @@ -18,7 +18,7 @@ userNicolaus = , affiliation = Nothing , sources = [_USER_SOURCE_INTERNAL] , uRole = _USER_ROLE_RESEARCHER - , permissions = ["PM_READ_PERM", "QTN_PERM", "DOC_TML_READ_PERM", "SUBM_PERM"] + , permissions = ["PM_READ_PERM", "PRJ_PERM", "DOC_TML_READ_PERM", "SUBM_PERM"] , active = True , -- cspell:disable passwordHash = "pbkdf1:sha256|17|awVwfF3h27PrxINtavVgFQ==|iUFbQnZFv+rBXBu1R2OkX+vEjPtohYk5lsyIeOBdEy4=" diff --git a/wizard-server/src/Wizard/Database/Migration/Development/User/Data/NikolaTesla.hs b/wizard-server/src/Wizard/Database/Migration/Development/User/Data/NikolaTesla.hs index 6f90a556c..e96088100 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/User/Data/NikolaTesla.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/User/Data/NikolaTesla.hs @@ -31,10 +31,10 @@ userNikola = , "KM_PUBLISH_PERM" , "PM_READ_PERM" , "PM_WRITE_PERM" - , "QTN_PERM" - , "QTN_ACTION_PERM" - , "QTN_IMPORTER_PERM" - , "QTN_TML_PERM" + , "PRJ_PERM" + , "PRJ_ACTION_PERM" + , "PRJ_IMPORTER_PERM" + , "PJR_TML_PERM" , "DOC_TML_READ_PERM" , "SUBM_PERM" , "DOC_TML_WRITE_PERM" diff --git a/wizard-server/src/Wizard/Database/Migration/Development/User/Data/SystemUser.hs b/wizard-server/src/Wizard/Database/Migration/Development/User/Data/SystemUser.hs index f1b3d5bd5..29e811b88 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/User/Data/SystemUser.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/User/Data/SystemUser.hs @@ -27,11 +27,11 @@ userSystem = , "KM_PUBLISH_PERM" , "PM_READ_PERM" , "PM_WRITE_PERM" - , "QTN_PERM" - , "QTN_FILE_PERM" - , "QTN_ACTION_PERM" - , "QTN_IMPORTER_PERM" - , "QTN_TML_PERM" + , "PRJ_PERM" + , "PRJ_FILE_PERM" + , "PRJ_ACTION_PERM" + , "PRJ_IMPORTER_PERM" + , "PJR_TML_PERM" , "DOC_TML_READ_PERM" , "CFG_PERM" , "SUBM_PERM" diff --git a/wizard-server/src/Wizard/Database/Migration/Production/Migration_0061_news/Migration.hs b/wizard-server/src/Wizard/Database/Migration/Production/Migration_0061_news/Migration.hs index 12449a88a..4de73250b 100644 --- a/wizard-server/src/Wizard/Database/Migration/Production/Migration_0061_news/Migration.hs +++ b/wizard-server/src/Wizard/Database/Migration/Production/Migration_0061_news/Migration.hs @@ -14,7 +14,162 @@ meta = MigrationMeta {mmNumber = 61, mmName = "Add user news", mmDescription = " migrate :: Pool Connection -> LoggingT IO (Maybe Error) migrate dbPool = do + addLastSeeNewsIdColumnToUser dbPool + renameQuestionnaireToProject dbPool + renameAuditLogsAndPersistentCommands dbPool + +addLastSeeNewsIdColumnToUser dbPool = do let sql = "ALTER TABLE user_entity ADD COLUMN last_seen_news_id varchar;" let action conn = execute_ conn sql liftIO $ withResource dbPool action return Nothing + +renameQuestionnaireToProject dbPool = do + let sql = + "ALTER TABLE questionnaire_action RENAME TO project_action; \ + \ALTER TABLE project_action RENAME CONSTRAINT questionnaire_action_pk TO project_action_pk; \ + \ALTER TABLE project_action RENAME CONSTRAINT questionnaire_action_tenant_uuid_fk TO project_action_tenant_uuid_fk; \ + \ \ + \ALTER TABLE questionnaire RENAME TO project; \ + \ALTER TABLE project RENAME CONSTRAINT questionnaire_pk TO project_pk; \ + \ALTER TABLE project RENAME CONSTRAINT questionnaire_created_by_fk TO project_created_by_fk; \ + \ALTER TABLE project RENAME CONSTRAINT questionnaire_document_template_id_fk TO project_document_template_id_fk; \ + \ALTER TABLE project RENAME CONSTRAINT questionnaire_knowledge_model_package_id_fk TO project_knowledge_model_package_id_fk; \ + \ALTER TABLE project RENAME CONSTRAINT questionnaire_tenant_uuid_fk TO project_tenant_uuid_fk; \ + \ \ + \ALTER TABLE questionnaire_importer RENAME TO project_importer; \ + \ALTER TABLE project_importer RENAME CONSTRAINT questionnaire_importer_pk TO project_importer_pk; \ + \ALTER TABLE project_importer RENAME CONSTRAINT questionnaire_importer_tenant_uuid_fk TO project_importer_tenant_uuid_fk; \ + \ \ + \ALTER TABLE questionnaire_event RENAME TO project_event; \ + \ALTER TABLE project_event RENAME COLUMN questionnaire_uuid TO project_uuid; \ + \ALTER TABLE project_event RENAME CONSTRAINT questionnaire_event_pk TO project_event_pk; \ + \ALTER TABLE project_event RENAME CONSTRAINT questionnaire_event_created_by_fk TO project_event_created_by_fk; \ + \ALTER TABLE project_event RENAME CONSTRAINT questionnaire_event_tenant_uuid_fk TO project_event_tenant_uuid_fk; \ + \ALTER TABLE project_event RENAME CONSTRAINT questionnaire_event_questionnaire_uuid_fk TO project_event_project_uuid_fk; \ + \ \ + \ALTER TABLE questionnaire_migration RENAME TO project_migration; \ + \ALTER TABLE project_migration RENAME COLUMN old_questionnaire_uuid TO old_project_uuid; \ + \ALTER TABLE project_migration RENAME COLUMN new_questionnaire_uuid TO new_project_uuid; \ + \ALTER TABLE project_migration RENAME CONSTRAINT questionnaire_migration_pk TO project_migration_pk; \ + \ALTER TABLE project_migration RENAME CONSTRAINT questionnaire_migration_new_questionnaire_uuid_fk TO project_migration_new_project_uuid_fk; \ + \ALTER TABLE project_migration RENAME CONSTRAINT questionnaire_migration_old_questionnaire_uuid_fk TO project_migration_old_project_uuid_fk; \ + \ALTER TABLE project_migration RENAME CONSTRAINT questionnaire_migration_tenant_uuid_fk TO project_migration_tenant_uuid_fk; \ + \ \ + \ALTER TABLE questionnaire_file RENAME TO project_file; \ + \ALTER TABLE project_file RENAME COLUMN questionnaire_uuid TO project_uuid; \ + \ALTER TABLE project_file RENAME CONSTRAINT questionnaire_file_pk TO project_file_pk; \ + \ALTER TABLE project_file RENAME CONSTRAINT questionnaire_file_questionnaire_uuid_fk TO project_file_project_uuid_fk; \ + \ALTER TABLE project_file RENAME CONSTRAINT questionnaire_file_created_by_fk TO project_file_created_by_fk; \ + \ALTER TABLE project_file RENAME CONSTRAINT questionnaire_file_tenant_uuid_fk TO project_file_tenant_uuid_fk; \ + \ALTER TRIGGER trigger_on_after_questionnaire_file_delete ON project_file RENAME TO trigger_on_after_project_file_delete; \ + \ALTER FUNCTION create_persistent_command_from_questionnaire_file_delete() RENAME TO create_persistent_command_from_project_file_delete; \ + \ \ + \ALTER TABLE questionnaire_perm_user RENAME TO project_perm_user; \ + \ALTER TABLE project_perm_user RENAME COLUMN questionnaire_uuid TO project_uuid; \ + \ALTER TABLE project_perm_user RENAME CONSTRAINT questionnaire_perm_user_pk TO project_perm_user_pk; \ + \ALTER TABLE project_perm_user RENAME CONSTRAINT questionnaire_perm_user_questionnaire_uuid_fk TO project_perm_user_project_uuid_fk; \ + \ALTER TABLE project_perm_user RENAME CONSTRAINT questionnaire_perm_user_tenant_uuid_fk TO project_perm_user_tenant_uuid_fk; \ + \ALTER TABLE project_perm_user RENAME CONSTRAINT questionnaire_perm_user_user_uuid_fk TO project_perm_user_user_uuid_fk; \ + \ \ + \ALTER TABLE questionnaire_perm_group RENAME TO project_perm_group; \ + \ALTER TABLE project_perm_group RENAME COLUMN questionnaire_uuid TO project_uuid; \ + \ALTER TABLE project_perm_group RENAME CONSTRAINT questionnaire_perm_group_pk TO project_perm_group_pk; \ + \ALTER TABLE project_perm_group RENAME CONSTRAINT questionnaire_perm_group_questionnaire_uuid_fk TO project_perm_group_project_uuid_fk; \ + \ALTER TABLE project_perm_group RENAME CONSTRAINT questionnaire_perm_group_tenant_uuid_fk TO project_perm_group_tenant_uuid_fk; \ + \ALTER TABLE project_perm_group RENAME CONSTRAINT questionnaire_perm_group_user_group_uuid_fk TO project_perm_group_user_group_uuid_fk; \ + \ \ + \ALTER TABLE questionnaire_version RENAME TO project_version; \ + \ALTER TABLE project_version RENAME COLUMN questionnaire_uuid TO project_uuid; \ + \ALTER TABLE project_version RENAME CONSTRAINT questionnaire_version_pk TO project_version_pk; \ + \ALTER TABLE project_version RENAME CONSTRAINT questionnaire_version_event_uuid_fk TO project_version_event_uuid_fk; \ + \ALTER TABLE project_version RENAME CONSTRAINT questionnaire_version_created_by_fk TO project_version_created_by_fk; \ + \ALTER TABLE project_version RENAME CONSTRAINT questionnaire_version_questionnaire_uuid_fk TO project_version_questionnaire_uuid_fk; \ + \ALTER TABLE project_version RENAME CONSTRAINT questionnaire_version_tenant_uuid_fk TO project_version_tenant_uuid_fk; \ + \ \ + \ALTER TABLE questionnaire_comment_thread RENAME TO project_comment_thread; \ + \ALTER TABLE project_comment_thread RENAME COLUMN questionnaire_uuid TO project_uuid; \ + \ALTER TABLE project_comment_thread RENAME CONSTRAINT questionnaire_comment_thread_pk TO project_comment_thread_pk; \ + \ALTER TABLE project_comment_thread RENAME CONSTRAINT questionnaire_comment_thread_assigned_by TO project_comment_thread_assigned_by; \ + \ALTER TABLE project_comment_thread RENAME CONSTRAINT questionnaire_comment_thread_assigned_to TO project_comment_thread_assigned_to; \ + \ALTER TABLE project_comment_thread RENAME CONSTRAINT questionnaire_comment_thread_questionnaire_uuid TO project_comment_thread_questionnaire_uuid; \ + \ALTER TABLE project_comment_thread RENAME CONSTRAINT questionnaire_comment_thread_tenant_uuid TO project_comment_thread_tenant_uuid; \ + \ \ + \ALTER TABLE questionnaire_comment RENAME TO project_comment; \ + \ALTER TABLE project_comment RENAME CONSTRAINT questionnaire_comment_pk TO project_comment_pk; \ + \ALTER TABLE project_comment RENAME CONSTRAINT questionnaire_comment_comment_thread_uuid TO project_comment_comment_thread_uuid; \ + \ALTER TABLE project_comment RENAME CONSTRAINT questionnaire_comment_tenant_uuid TO project_comment_tenant_uuid; \ + \ \ + \ALTER TABLE config_questionnaire RENAME TO config_project; \ + \ALTER TABLE config_project RENAME CONSTRAINT config_questionnaire_pk TO config_project_pk; \ + \ALTER TABLE config_project RENAME CONSTRAINT config_questionnaire_tenant_uuid_fk TO config_project_tenant_uuid_fk; \ + \ \ + \ALTER TABLE document RENAME COLUMN questionnaire_uuid TO project_uuid; \ + \ALTER TABLE document RENAME COLUMN questionnaire_event_uuid TO project_event_uuid; \ + \ALTER TABLE document RENAME COLUMN questionnaire_replies_hash TO project_replies_hash; \ + \ALTER TABLE document RENAME CONSTRAINT document_questionnaire_uuid_fk TO document_project_uuid_fk; \ + \ \ + \ALTER TABLE document_template_draft_data RENAME COLUMN questionnaire_uuid TO project_uuid; \ + \ALTER TABLE document_template_draft_data RENAME CONSTRAINT document_template_draft_data_questionnaire_uuid_fk TO document_template_draft_data_project_uuid_fk; \ + \ \ + \ALTER TABLE tenant_limit_bundle RENAME COLUMN questionnaires TO projects; \ + \ \ + \UPDATE config_project SET visibility_default_value = 'PrivateProjectVisibility' WHERE visibility_default_value = 'PrivateQuestionnaire'; \ + \UPDATE config_project SET visibility_default_value = 'VisibleViewProjectVisibility' WHERE visibility_default_value = 'VisibleViewQuestionnaire'; \ + \UPDATE config_project SET visibility_default_value = 'VisibleCommentProjectVisibility' WHERE visibility_default_value = 'VisibleCommentQuestionnaire'; \ + \UPDATE config_project SET visibility_default_value = 'VisibleEditProjectVisibility' WHERE visibility_default_value = 'VisibleEditQuestionnaire'; \ + \ \ + \UPDATE config_project SET sharing_default_value = 'RestrictedProjectSharing' WHERE sharing_default_value = 'RestrictedQuestionnaire'; \ + \UPDATE config_project SET sharing_default_value = 'AnyoneWithLinkViewProjectSharing' WHERE sharing_default_value = 'AnyoneWithLinkViewQuestionnaire'; \ + \UPDATE config_project SET sharing_default_value = 'AnyoneWithLinkCommentProjectSharing' WHERE sharing_default_value = 'AnyoneWithLinkCommentQuestionnaire'; \ + \UPDATE config_project SET sharing_default_value = 'AnyoneWithLinkEditProjectSharing' WHERE sharing_default_value = 'AnyoneWithLinkEditQuestionnaire'; \ + \ \ + \UPDATE config_project SET creation = 'CustomProjectCreation' WHERE creation = 'CustomQuestionnaireCreation'; \ + \UPDATE config_project SET creation = 'TemplateProjectCreation' WHERE creation = 'TemplateQuestionnaireCreation'; \ + \UPDATE config_project SET creation = 'TemplateAndCustomProjectCreation' WHERE creation = 'TemplateAndCustomQuestionnaireCreation'; \ + \ \ + \UPDATE user_entity set permissions = replace(permissions::varchar, 'QTN_PERM', 'PRJ_PERM')::varchar[]; \ + \UPDATE user_entity set permissions = replace(permissions::varchar, 'QTN_IMPORTER_PERM', 'PRJ_IMPORTER_PERM')::varchar[]; \ + \UPDATE user_entity set permissions = replace(permissions::varchar, 'QTN_TML_PERM', 'PRJ_TML_PERM')::varchar[]; \ + \UPDATE user_entity set permissions = replace(permissions::varchar, 'QTN_ACTION_PERM', 'PRJ_ACTION_PERM')::varchar[]; \ + \UPDATE user_entity set permissions = replace(permissions::varchar, 'QTN_FILE_PERM', 'PRJ_FILE_PERM')::varchar[]; \ + \ \ + \UPDATE project SET visibility = 'PrivateProjectVisibility' WHERE visibility = 'PrivateQuestionnaire'; \ + \UPDATE project SET visibility = 'VisibleViewProjectVisibility' WHERE visibility = 'VisibleViewQuestionnaire'; \ + \UPDATE project SET visibility = 'VisibleCommentProjectVisibility' WHERE visibility = 'VisibleCommentQuestionnaire'; \ + \UPDATE project SET visibility = 'VisibleEditProjectVisibility' WHERE visibility = 'VisibleEditQuestionnaire'; \ + \ \ + \UPDATE project SET sharing = 'RestrictedProjectSharing' WHERE sharing = 'RestrictedQuestionnaire'; \ + \UPDATE project SET sharing = 'AnyoneWithLinkViewProjectSharing' WHERE sharing = 'AnyoneWithLinkViewQuestionnaire'; \ + \UPDATE project SET sharing = 'AnyoneWithLinkCommentProjectSharing' WHERE sharing = 'AnyoneWithLinkCommentQuestionnaire'; \ + \UPDATE project SET sharing = 'AnyoneWithLinkEditProjectSharing' WHERE sharing = 'AnyoneWithLinkEditQuestionnaire'; \ + \ \ + \ALTER TYPE questionnaire_event_type RENAME TO project_event_type; \ + \ \ + \UPDATE user_entity set permissions = replace(permissions::varchar, 'QTN_PERM', 'PRJ_PERM')::varchar[]; \ + \UPDATE user_entity set permissions = replace(permissions::varchar, 'QTN_IMPORTER_PERM', 'PRJ_IMPORTER_PERM')::varchar[]; \ + \UPDATE user_entity set permissions = replace(permissions::varchar, 'QTN_TML_PERM', 'PRJ_TML_PERM')::varchar[]; \ + \UPDATE user_entity set permissions = replace(permissions::varchar, 'QTN_ACTION_PERM', 'PRJ_ACTION_PERM')::varchar[]; \ + \UPDATE user_entity set permissions = replace(permissions::varchar, 'QTN_FILE_PERM', 'PRJ_FILE_PERM')::varchar[];" + let action conn = execute_ conn sql + liftIO $ withResource dbPool action + return Nothing + +renameAuditLogsAndPersistentCommands dbPool = do + let sql = + "UPDATE persistent_command SET component = 'project', function = 'createProjects' WHERE component = 'questionnaire' AND function = 'createQuestionnaires'; \ + \UPDATE persistent_command SET component = 'project_file' WHERE component = 'questionnaire_file'; \ + \ \ + \UPDATE audit SET component = 'tenant_config' WHERE component = 'app_config'; \ + \UPDATE audit SET component = 'knowledge_model_editor' WHERE component = 'branch'; \ + \UPDATE audit SET component = 'knowledge_model_migration' WHERE component = 'knowledge_model.migration'; \ + \UPDATE audit SET component = 'knowledge_model_package' WHERE component = 'package'; \ + \UPDATE audit SET component = 'knowledge_model_bundle' WHERE component = 'package_bundle'; \ + \UPDATE audit SET component = 'project' WHERE component = 'questionnaire'; \ + \UPDATE audit SET component = 'project_importer' WHERE component = 'questionnaireImporter'; \ + \UPDATE audit SET component = 'project_migration' WHERE component = 'questionnaire.migration'; \ + \UPDATE audit SET component = 'document_template_bundle' WHERE component = 'template_bundle'; \ + \UPDATE audit SET action = 'createByAdmin' WHERE action = 'create_by_admin';" + let action conn = execute_ conn sql + liftIO $ withResource dbPool action + return Nothing diff --git a/wizard-server/src/Wizard/Integration/Http/GitHub/RequestMapper.hs b/wizard-server/src/Wizard/Integration/Http/GitHub/RequestMapper.hs index 66d11fada..0afa46fec 100644 --- a/wizard-server/src/Wizard/Integration/Http/GitHub/RequestMapper.hs +++ b/wizard-server/src/Wizard/Integration/Http/GitHub/RequestMapper.hs @@ -15,7 +15,7 @@ import Wizard.Model.Config.ServerConfig import Wizard.Model.Tenant.Config.TenantConfig import Wizard.Util.Interpolation (interpolateString) -toGetIssuesRequest :: ServerConfigFeedback -> TenantConfigQuestionnaireFeedback -> HttpRequest +toGetIssuesRequest :: ServerConfigFeedback -> TenantConfigProjectFeedback -> HttpRequest toGetIssuesRequest serverConfig tenantConfig = let variables = M.fromList [("owner", tenantConfig.owner), ("repo", tenantConfig.repo)] in HttpRequest @@ -28,7 +28,7 @@ toGetIssuesRequest serverConfig tenantConfig = , multipart = Nothing } -toCreateIssueRequest :: ServerConfigFeedback -> TenantConfigQuestionnaireFeedback -> String -> U.UUID -> String -> String -> Maybe U.UUID -> HttpRequest +toCreateIssueRequest :: ServerConfigFeedback -> TenantConfigProjectFeedback -> String -> U.UUID -> String -> String -> Maybe U.UUID -> HttpRequest toCreateIssueRequest serverConfig tenantConfig pkgId questionUuid title content mCreatedBy = let variables = M.fromList [("owner", tenantConfig.owner), ("repo", tenantConfig.repo)] in HttpRequest diff --git a/wizard-server/src/Wizard/Integration/Http/GitHub/Runner.hs b/wizard-server/src/Wizard/Integration/Http/GitHub/Runner.hs index ef07494b7..a16d586b5 100644 --- a/wizard-server/src/Wizard/Integration/Http/GitHub/Runner.hs +++ b/wizard-server/src/Wizard/Integration/Http/GitHub/Runner.hs @@ -16,18 +16,18 @@ import Wizard.Service.Tenant.Config.ConfigService getIssues :: AppContextM [IssueIDTO] getIssues = do serverConfig <- asks serverConfig - tcQuestionnaire <- getCurrentTenantConfigQuestionnaire - runRequest (toGetIssuesRequest serverConfig.feedback tcQuestionnaire.feedback) toGetIssuesResponse + tcProject <- getCurrentTenantConfigProject + runRequest (toGetIssuesRequest serverConfig.feedback tcProject.feedback) toGetIssuesResponse createIssue :: String -> U.UUID -> String -> String -> AppContextM IssueIDTO createIssue pkgId questionUuid title content = do serverConfig <- asks serverConfig mCurrentUser <- asks currentUser - tcQuestionnaire <- getCurrentTenantConfigQuestionnaire + tcProject <- getCurrentTenantConfigProject runRequest ( toCreateIssueRequest serverConfig.feedback - tcQuestionnaire.feedback + tcProject.feedback pkgId questionUuid title diff --git a/wizard-server/src/Wizard/Integration/Http/Registry/RequestMapper.hs b/wizard-server/src/Wizard/Integration/Http/Registry/RequestMapper.hs index 8db5e2b9b..29113838d 100644 --- a/wizard-server/src/Wizard/Integration/Http/Registry/RequestMapper.hs +++ b/wizard-server/src/Wizard/Integration/Http/Registry/RequestMapper.hs @@ -63,7 +63,7 @@ toRetrievePackagesRequest tenantConfig iStat = mTokenHeader xUserCountHeaderName xKnowledgeModelPackageCountHeaderName - xQtnCountHeaderName + xProjectCountHeaderName xKnowledgeModelEditorCountHeaderName xDocCountHeaderName xTmlCountHeaderName @@ -74,7 +74,7 @@ toRetrievePackagesRequest tenantConfig iStat = mTokenHeader = Just $ "Bearer " ++ tenantConfig.token xUserCountHeaderName = Just . show $ iStat.userCount xKnowledgeModelPackageCountHeaderName = Just . show $ iStat.pkgCount - xQtnCountHeaderName = Just . show $ iStat.qtnCount + xProjectCountHeaderName = Just . show $ iStat.prjCount xKnowledgeModelEditorCountHeaderName = Just . show $ iStat.knowledgeModelEditorCount xDocCountHeaderName = Just . show $ iStat.docCount xTmlCountHeaderName = Just . show $ iStat.tmlCount diff --git a/wizard-server/src/Wizard/Localization/Messages/Internal.hs b/wizard-server/src/Wizard/Localization/Messages/Internal.hs index c0b52a85a..0607d6773 100644 --- a/wizard-server/src/Wizard/Localization/Messages/Internal.hs +++ b/wizard-server/src/Wizard/Localization/Messages/Internal.hs @@ -16,9 +16,9 @@ _ERROR_SERVICE_MIGRATION_METAMODEL__FAILED_TO_MIGRATE_ENTITIES entityName = "Fai _ERROR_SERVICE_MIGRATION_METAMODEL__FAILED_CONVERT_TO_NEW_METAMODEL entityName = "Failed to convert entity ('" ++ entityName ++ "') to new metamodel" --- Questionnaire -_ERROR_SERVICE_QTN__INVITATION_EMAIL_NOT_SENT = - "The questionnaire invitation email could not be sent. Please contact administrator." +-- Project +_ERROR_SERVICE_PROJECT__INVITATION_EMAIL_NOT_SENT = + "The project invitation email could not be sent. Please contact administrator." -- Token _ERROR_SERVICE_TOKEN__UNABLE_TO_GET_TOKEN = "Unable to get token" diff --git a/wizard-server/src/Wizard/Localization/Messages/Public.hs b/wizard-server/src/Wizard/Localization/Messages/Public.hs index 01ea15d5f..d341d7966 100644 --- a/wizard-server/src/Wizard/Localization/Messages/Public.hs +++ b/wizard-server/src/Wizard/Localization/Messages/Public.hs @@ -20,8 +20,8 @@ _ERROR_VALIDATION__DOC_TML_FILE_OR_ASSET_UNIQUENESS = _ERROR_VALIDATION__KM_MIGRATION_UNIQUENESS = LocaleRecord "error.validation.km_migration_uniqueness" "Migration of Knowledge Model already exists" [] -_ERROR_VALIDATION__QTN_MIGRATION_UNIQUENESS = - LocaleRecord "error.validation.qtn_migration_uniqueness" "Migration of Questionnaire already exists" [] +_ERROR_VALIDATION__PROJECT_MIGRATION_UNIQUENESS = + LocaleRecord "error.validation.project_migration_uniqueness" "Project Migration already exists" [] _ERROR_VALIDATION__USER_EMAIL_UNIQUENESS email = LocaleRecord "error.validation.user_email_uniqueness" "User (email: '%s') already exists" [email] @@ -64,12 +64,12 @@ _ERROR_VALIDATION__PKG_UNSUPPORTED_METAMODEL_VERSION pkgMetamodelVersion appPkgM _ERROR_VALIDATION__DOC_TML_UNSUPPORTED_STATE tmlId phase = LocaleRecord "error.validation.doc_tml_unsupported_state" "You can not move '%s' into the following phase: %s" [tmlId, phase] --- Questionnaire File -_ERROR_VALIDATION__QUESTIONNAIRE_FILE_SIZE_EXCEEDS_LIMIT fileSize maxFileSize = - LocaleRecord "error.validation.questionnaire_file_size_exceeds_limit" "File exceeds the maximum allowed size (file: %s, maximum: %s)" [show fileSize, show maxFileSize] +-- Project File +_ERROR_VALIDATION__PROJECT_FILE_SIZE_EXCEEDS_LIMIT fileSize maxFileSize = + LocaleRecord "error.validation.project_file_size_exceeds_limit" "File exceeds the maximum allowed size (file: %s, maximum: %s)" [show fileSize, show maxFileSize] -_ERROR_VALIDATION__QUESTIONNAIRE_FILE_QUESTION_ABSENCE_OR_WRONG_TYPE = - LocaleRecord "error.validation.questionnaire_file_question_absence_or_wrong_type" "The question either doesn't exist or is not a File Question" [] +_ERROR_VALIDATION__PROJECT_FILE_QUESTION_ABSENCE_OR_WRONG_TYPE = + LocaleRecord "error.validation.project_file_question_absence_or_wrong_type" "The question either doesn't exist or is not a File Question" [] -- -------------------------------------- -- SERVICE @@ -77,8 +77,8 @@ _ERROR_VALIDATION__QUESTIONNAIRE_FILE_QUESTION_ABSENCE_OR_WRONG_TYPE = _ERROR_SERVICE_DOCUMENT__TEMPLATE_OR_FORMAT_NOT_SET_UP = LocaleRecord "error.service.template.template_or_format_not_set_up" "DocumentTemplate or format is not set up" [] -_ERROR_SERVICE_DOCUMENT__QUESTIONNAIRE_OR_FORMAT_NOT_SET_UP = - LocaleRecord "error.service.template.questionnaire_or_format_not_set_up" "Questionnaire or format is not set up" [] +_ERROR_SERVICE_DOCUMENT__PROJECT_OR_FORMAT_NOT_SET_UP = + LocaleRecord "error.service.template.project_or_format_not_set_up" "Project or format is not set up" [] -- Auth _ERROR_SERVICE_AUTH__SERVICE_NOT_DEFINED authId = @@ -88,11 +88,11 @@ _ERROR_SERVICE_AUTH__SERVICE_NOT_DEFINED authId = _ERROR_SERVICE_KNOWLEDGE_MODEL_EDITOR__KM_MIGRATION_EXISTS = LocaleRecord "error.service.knowledge_model_editor.km_migration_exists" "You can't publish the KM editor when there is ongoing KM migration" [] -_ERROR_SERVICE_KNOWLEDGE_MODEL_EDITOR__COLLABORATION__FORCE_DISCONNECT qtnUuid = +_ERROR_SERVICE_KNOWLEDGE_MODEL_EDITOR__COLLABORATION__FORCE_DISCONNECT projectUuid = LocaleRecord "error.service.knowledge_model_editor.collaboration.force_disconnect" "Knowledge Model Editor ('%s') dramatically changed its state. Therefore, users has to be disconnected" - [qtnUuid] + [projectUuid] -- Locale Bundle _ERROR_SERVICE_LB__PULL_NON_EXISTING_LOCALE lclId = @@ -152,33 +152,33 @@ _ERROR_SERVICE_PB__PULL_NON_EXISTING_PKG pkgId = "Desired knowledge model ('%s') wasn't found in Registry" [pkgId] --- Questionnaire -_ERROR_SERVICE_QTN__QTN_CANT_BE_DELETED_BECAUSE_IT_IS_USED_IN_MIGRATION = +-- Project +_ERROR_SERVICE_PROJECT__PROJECT_CANT_BE_DELETED_BECAUSE_IT_IS_USED_IN_MIGRATION = LocaleRecord - "error.service.qtn.qtn_cant_be_deleted_because_it_is_used_in_migration" - "Questionnaire can't be deleted because it's used in some questionnaire migration" + "error.service.project.project_cant_be_deleted_because_it_is_used_in_migration" + "Project can't be deleted because it's used in some project migration" [] -_ERROR_SERVICE_QTN_COLLABORATION__FORCE_DISCONNECT qtnUuid = +_ERROR_SERVICE_PROJECT_COLLABORATION__FORCE_DISCONNECT projectUuid = LocaleRecord - "error.service.qtn.collaboration.force_disconnect" - "Questionnaire ('%s') dramatically changed its state. Therefore, users has to be disconnected" - [qtnUuid] + "error.service.project.collaboration.force_disconnect" + "Project ('%s') dramatically changed its state. Therefore, users has to be disconnected" + [projectUuid] -_ERROR_SERVICE_QTN_VERSION__NON_EXISTENT_EVENT_UUID eventUuid = +_ERROR_SERVICE_PROJECT_VERSION__NON_EXISTENT_EVENT_UUID eventUuid = LocaleRecord - "error.service.qtn.version.non_existent_event_uuid" + "error.service.project.version.non_existent_event_uuid" "You can't create version for non-existent event (eventUuid: '%s')" [eventUuid] -_ERROR_SERVICE_QTN_VERSION__VERSION_UNIQUENESS eventUuid = +_ERROR_SERVICE_PROJECT_VERSION__VERSION_UNIQUENESS eventUuid = LocaleRecord - "error.service.qtn.version.version_uniqueness" + "error.service.project.version.version_uniqueness" "There is already a version for the event (eventUuid: '%s')" [eventUuid] -_ERROR_SERVICE_QTN__UNABLE_TO_GENERATE_DOCUMENT_PREVIEW workerLog = - LocaleRecord "error.service.qtn.unable_to_generate_document_preview" "%s" [fromMaybe "no log provided" workerLog] +_ERROR_SERVICE_PROJECT__UNABLE_TO_GENERATE_DOCUMENT_PREVIEW workerLog = + LocaleRecord "error.service.project.unable_to_generate_document_preview" "%s" [fromMaybe "no log provided" workerLog] -- DocumentTemplate Bundle _ERROR_SERVICE_TB__PULL_NON_EXISTING_TML tmlId = diff --git a/wizard-server/src/Wizard/Model/Cache/ServerCache.hs b/wizard-server/src/Wizard/Model/Cache/ServerCache.hs index 874580529..e12768d8d 100644 --- a/wizard-server/src/Wizard/Model/Cache/ServerCache.hs +++ b/wizard-server/src/Wizard/Model/Cache/ServerCache.hs @@ -8,7 +8,7 @@ import WizardLib.Public.Model.User.UserToken data ServerCache = ServerCache { knowledgeModelEditorWebsocket :: C.Cache Int WebsocketRecord - , questionnaireWebsocket :: C.Cache Int WebsocketRecord + , projectWebsocket :: C.Cache Int WebsocketRecord , user :: C.Cache Int User , userToken :: C.Cache Int UserToken } diff --git a/wizard-server/src/Wizard/Model/Common/Lens.hs b/wizard-server/src/Wizard/Model/Common/Lens.hs index eef6d3cb1..6b21bc952 100644 --- a/wizard-server/src/Wizard/Model/Common/Lens.hs +++ b/wizard-server/src/Wizard/Model/Common/Lens.hs @@ -2,6 +2,6 @@ module Wizard.Model.Common.Lens where import qualified Data.UUID as U -class HasQuestionnaireUuid' entity where - getQuestionnaireUuid :: entity -> U.UUID - setQuestionnaireUuid :: entity -> U.UUID -> entity +class HasProjectUuid' entity where + getProjectUuid :: entity -> U.UUID + setProjectUuid :: entity -> U.UUID -> entity diff --git a/wizard-server/src/Wizard/Model/Config/ServerConfig.hs b/wizard-server/src/Wizard/Model/Config/ServerConfig.hs index 19d583248..2c5ecfdd4 100644 --- a/wizard-server/src/Wizard/Model/Config/ServerConfig.hs +++ b/wizard-server/src/Wizard/Model/Config/ServerConfig.hs @@ -18,7 +18,7 @@ data ServerConfig = ServerConfig , document :: ServerConfigDocument , feedback :: ServerConfigFeedback , knowledgeModelEditor :: ServerConfigKnowledgeModelEditor - , questionnaire :: ServerConfigQuestionnaire + , project :: ServerConfigProject , temporaryFile :: ServerConfigTemporaryFile , userToken :: ServerConfigUserToken , analyticalMails :: ServerConfigAnalyticalMails @@ -80,7 +80,7 @@ data ServerConfigKnowledgeModelEditor = ServerConfigKnowledgeModelEditor } deriving (Generic, Show) -data ServerConfigQuestionnaire = ServerConfigQuestionnaire +data ServerConfigProject = ServerConfigProject { clean :: ServerConfigCronWorker , squash :: ServerConfigCronWorker , assigneeNotification :: ServerConfigCronWorker @@ -102,7 +102,7 @@ data ServerConfigSignalBridge = ServerConfigSignalBridge { enabled :: Bool , updatePermsArn :: String , updateUserGroupArn :: String - , setQuestionnaireArn :: String + , setProjectArn :: String , addFileArn :: String , logOutAllArn :: String } diff --git a/wizard-server/src/Wizard/Model/Config/ServerConfigDM.hs b/wizard-server/src/Wizard/Model/Config/ServerConfigDM.hs index f98fec2a0..67b6d57e5 100644 --- a/wizard-server/src/Wizard/Model/Config/ServerConfigDM.hs +++ b/wizard-server/src/Wizard/Model/Config/ServerConfigDM.hs @@ -21,7 +21,7 @@ defaultConfig = , document = defaultDocument , feedback = defaultFeedback , knowledgeModelEditor = defaultKnowledgeModelEditor - , questionnaire = defaultQuestionnaire + , project = defaultProject , temporaryFile = defaultTemporaryFile , userToken = defaultUserToken , analyticalMails = defaultAnalyticalMails @@ -56,11 +56,11 @@ defaultRoles = , "KM_PUBLISH_PERM" , "PM_READ_PERM" , "PM_WRITE_PERM" - , "QTN_PERM" - , "QTN_ACTION_PERM" - , "QTN_FILE_PERM" - , "QTN_IMPORTER_PERM" - , "QTN_TML_PERM" + , "PRJ_PERM" + , "PRJ_ACTION_PERM" + , "PRJ_FILE_PERM" + , "PRJ_IMPORTER_PERM" + , "PJR_TML_PERM" , "DOC_TML_READ_PERM" , "CFG_PERM" , "SUBM_PERM" @@ -74,15 +74,15 @@ defaultRoles = , "KM_PUBLISH_PERM" , "PM_READ_PERM" , "PM_WRITE_PERM" - , "QTN_PERM" - , "QTN_ACTION_PERM" - , "QTN_IMPORTER_PERM" - , "QTN_TML_PERM" + , "PRJ_PERM" + , "PRJ_ACTION_PERM" + , "PRJ_IMPORTER_PERM" + , "PJR_TML_PERM" , "DOC_TML_READ_PERM" , "SUBM_PERM" , "DOC_TML_WRITE_PERM" ] - , researcher = ["PM_READ_PERM", "QTN_PERM", "DOC_TML_READ_PERM", "SUBM_PERM"] + , researcher = ["PM_READ_PERM", "PRJ_PERM", "DOC_TML_READ_PERM", "SUBM_PERM"] } defaultRegistrySyncJob :: ServerConfigCronWorker @@ -135,24 +135,24 @@ defaultKnowledgeModelEditorSquash :: ServerConfigCronWorker defaultKnowledgeModelEditorSquash = ServerConfigCronWorker {enabled = True, cron = squashKnowledgeModelEditorEventsWorker.cronDefault} -defaultQuestionnaire :: ServerConfigQuestionnaire -defaultQuestionnaire = - ServerConfigQuestionnaire - { clean = defaultQuestionnaireClean - , squash = defaultQuestionnaireSquash - , assigneeNotification = defaultQuestionnaireAssigneeNotification +defaultProject :: ServerConfigProject +defaultProject = + ServerConfigProject + { clean = defaultProjectClean + , squash = defaultProjectSquash + , assigneeNotification = defaultProjectAssigneeNotification } -defaultQuestionnaireClean :: ServerConfigCronWorker -defaultQuestionnaireClean = - ServerConfigCronWorker {enabled = True, cron = cleanQuestionnaireWorker.cronDefault} +defaultProjectClean :: ServerConfigCronWorker +defaultProjectClean = + ServerConfigCronWorker {enabled = True, cron = cleanProjectWorker.cronDefault} -defaultQuestionnaireSquash :: ServerConfigCronWorker -defaultQuestionnaireSquash = - ServerConfigCronWorker {enabled = True, cron = squashQuestionnaireEventsWorker.cronDefault} +defaultProjectSquash :: ServerConfigCronWorker +defaultProjectSquash = + ServerConfigCronWorker {enabled = True, cron = squashProjectEventsWorker.cronDefault} -defaultQuestionnaireAssigneeNotification :: ServerConfigCronWorker -defaultQuestionnaireAssigneeNotification = +defaultProjectAssigneeNotification :: ServerConfigCronWorker +defaultProjectAssigneeNotification = ServerConfigCronWorker {enabled = True, cron = assigneeNotificationWorker.cronDefault} defaultTemporaryFile :: ServerConfigTemporaryFile @@ -179,7 +179,7 @@ defaultSignalBridge = { enabled = False , updatePermsArn = "" , updateUserGroupArn = "" - , setQuestionnaireArn = "" + , setProjectArn = "" , addFileArn = "" , logOutAllArn = "" } diff --git a/wizard-server/src/Wizard/Model/Config/ServerConfigIM.hs b/wizard-server/src/Wizard/Model/Config/ServerConfigIM.hs index 389e79672..a6deb8905 100644 --- a/wizard-server/src/Wizard/Model/Config/ServerConfigIM.hs +++ b/wizard-server/src/Wizard/Model/Config/ServerConfigIM.hs @@ -18,7 +18,7 @@ instance FromEnv ServerConfig where document <- applyEnv serverConfig.document feedback <- applyEnv serverConfig.feedback knowledgeModelEditor <- applyEnv serverConfig.knowledgeModelEditor - questionnaire <- applyEnv serverConfig.questionnaire + project <- applyEnv serverConfig.project temporaryFile <- applyEnv serverConfig.temporaryFile userToken <- applyEnv serverConfig.userToken analyticalMails <- applyEnv serverConfig.analyticalMails @@ -98,16 +98,16 @@ instance FromEnv ServerConfigKnowledgeModelEditor where , \c -> applyStringEnvVariable "KNOWLEDGE_MODEL_EDITOR_SQUASH_CRON" c.squash.cron (\x -> c {squash = c.squash {cron = x}} :: ServerConfigKnowledgeModelEditor) ] -instance FromEnv ServerConfigQuestionnaire where +instance FromEnv ServerConfigProject where applyEnv serverConfig = applyEnvVariables serverConfig - [ \c -> applyEnvVariable "QUESTIONNAIRE_CLEAN_ENABLED" c.clean.enabled (\x -> c {clean = c.clean {enabled = x}} :: ServerConfigQuestionnaire) - , \c -> applyStringEnvVariable "QUESTIONNAIRE_CLEAN_CRON" c.clean.cron (\x -> c {clean = c.clean {cron = x}} :: ServerConfigQuestionnaire) - , \c -> applyEnvVariable "QUESTIONNAIRE_SQUASH_ENABLED" c.squash.enabled (\x -> c {squash = c.squash {enabled = x}} :: ServerConfigQuestionnaire) - , \c -> applyStringEnvVariable "QUESTIONNAIRE_SQUASH_CRON" c.squash.cron (\x -> c {squash = c.squash {cron = x}} :: ServerConfigQuestionnaire) - , \c -> applyEnvVariable "QUESTIONNAIRE_ASSIGNEE_NOTIFICATION_ENABLED" c.assigneeNotification.enabled (\x -> c {assigneeNotification = c.assigneeNotification {enabled = x}} :: ServerConfigQuestionnaire) - , \c -> applyStringEnvVariable "QUESTIONNAIRE_ASSIGNEE_NOTIFICATION_CRON" c.assigneeNotification.cron (\x -> c {assigneeNotification = c.assigneeNotification {cron = x}} :: ServerConfigQuestionnaire) + [ \c -> applyEnvVariable "PROJECT_CLEAN_ENABLED" c.clean.enabled (\x -> c {clean = c.clean {enabled = x}} :: ServerConfigProject) + , \c -> applyStringEnvVariable "PROJECT_CLEAN_CRON" c.clean.cron (\x -> c {clean = c.clean {cron = x}} :: ServerConfigProject) + , \c -> applyEnvVariable "PROJECT_SQUASH_ENABLED" c.squash.enabled (\x -> c {squash = c.squash {enabled = x}} :: ServerConfigProject) + , \c -> applyStringEnvVariable "PROJECT_SQUASH_CRON" c.squash.cron (\x -> c {squash = c.squash {cron = x}} :: ServerConfigProject) + , \c -> applyEnvVariable "PROJECT_ASSIGNEE_NOTIFICATION_ENABLED" c.assigneeNotification.enabled (\x -> c {assigneeNotification = c.assigneeNotification {enabled = x}} :: ServerConfigProject) + , \c -> applyStringEnvVariable "PROJECT_ASSIGNEE_NOTIFICATION_CRON" c.assigneeNotification.cron (\x -> c {assigneeNotification = c.assigneeNotification {cron = x}} :: ServerConfigProject) ] instance FromEnv ServerConfigTemporaryFile where @@ -135,7 +135,7 @@ instance FromEnv ServerConfigSignalBridge where [ \c -> applyEnvVariable "SIGNAL_BRIDGE_ENABLED" c.enabled (\x -> c {enabled = x} :: ServerConfigSignalBridge) , \c -> applyStringEnvVariable "SIGNAL_BRIDGE_UPDATE_PERMS_ARN" c.updatePermsArn (\x -> c {updatePermsArn = x} :: ServerConfigSignalBridge) , \c -> applyStringEnvVariable "SIGNAL_BRIDGE_UPDATE_USER_GROUP_ARN" c.updateUserGroupArn (\x -> c {updateUserGroupArn = x} :: ServerConfigSignalBridge) - , \c -> applyStringEnvVariable "SIGNAL_BRIDGE_SET_QUESTIONNAIRE_ARN" c.setQuestionnaireArn (\x -> c {setQuestionnaireArn = x} :: ServerConfigSignalBridge) + , \c -> applyStringEnvVariable "SIGNAL_BRIDGE_SET_PROJECT_ARN" c.setProjectArn (\x -> c {setProjectArn = x} :: ServerConfigSignalBridge) , \c -> applyStringEnvVariable "SIGNAL_BRIDGE_ADD_FILE_ARN" c.addFileArn (\x -> c {addFileArn = x} :: ServerConfigSignalBridge) , \c -> applyStringEnvVariable "SIGNAL_BRIDGE_LOG_OUT_ALL_ARN" c.logOutAllArn (\x -> c {logOutAllArn = x} :: ServerConfigSignalBridge) ] diff --git a/wizard-server/src/Wizard/Model/Config/ServerConfigJM.hs b/wizard-server/src/Wizard/Model/Config/ServerConfigJM.hs index 7fe3e9d89..37cd93c94 100644 --- a/wizard-server/src/Wizard/Model/Config/ServerConfigJM.hs +++ b/wizard-server/src/Wizard/Model/Config/ServerConfigJM.hs @@ -28,7 +28,7 @@ instance FromJSON ServerConfig where cache <- o .:? "cache" .!= defaultCache document <- o .:? "document" .!= defaultDocument feedback <- o .:? "feedback" .!= defaultFeedback - questionnaire <- o .:? "questionnaire" .!= defaultQuestionnaire + project <- o .:? "project" .!= defaultProject temporaryFile <- o .:? "temporaryFile" .!= defaultTemporaryFile userToken <- o .:? "userToken" .!= defaultUserToken analyticalMails <- o .:? "analyticalMails" .!= defaultAnalyticalMails @@ -104,12 +104,12 @@ instance FromJSON ServerConfigFeedback where return ServerConfigFeedback {..} parseJSON _ = mzero -instance FromJSON ServerConfigQuestionnaire where +instance FromJSON ServerConfigProject where parseJSON (Object o) = do - clean <- o .:? "clean" .!= defaultQuestionnaire.clean - squash <- o .:? "squash" .!= defaultQuestionnaire.squash - assigneeNotification <- o .:? "assigneeNotification" .!= defaultQuestionnaire.assigneeNotification - return ServerConfigQuestionnaire {..} + clean <- o .:? "clean" .!= defaultProject.clean + squash <- o .:? "squash" .!= defaultProject.squash + assigneeNotification <- o .:? "assigneeNotification" .!= defaultProject.assigneeNotification + return ServerConfigProject {..} parseJSON _ = mzero instance FromJSON ServerConfigTemporaryFile where @@ -130,7 +130,7 @@ instance FromJSON ServerConfigSignalBridge where enabled <- o .:? "enabled" .!= defaultSignalBridge.enabled updatePermsArn <- o .:? "updatePermsArn" .!= defaultSignalBridge.updatePermsArn updateUserGroupArn <- o .:? "updateUserGroupArn" .!= defaultSignalBridge.updateUserGroupArn - setQuestionnaireArn <- o .:? "setQuestionnaireArn" .!= defaultSignalBridge.setQuestionnaireArn + setProjectArn <- o .:? "setProjectArn" .!= defaultSignalBridge.setProjectArn addFileArn <- o .:? "addFileArn" .!= defaultSignalBridge.addFileArn logOutAllArn <- o .:? "logOutAllArn" .!= defaultSignalBridge.logOutAllArn return ServerConfigSignalBridge {..} diff --git a/wizard-server/src/Wizard/Model/Document/Document.hs b/wizard-server/src/Wizard/Model/Document/Document.hs index 80d6a7ca7..4533ae703 100644 --- a/wizard-server/src/Wizard/Model/Document/Document.hs +++ b/wizard-server/src/Wizard/Model/Document/Document.hs @@ -22,9 +22,9 @@ data Document = Document , name :: String , state :: DocumentState , durability :: DocumentDurability - , questionnaireUuid :: Maybe U.UUID - , questionnaireEventUuid :: Maybe U.UUID - , questionnaireRepliesHash :: Int + , projectUuid :: Maybe U.UUID + , projectEventUuid :: Maybe U.UUID + , projectRepliesHash :: Int , documentTemplateId :: String , formatUuid :: U.UUID , createdBy :: Maybe U.UUID diff --git a/wizard-server/src/Wizard/Model/Document/DocumentContext.hs b/wizard-server/src/Wizard/Model/Document/DocumentContext.hs index 7e8176874..a3d760967 100644 --- a/wizard-server/src/Wizard/Model/Document/DocumentContext.hs +++ b/wizard-server/src/Wizard/Model/Document/DocumentContext.hs @@ -8,9 +8,9 @@ import GHC.Generics import Shared.Common.Model.Common.SemVer2Tuple import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel import Wizard.Api.Resource.User.UserDTO -import Wizard.Model.Questionnaire.QuestionnaireFileSimple -import Wizard.Model.Questionnaire.QuestionnaireReply -import Wizard.Model.Questionnaire.QuestionnaireVersionList +import Wizard.Model.Project.File.ProjectFileSimple +import Wizard.Model.Project.ProjectReply +import Wizard.Model.Project.Version.ProjectVersionList import Wizard.Model.Registry.RegistryOrganization import Wizard.Model.Report.Report import Wizard.Model.Tenant.Config.TenantConfig @@ -19,7 +19,7 @@ import WizardLib.Public.Api.Resource.User.Group.UserGroupDetailDTO data DocumentContext = DocumentContext { config :: DocumentContextConfig , document :: DocumentContextDocument - , questionnaire :: DocumentContextQuestionnaire + , project :: DocumentContextQuestionnaire , knowledgeModel :: KnowledgeModel , report :: Report , package :: DocumentContextPackage @@ -57,9 +57,9 @@ data DocumentContextQuestionnaire = DocumentContextQuestionnaire , phaseUuid :: Maybe U.UUID , labels :: M.Map String [U.UUID] , versionUuid :: Maybe U.UUID - , versions :: [QuestionnaireVersionList] + , versions :: [ProjectVersionList] , projectTags :: [String] - , files :: [QuestionnaireFileSimple] + , files :: [ProjectFileSimple] , createdBy :: Maybe UserDTO , createdAt :: UTCTime , updatedAt :: UTCTime diff --git a/wizard-server/src/Wizard/Model/Document/DocumentContextJM.hs b/wizard-server/src/Wizard/Model/Document/DocumentContextJM.hs index e8354a6a5..f40f61bdc 100644 --- a/wizard-server/src/Wizard/Model/Document/DocumentContextJM.hs +++ b/wizard-server/src/Wizard/Model/Document/DocumentContextJM.hs @@ -6,10 +6,10 @@ import Shared.Common.Api.Resource.Common.SemVer2TupleJM () import Shared.Common.Util.Aeson import Shared.KnowledgeModel.Api.Resource.KnowledgeModel.KnowledgeModelJM () import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSimpleJM () -import Wizard.Api.Resource.Questionnaire.File.QuestionnaireFileSimpleJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireCommentThreadListJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireReplyJM () -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionListJM () +import Wizard.Api.Resource.Project.Comment.ProjectCommentThreadListJM () +import Wizard.Api.Resource.Project.File.ProjectFileSimpleJM () +import Wizard.Api.Resource.Project.ProjectReplyJM () +import Wizard.Api.Resource.Project.Version.ProjectVersionListJM () import Wizard.Api.Resource.Report.ReportJM () import Wizard.Api.Resource.Tenant.Config.TenantConfigJM () import Wizard.Api.Resource.User.UserJM () diff --git a/wizard-server/src/Wizard/Model/Document/DocumentList.hs b/wizard-server/src/Wizard/Model/Document/DocumentList.hs index a99903ed0..a059dfc24 100644 --- a/wizard-server/src/Wizard/Model/Document/DocumentList.hs +++ b/wizard-server/src/Wizard/Model/Document/DocumentList.hs @@ -12,10 +12,10 @@ data DocumentList = DocumentList { uuid :: U.UUID , name :: String , state :: DocumentState - , questionnaireUuid :: U.UUID - , questionnaireName :: String - , questionnaireEventUuid :: Maybe U.UUID - , questionnaireVersion :: Maybe String + , projectUuid :: U.UUID + , projectName :: String + , projectEventUuid :: Maybe U.UUID + , projectVersion :: Maybe String , documentTemplateId :: String , documentTemplateName :: String , documentTemplateFormats :: [DocumentTemplateFormatSimple] diff --git a/wizard-server/src/Wizard/Model/DocumentTemplate/DocumentTemplateDraftData.hs b/wizard-server/src/Wizard/Model/DocumentTemplate/DocumentTemplateDraftData.hs index 26675cf05..2b39124aa 100644 --- a/wizard-server/src/Wizard/Model/DocumentTemplate/DocumentTemplateDraftData.hs +++ b/wizard-server/src/Wizard/Model/DocumentTemplate/DocumentTemplateDraftData.hs @@ -6,7 +6,7 @@ import GHC.Generics data DocumentTemplateDraftData = DocumentTemplateDraftData { documentTemplateId :: String - , questionnaireUuid :: Maybe U.UUID + , projectUuid :: Maybe U.UUID , formatUuid :: Maybe U.UUID , tenantUuid :: U.UUID , createdAt :: UTCTime @@ -18,7 +18,7 @@ data DocumentTemplateDraftData = DocumentTemplateDraftData instance Eq DocumentTemplateDraftData where a == b = a.documentTemplateId == b.documentTemplateId - && a.questionnaireUuid == b.questionnaireUuid + && a.projectUuid == b.projectUuid && a.knowledgeModelEditorUuid == b.knowledgeModelEditorUuid && a.formatUuid == b.formatUuid && a.tenantUuid == b.tenantUuid diff --git a/wizard-server/src/Wizard/Model/DocumentTemplate/DocumentTemplateDraftDetail.hs b/wizard-server/src/Wizard/Model/DocumentTemplate/DocumentTemplateDraftDetail.hs index fdaf85d33..72fbea305 100644 --- a/wizard-server/src/Wizard/Model/DocumentTemplate/DocumentTemplateDraftDetail.hs +++ b/wizard-server/src/Wizard/Model/DocumentTemplate/DocumentTemplateDraftDetail.hs @@ -7,7 +7,7 @@ import GHC.Generics import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplate import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackagePattern import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditorSuggestion -import Wizard.Model.Questionnaire.QuestionnaireSuggestion +import Wizard.Model.Project.ProjectSuggestion data DocumentTemplateDraftDetail = DocumentTemplateDraftDetail { tId :: String @@ -19,8 +19,8 @@ data DocumentTemplateDraftDetail = DocumentTemplateDraftDetail , license :: String , allowedPackages :: [KnowledgeModelPackagePattern] , formats :: [DocumentTemplateFormat] - , questionnaireUuid :: Maybe U.UUID - , questionnaire :: Maybe QuestionnaireSuggestion + , projectUuid :: Maybe U.UUID + , project :: Maybe ProjectSuggestion , knowledgeModelEditorUuid :: Maybe U.UUID , knowledgeModelEditor :: Maybe KnowledgeModelEditorSuggestion , formatUuid :: Maybe U.UUID diff --git a/wizard-server/src/Wizard/Model/KnowledgeModel/Editor/KnowledgeModelEditorReply.hs b/wizard-server/src/Wizard/Model/KnowledgeModel/Editor/KnowledgeModelEditorReply.hs index 6f70cffec..5659cd6c4 100644 --- a/wizard-server/src/Wizard/Model/KnowledgeModel/Editor/KnowledgeModelEditorReply.hs +++ b/wizard-server/src/Wizard/Model/KnowledgeModel/Editor/KnowledgeModelEditorReply.hs @@ -4,7 +4,7 @@ import Data.Time import qualified Data.UUID as U import GHC.Generics -import Wizard.Model.Questionnaire.QuestionnaireReply +import Wizard.Model.Project.ProjectReply import WizardLib.Public.Model.User.UserSuggestion data KnowledgeModelEditorReply = KnowledgeModelEditorReply diff --git a/wizard-server/src/Wizard/Model/PersistentCommand/Project/File/ProjectFileDeleteFromS3Command.hs b/wizard-server/src/Wizard/Model/PersistentCommand/Project/File/ProjectFileDeleteFromS3Command.hs new file mode 100644 index 000000000..58b984989 --- /dev/null +++ b/wizard-server/src/Wizard/Model/PersistentCommand/Project/File/ProjectFileDeleteFromS3Command.hs @@ -0,0 +1,19 @@ +module Wizard.Model.PersistentCommand.Project.File.ProjectFileDeleteFromS3Command where + +import Data.Aeson +import qualified Data.UUID as U +import GHC.Generics + +import Shared.Common.Util.Aeson + +data ProjectFileDeleteFromS3Command = ProjectFileDeleteFromS3Command + { projectUuid :: U.UUID + , fileUuid :: U.UUID + } + deriving (Show, Eq, Generic) + +instance FromJSON ProjectFileDeleteFromS3Command where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON ProjectFileDeleteFromS3Command where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Model/PersistentCommand/Questionnaire/File/QuestionnaireFileDeleteFromS3Command.hs b/wizard-server/src/Wizard/Model/PersistentCommand/Questionnaire/File/QuestionnaireFileDeleteFromS3Command.hs deleted file mode 100644 index 2d848952b..000000000 --- a/wizard-server/src/Wizard/Model/PersistentCommand/Questionnaire/File/QuestionnaireFileDeleteFromS3Command.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Wizard.Model.PersistentCommand.Questionnaire.File.QuestionnaireFileDeleteFromS3Command where - -import Data.Aeson -import qualified Data.UUID as U -import GHC.Generics - -import Shared.Common.Util.Aeson - -data QuestionnaireFileDeleteFromS3Command = QuestionnaireFileDeleteFromS3Command - { questionnaireUuid :: U.UUID - , fileUuid :: U.UUID - } - deriving (Show, Eq, Generic) - -instance FromJSON QuestionnaireFileDeleteFromS3Command where - parseJSON = genericParseJSON jsonOptions - -instance ToJSON QuestionnaireFileDeleteFromS3Command where - toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Model/Project/Acl/ProjectAclHelpers.hs b/wizard-server/src/Wizard/Model/Project/Acl/ProjectAclHelpers.hs new file mode 100644 index 000000000..350f3c2fb --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/Acl/ProjectAclHelpers.hs @@ -0,0 +1,63 @@ +module Wizard.Model.Project.Acl.ProjectAclHelpers where + +import qualified Data.UUID as U + +import Wizard.Model.Acl.Acl +import Wizard.Model.Project.Acl.ProjectPerm + +getUserUuidsForViewerPerm :: ProjectPermC projectPerm => [projectPerm] -> [U.UUID] +getUserUuidsForViewerPerm = getUserUuidsForPerm _VIEW_PERM + +getUserUuidsForCommenterPerm :: ProjectPermC projectPerm => [projectPerm] -> [U.UUID] +getUserUuidsForCommenterPerm = getUserUuidsForPerm _COMMENT_PERM + +getUserUuidsForEditorPerm :: ProjectPermC projectPerm => [projectPerm] -> [U.UUID] +getUserUuidsForEditorPerm = getUserUuidsForPerm _EDIT_PERM + +getUserUuidsForOwnerPerm :: ProjectPermC projectPerm => [projectPerm] -> [U.UUID] +getUserUuidsForOwnerPerm = getUserUuidsForPerm _ADMIN_PERM + +getUserUuidsForPerm :: ProjectPermC projectPerm => String -> [projectPerm] -> [U.UUID] +getUserUuidsForPerm desiredPerm = foldl go [] + where + go :: ProjectPermC projectPerm => [U.UUID] -> projectPerm -> [U.UUID] + go acc projectPerm = + case projectPerm.memberType of + UserProjectPermType -> + if desiredPerm `elem` projectPerm.perms + then acc ++ [projectPerm.memberUuid] + else acc + _ -> acc + +getUserGroupUuidsForViewerPerm :: ProjectPermC projectPerm => [projectPerm] -> [U.UUID] +getUserGroupUuidsForViewerPerm = getUserGroupUuidsForPerm _VIEW_PERM + +getUserGroupUuidsForCommenterPerm :: ProjectPermC projectPerm => [projectPerm] -> [U.UUID] +getUserGroupUuidsForCommenterPerm = getUserGroupUuidsForPerm _COMMENT_PERM + +getUserGroupUuidsForEditorPerm :: ProjectPermC projectPerm => [projectPerm] -> [U.UUID] +getUserGroupUuidsForEditorPerm = getUserGroupUuidsForPerm _EDIT_PERM + +getUserGroupUuidsForOwnerPerm :: ProjectPermC projectPerm => [projectPerm] -> [U.UUID] +getUserGroupUuidsForOwnerPerm = getUserGroupUuidsForPerm _ADMIN_PERM + +getUserGroupUuidsForPerm :: ProjectPermC projectPerm => String -> [projectPerm] -> [U.UUID] +getUserGroupUuidsForPerm desiredPerm = foldl go [] + where + go :: ProjectPermC projectPerm => [U.UUID] -> projectPerm -> [U.UUID] + go acc projectPerm = + case projectPerm.memberType of + UserGroupProjectPermType -> + if desiredPerm `elem` projectPerm.perms + then acc ++ [projectPerm.memberUuid] + else acc + _ -> acc + +removeUserPermission :: ProjectPermC projectPerm => U.UUID -> [projectPerm] -> [projectPerm] +removeUserPermission userUuidToDelete = filter go + where + go :: ProjectPermC projectPerm => projectPerm -> Bool + go projectPerm = + case projectPerm.memberType of + UserProjectPermType -> projectPerm.memberUuid /= userUuidToDelete + _ -> True diff --git a/wizard-server/src/Wizard/Model/Project/Acl/ProjectPerm.hs b/wizard-server/src/Wizard/Model/Project/Acl/ProjectPerm.hs new file mode 100644 index 000000000..861f71a67 --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/Acl/ProjectPerm.hs @@ -0,0 +1,38 @@ +module Wizard.Model.Project.Acl.ProjectPerm where + +import qualified Data.UUID as U +import GHC.Generics +import GHC.Records + +import Wizard.Model.Acl.Acl + +data ProjectPermType + = UserProjectPermType + | UserGroupProjectPermType + deriving (Show, Eq, Generic, Read) + +data ProjectPerm = ProjectPerm + { projectUuid :: U.UUID + , memberType :: ProjectPermType + , memberUuid :: U.UUID + , perms :: [String] + , tenantUuid :: U.UUID + } + deriving (Generic, Eq, Show) + +class + ( HasField "perms" projectPerm [String] + , HasField "memberUuid" projectPerm U.UUID + , HasField "memberType" projectPerm ProjectPermType + ) => + ProjectPermC projectPerm + +instance ProjectPermC ProjectPerm + +ownerPermissions = [_VIEW_PERM, _COMMENT_PERM, _EDIT_PERM, _ADMIN_PERM] + +editorPermissions = [_VIEW_PERM, _COMMENT_PERM, _EDIT_PERM] + +commentatorPermissions = [_VIEW_PERM, _COMMENT_PERM] + +viewerPermissions = [_VIEW_PERM] diff --git a/wizard-server/src/Wizard/Model/Project/Action/ProjectAction.hs b/wizard-server/src/Wizard/Model/Project/Action/ProjectAction.hs new file mode 100644 index 000000000..793200703 --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/Action/ProjectAction.hs @@ -0,0 +1,28 @@ +module Wizard.Model.Project.Action.ProjectAction where + +import Data.Aeson +import Data.Time +import qualified Data.UUID as U +import GHC.Generics + +import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackagePattern + +data ProjectAction = ProjectAction + { paId :: String + , name :: String + , organizationId :: String + , actionId :: String + , version :: String + , metamodelVersion :: Int + , description :: String + , readme :: String + , license :: String + , allowedPackages :: [KnowledgeModelPackagePattern] + , url :: String + , config :: Object + , enabled :: Bool + , tenantUuid :: U.UUID + , createdAt :: UTCTime + , updatedAt :: UTCTime + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/Project/Comment/ProjectComment.hs b/wizard-server/src/Wizard/Model/Project/Comment/ProjectComment.hs new file mode 100644 index 000000000..ba7cff6e0 --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/Comment/ProjectComment.hs @@ -0,0 +1,33 @@ +module Wizard.Model.Project.Comment.ProjectComment where + +import Data.Time +import qualified Data.UUID as U +import GHC.Generics + +data ProjectCommentThread = ProjectCommentThread + { uuid :: U.UUID + , path :: String + , resolved :: Bool + , comments :: [ProjectComment] + , private :: Bool + , projectUuid :: U.UUID + , assignedTo :: Maybe U.UUID + , assignedBy :: Maybe U.UUID + , notificationRequired :: Bool + , createdBy :: Maybe U.UUID + , tenantUuid :: U.UUID + , createdAt :: UTCTime + , updatedAt :: UTCTime + } + deriving (Show, Eq, Generic) + +data ProjectComment = ProjectComment + { uuid :: U.UUID + , text :: String + , threadUuid :: U.UUID + , tenantUuid :: U.UUID + , createdBy :: Maybe U.UUID + , createdAt :: UTCTime + , updatedAt :: UTCTime + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/Project/Comment/ProjectCommentList.hs b/wizard-server/src/Wizard/Model/Project/Comment/ProjectCommentList.hs new file mode 100644 index 000000000..6f739db9d --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/Comment/ProjectCommentList.hs @@ -0,0 +1,32 @@ +module Wizard.Model.Project.Comment.ProjectCommentList where + +import Data.Time +import qualified Data.UUID as U +import GHC.Generics + +import WizardLib.Public.Model.User.UserSuggestion + +data ProjectCommentThreadList = ProjectCommentThreadList + { uuid :: U.UUID + , path :: String + , resolved :: Bool + , comments :: [ProjectCommentList] + , private :: Bool + , assignedTo :: Maybe UserSuggestion + , createdBy :: Maybe UserSuggestion + , createdAt :: UTCTime + , updatedAt :: UTCTime + } + deriving (Show, Eq, Generic) + +data ProjectCommentList = ProjectCommentList + { uuid :: U.UUID + , text :: String + , createdBy :: Maybe UserSuggestion + , createdAt :: UTCTime + , updatedAt :: UTCTime + } + deriving (Show, Eq, Generic) + +instance Ord ProjectCommentList where + compare a b = compare a.uuid b.uuid diff --git a/wizard-server/src/Wizard/Model/Project/Comment/ProjectCommentThreadAssigned.hs b/wizard-server/src/Wizard/Model/Project/Comment/ProjectCommentThreadAssigned.hs new file mode 100644 index 000000000..7166b8553 --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/Comment/ProjectCommentThreadAssigned.hs @@ -0,0 +1,20 @@ +module Wizard.Model.Project.Comment.ProjectCommentThreadAssigned where + +import Data.Time +import qualified Data.UUID as U +import GHC.Generics + +import WizardLib.Public.Model.User.UserSuggestion + +data ProjectCommentThreadAssigned = ProjectCommentThreadAssigned + { projectUuid :: U.UUID + , projectName :: String + , commentThreadUuid :: U.UUID + , path :: String + , resolved :: Bool + , private :: Bool + , text :: String + , createdBy :: Maybe UserSuggestion + , updatedAt :: UTCTime + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/Project/Comment/ProjectCommentThreadNotification.hs b/wizard-server/src/Wizard/Model/Project/Comment/ProjectCommentThreadNotification.hs new file mode 100644 index 000000000..248b09696 --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/Comment/ProjectCommentThreadNotification.hs @@ -0,0 +1,30 @@ +module Wizard.Model.Project.Comment.ProjectCommentThreadNotification where + +import qualified Data.UUID as U +import GHC.Generics + +import WizardLib.Public.Model.User.UserSimple + +data ProjectCommentThreadNotification = ProjectCommentThreadNotification + { projectUuid :: U.UUID + , projectName :: String + , tenantUuid :: U.UUID + , commentThreadUuid :: U.UUID + , path :: String + , resolved :: Bool + , private :: Bool + , assignedTo :: UserSimple + , assignedBy :: Maybe UserSimple + , text :: String + , clientUrl :: String + , appTitle :: Maybe String + , logoUrl :: Maybe String + , primaryColor :: Maybe String + , illustrationsColor :: Maybe String + , supportEmail :: Maybe String + , mailConfigUuid :: Maybe U.UUID + } + deriving (Show, Eq, Generic) + +instance Ord ProjectCommentThreadNotification where + compare a b = compare a.projectUuid b.projectUuid diff --git a/wizard-server/src/Wizard/Model/Project/Detail/ProjectDetail.hs b/wizard-server/src/Wizard/Model/Project/Detail/ProjectDetail.hs new file mode 100644 index 000000000..3ed0254dc --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/Detail/ProjectDetail.hs @@ -0,0 +1,23 @@ +module Wizard.Model.Project.Detail.ProjectDetail where + +import qualified Data.UUID as U +import GHC.Generics + +import Wizard.Api.Resource.Project.Acl.ProjectPermDTO +import Wizard.Model.Project.Project + +data ProjectDetail = ProjectDetail + { uuid :: U.UUID + , name :: String + , visibility :: ProjectVisibility + , sharing :: ProjectSharing + , knowledgeModelPackageId :: String + , selectedQuestionTagUuids :: [U.UUID] + , isTemplate :: Bool + , migrationUuid :: Maybe U.UUID + , permissions :: [ProjectPermDTO] + , projectActionsAvailable :: Int + , projectImportersAvailable :: Int + , fileCount :: Int + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/Project/Detail/ProjectDetailPreview.hs b/wizard-server/src/Wizard/Model/Project/Detail/ProjectDetailPreview.hs new file mode 100644 index 000000000..ea5e8d3a3 --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/Detail/ProjectDetailPreview.hs @@ -0,0 +1,23 @@ +module Wizard.Model.Project.Detail.ProjectDetailPreview where + +import qualified Data.UUID as U +import GHC.Generics + +import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplateFormatSimple +import Wizard.Api.Resource.Project.Acl.ProjectPermDTO +import Wizard.Model.Project.Project + +data ProjectDetailPreview = ProjectDetailPreview + { uuid :: U.UUID + , name :: String + , visibility :: ProjectVisibility + , sharing :: ProjectSharing + , knowledgeModelPackageId :: String + , isTemplate :: Bool + , migrationUuid :: Maybe U.UUID + , permissions :: [ProjectPermDTO] + , documentTemplateId :: Maybe String + , format :: Maybe DocumentTemplateFormatSimple + , fileCount :: Int + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/Project/Detail/ProjectDetailQuestionnaire.hs b/wizard-server/src/Wizard/Model/Project/Detail/ProjectDetailQuestionnaire.hs new file mode 100644 index 000000000..10751c3cc --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/Detail/ProjectDetailQuestionnaire.hs @@ -0,0 +1,24 @@ +module Wizard.Model.Project.Detail.ProjectDetailQuestionnaire where + +import qualified Data.UUID as U +import GHC.Generics + +import Wizard.Api.Resource.Project.Acl.ProjectPermDTO +import Wizard.Model.Project.File.ProjectFileSimple +import Wizard.Model.Project.Project + +data ProjectDetailQuestionnaire = ProjectDetailQuestionnaire + { uuid :: U.UUID + , name :: String + , visibility :: ProjectVisibility + , sharing :: ProjectSharing + , knowledgeModelPackageId :: String + , selectedQuestionTagUuids :: [U.UUID] + , isTemplate :: Bool + , migrationUuid :: Maybe U.UUID + , permissions :: [ProjectPermDTO] + , files :: [ProjectFileSimple] + , projectActionsAvailable :: Int + , projectImportersAvailable :: Int + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/Project/Detail/ProjectDetailSettings.hs b/wizard-server/src/Wizard/Model/Project/Detail/ProjectDetailSettings.hs new file mode 100644 index 000000000..8286ae18a --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/Detail/ProjectDetailSettings.hs @@ -0,0 +1,34 @@ +module Wizard.Model.Project.Detail.ProjectDetailSettings where + +import qualified Data.UUID as U +import GHC.Generics + +import Shared.DocumentTemplate.Api.Resource.DocumentTemplate.DocumentTemplateDTO +import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplate +import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel +import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSimpleDTO +import Wizard.Api.Resource.Project.Acl.ProjectPermDTO +import Wizard.Model.DocumentTemplate.DocumentTemplateState +import Wizard.Model.Project.Project + +data ProjectDetailSettings = ProjectDetailSettings + { uuid :: U.UUID + , name :: String + , description :: Maybe String + , visibility :: ProjectVisibility + , sharing :: ProjectSharing + , isTemplate :: Bool + , migrationUuid :: Maybe U.UUID + , permissions :: [ProjectPermDTO] + , projectTags :: [String] + , knowledgeModelPackageId :: String + , knowledgeModelPackage :: KnowledgeModelPackageSimpleDTO + , knowledgeModelTags :: [Tag] + , documentTemplate :: Maybe DocumentTemplateDTO + , documentTemplateState :: Maybe DocumentTemplateState + , documentTemplatePhase :: Maybe DocumentTemplatePhase + , formatUuid :: Maybe U.UUID + , selectedQuestionTagUuids :: [U.UUID] + , fileCount :: Int + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/Project/Event/ProjectEvent.hs b/wizard-server/src/Wizard/Model/Project/Event/ProjectEvent.hs new file mode 100644 index 000000000..446797d92 --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/Event/ProjectEvent.hs @@ -0,0 +1,90 @@ +module Wizard.Model.Project.Event.ProjectEvent where + +import Data.Time +import qualified Data.UUID as U +import GHC.Generics + +import Wizard.Model.Project.ProjectReply + +data ProjectEvent + = SetReplyEvent' SetReplyEvent + | ClearReplyEvent' ClearReplyEvent + | SetPhaseEvent' SetPhaseEvent + | SetLabelsEvent' SetLabelsEvent + deriving (Show, Eq, Generic) + +data SetReplyEvent = SetReplyEvent + { uuid :: U.UUID + , path :: String + , value :: ReplyValue + , projectUuid :: U.UUID + , tenantUuid :: U.UUID + , createdBy :: Maybe U.UUID + , createdAt :: UTCTime + } + deriving (Show, Generic) + +instance Eq SetReplyEvent where + a == b = + a.uuid == b.uuid + && a.path == b.path + && a.value == b.value + && a.projectUuid == b.projectUuid + && a.tenantUuid == b.tenantUuid + && a.createdBy == b.createdBy + +data ClearReplyEvent = ClearReplyEvent + { uuid :: U.UUID + , path :: String + , projectUuid :: U.UUID + , tenantUuid :: U.UUID + , createdBy :: Maybe U.UUID + , createdAt :: UTCTime + } + deriving (Show, Generic) + +instance Eq ClearReplyEvent where + a == b = + a.uuid == b.uuid + && a.path == b.path + && a.projectUuid == b.projectUuid + && a.tenantUuid == b.tenantUuid + && a.createdBy == b.createdBy + +data SetPhaseEvent = SetPhaseEvent + { uuid :: U.UUID + , phaseUuid :: Maybe U.UUID + , projectUuid :: U.UUID + , tenantUuid :: U.UUID + , createdBy :: Maybe U.UUID + , createdAt :: UTCTime + } + deriving (Show, Generic) + +instance Eq SetPhaseEvent where + a == b = + a.uuid == b.uuid + && a.phaseUuid == b.phaseUuid + && a.projectUuid == b.projectUuid + && a.tenantUuid == b.tenantUuid + && a.createdBy == b.createdBy + +data SetLabelsEvent = SetLabelsEvent + { uuid :: U.UUID + , path :: String + , value :: [U.UUID] + , projectUuid :: U.UUID + , tenantUuid :: U.UUID + , createdBy :: Maybe U.UUID + , createdAt :: UTCTime + } + deriving (Show, Generic) + +instance Eq SetLabelsEvent where + a == b = + a.uuid == b.uuid + && a.path == b.path + && a.value == b.value + && a.projectUuid == b.projectUuid + && a.tenantUuid == b.tenantUuid + && a.createdBy == b.createdBy diff --git a/wizard-server/src/Wizard/Model/Project/Event/ProjectEventLenses.hs b/wizard-server/src/Wizard/Model/Project/Event/ProjectEventLenses.hs new file mode 100644 index 000000000..b911cf767 --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/Event/ProjectEventLenses.hs @@ -0,0 +1,45 @@ +module Wizard.Model.Project.Event.ProjectEventLenses where + +import Shared.Common.Model.Common.Lens +import Wizard.Model.Common.Lens +import Wizard.Model.Project.Event.ProjectEvent + +instance HasUuid' ProjectEvent where + getUuid (SetReplyEvent' entity) = entity.uuid + getUuid (ClearReplyEvent' entity) = entity.uuid + getUuid (SetPhaseEvent' entity) = entity.uuid + getUuid (SetLabelsEvent' entity) = entity.uuid + setUuid (SetReplyEvent' entity) newValue = SetReplyEvent' $ entity {uuid = newValue} + setUuid (ClearReplyEvent' entity) newValue = ClearReplyEvent' $ entity {uuid = newValue} + setUuid (SetPhaseEvent' entity) newValue = SetPhaseEvent' $ entity {uuid = newValue} + setUuid (SetLabelsEvent' entity) newValue = SetLabelsEvent' $ entity {uuid = newValue} + +instance HasProjectUuid' ProjectEvent where + getProjectUuid (SetReplyEvent' entity) = entity.projectUuid + getProjectUuid (ClearReplyEvent' entity) = entity.projectUuid + getProjectUuid (SetPhaseEvent' entity) = entity.projectUuid + getProjectUuid (SetLabelsEvent' entity) = entity.projectUuid + setProjectUuid (SetReplyEvent' entity) newValue = SetReplyEvent' $ entity {projectUuid = newValue} + setProjectUuid (ClearReplyEvent' entity) newValue = ClearReplyEvent' $ entity {projectUuid = newValue} + setProjectUuid (SetPhaseEvent' entity) newValue = SetPhaseEvent' $ entity {projectUuid = newValue} + setProjectUuid (SetLabelsEvent' entity) newValue = SetLabelsEvent' $ entity {projectUuid = newValue} + +instance HasCreatedAt' ProjectEvent where + getCreatedAt (SetReplyEvent' entity) = entity.createdAt + getCreatedAt (ClearReplyEvent' entity) = entity.createdAt + getCreatedAt (SetPhaseEvent' entity) = entity.createdAt + getCreatedAt (SetLabelsEvent' entity) = entity.createdAt + setCreatedAt (SetReplyEvent' entity) newValue = SetReplyEvent' $ entity {createdAt = newValue} + setCreatedAt (ClearReplyEvent' entity) newValue = ClearReplyEvent' $ entity {createdAt = newValue} + setCreatedAt (SetPhaseEvent' entity) newValue = SetPhaseEvent' $ entity {createdAt = newValue} + setCreatedAt (SetLabelsEvent' entity) newValue = SetLabelsEvent' $ entity {createdAt = newValue} + +instance HasCreatedBy' ProjectEvent where + getCreatedBy (SetReplyEvent' entity) = entity.createdBy + getCreatedBy (ClearReplyEvent' entity) = entity.createdBy + getCreatedBy (SetPhaseEvent' entity) = entity.createdBy + getCreatedBy (SetLabelsEvent' entity) = entity.createdBy + setCreatedBy (SetReplyEvent' entity) newValue = SetReplyEvent' $ entity {createdBy = newValue} + setCreatedBy (ClearReplyEvent' entity) newValue = ClearReplyEvent' $ entity {createdBy = newValue} + setCreatedBy (SetPhaseEvent' entity) newValue = SetPhaseEvent' $ entity {createdBy = newValue} + setCreatedBy (SetLabelsEvent' entity) newValue = SetLabelsEvent' $ entity {createdBy = newValue} diff --git a/wizard-server/src/Wizard/Model/Project/Event/ProjectEventList.hs b/wizard-server/src/Wizard/Model/Project/Event/ProjectEventList.hs new file mode 100644 index 000000000..1b7cedb8e --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/Event/ProjectEventList.hs @@ -0,0 +1,75 @@ +module Wizard.Model.Project.Event.ProjectEventList where + +import Data.Time +import qualified Data.UUID as U +import GHC.Generics + +import Wizard.Model.Project.ProjectReply +import WizardLib.Public.Model.User.UserSuggestion + +data ProjectEventList + = SetReplyEventList' SetReplyEventList + | ClearReplyEventList' ClearReplyEventList + | SetPhaseEventList' SetPhaseEventList + | SetLabelsEventList' SetLabelsEventList + deriving (Show, Eq, Generic) + +data SetReplyEventList = SetReplyEventList + { uuid :: U.UUID + , path :: String + , value :: ReplyValue + , createdBy :: Maybe UserSuggestion + , createdAt :: UTCTime + } + deriving (Show, Generic) + +instance Eq SetReplyEventList where + a == b = + a.uuid == b.uuid + && a.path == b.path + && a.value == b.value + && a.createdBy == b.createdBy + +data ClearReplyEventList = ClearReplyEventList + { uuid :: U.UUID + , path :: String + , createdBy :: Maybe UserSuggestion + , createdAt :: UTCTime + } + deriving (Show, Generic) + +instance Eq ClearReplyEventList where + a == b = + a.uuid == b.uuid + && a.path == b.path + && a.createdBy == b.createdBy + +data SetPhaseEventList = SetPhaseEventList + { uuid :: U.UUID + , phaseUuid :: Maybe U.UUID + , createdBy :: Maybe UserSuggestion + , createdAt :: UTCTime + } + deriving (Show, Generic) + +instance Eq SetPhaseEventList where + a == b = + a.uuid == b.uuid + && a.phaseUuid == b.phaseUuid + && a.createdBy == b.createdBy + +data SetLabelsEventList = SetLabelsEventList + { uuid :: U.UUID + , path :: String + , value :: [U.UUID] + , createdBy :: Maybe UserSuggestion + , createdAt :: UTCTime + } + deriving (Show, Generic) + +instance Eq SetLabelsEventList where + a == b = + a.uuid == b.uuid + && a.path == b.path + && a.value == b.value + && a.createdBy == b.createdBy diff --git a/wizard-server/src/Wizard/Model/Project/Event/ProjectEventListLenses.hs b/wizard-server/src/Wizard/Model/Project/Event/ProjectEventListLenses.hs new file mode 100644 index 000000000..671bfac25 --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/Event/ProjectEventListLenses.hs @@ -0,0 +1,24 @@ +module Wizard.Model.Project.Event.ProjectEventListLenses where + +import Shared.Common.Model.Common.Lens +import Wizard.Model.Project.Event.ProjectEventList + +instance HasUuid' ProjectEventList where + getUuid (SetReplyEventList' entity) = entity.uuid + getUuid (ClearReplyEventList' entity) = entity.uuid + getUuid (SetPhaseEventList' entity) = entity.uuid + getUuid (SetLabelsEventList' entity) = entity.uuid + setUuid (SetReplyEventList' entity) newValue = SetReplyEventList' $ entity {uuid = newValue} + setUuid (ClearReplyEventList' entity) newValue = ClearReplyEventList' $ entity {uuid = newValue} + setUuid (SetPhaseEventList' entity) newValue = SetPhaseEventList' $ entity {uuid = newValue} + setUuid (SetLabelsEventList' entity) newValue = SetLabelsEventList' $ entity {uuid = newValue} + +instance HasCreatedAt' ProjectEventList where + getCreatedAt (SetReplyEventList' entity) = entity.createdAt + getCreatedAt (ClearReplyEventList' entity) = entity.createdAt + getCreatedAt (SetPhaseEventList' entity) = entity.createdAt + getCreatedAt (SetLabelsEventList' entity) = entity.createdAt + setCreatedAt (SetReplyEventList' entity) newValue = SetReplyEventList' $ entity {createdAt = newValue} + setCreatedAt (ClearReplyEventList' entity) newValue = ClearReplyEventList' $ entity {createdAt = newValue} + setCreatedAt (SetPhaseEventList' entity) newValue = SetPhaseEventList' $ entity {createdAt = newValue} + setCreatedAt (SetLabelsEventList' entity) newValue = SetLabelsEventList' $ entity {createdAt = newValue} diff --git a/wizard-server/src/Wizard/Model/Project/File/ProjectFile.hs b/wizard-server/src/Wizard/Model/Project/File/ProjectFile.hs new file mode 100644 index 000000000..7de1a595e --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/File/ProjectFile.hs @@ -0,0 +1,18 @@ +module Wizard.Model.Project.File.ProjectFile where + +import Data.Time +import qualified Data.UUID as U +import GHC.Generics +import GHC.Int + +data ProjectFile = ProjectFile + { uuid :: U.UUID + , fileName :: String + , contentType :: String + , fileSize :: Int64 + , projectUuid :: U.UUID + , createdBy :: Maybe U.UUID + , tenantUuid :: U.UUID + , createdAt :: UTCTime + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/Project/File/ProjectFileList.hs b/wizard-server/src/Wizard/Model/Project/File/ProjectFileList.hs new file mode 100644 index 000000000..d08622273 --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/File/ProjectFileList.hs @@ -0,0 +1,20 @@ +module Wizard.Model.Project.File.ProjectFileList where + +import Data.Time +import qualified Data.UUID as U +import GHC.Generics +import GHC.Int + +import Wizard.Model.Project.ProjectSimple +import WizardLib.Public.Model.User.UserSuggestion + +data ProjectFileList = ProjectFileList + { uuid :: U.UUID + , fileName :: String + , contentType :: String + , fileSize :: Int64 + , project :: ProjectSimple + , createdBy :: Maybe UserSuggestion + , createdAt :: UTCTime + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/Project/File/ProjectFileSimple.hs b/wizard-server/src/Wizard/Model/Project/File/ProjectFileSimple.hs new file mode 100644 index 000000000..1e7495977 --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/File/ProjectFileSimple.hs @@ -0,0 +1,13 @@ +module Wizard.Model.Project.File.ProjectFileSimple where + +import qualified Data.UUID as U +import GHC.Generics +import GHC.Int + +data ProjectFileSimple = ProjectFileSimple + { uuid :: U.UUID + , fileName :: String + , contentType :: String + , fileSize :: Int64 + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/Project/Importer/ProjectImporter.hs b/wizard-server/src/Wizard/Model/Project/Importer/ProjectImporter.hs new file mode 100644 index 000000000..8366a9e40 --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/Importer/ProjectImporter.hs @@ -0,0 +1,26 @@ +module Wizard.Model.Project.Importer.ProjectImporter where + +import Data.Time +import qualified Data.UUID as U +import GHC.Generics + +import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackagePattern + +data ProjectImporter = ProjectImporter + { piId :: String + , name :: String + , organizationId :: String + , importerId :: String + , version :: String + , metamodelVersion :: Int + , description :: String + , readme :: String + , license :: String + , allowedPackages :: [KnowledgeModelPackagePattern] + , url :: String + , enabled :: Bool + , tenantUuid :: U.UUID + , createdAt :: UTCTime + , updatedAt :: UTCTime + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/Project/Migration/ProjectMigration.hs b/wizard-server/src/Wizard/Model/Project/Migration/ProjectMigration.hs new file mode 100644 index 000000000..4213c2363 --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/Migration/ProjectMigration.hs @@ -0,0 +1,12 @@ +module Wizard.Model.Project.Migration.ProjectMigration where + +import qualified Data.UUID as U +import GHC.Generics + +data ProjectMigration = ProjectMigration + { oldProjectUuid :: U.UUID + , newProjectUuid :: U.UUID + , resolvedQuestionUuids :: [U.UUID] + , tenantUuid :: U.UUID + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/Project/Project.hs b/wizard-server/src/Wizard/Model/Project/Project.hs new file mode 100644 index 000000000..dc7a4d602 --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/Project.hs @@ -0,0 +1,60 @@ +module Wizard.Model.Project.Project where + +import Data.Time +import qualified Data.UUID as U +import GHC.Generics + +import Wizard.Model.Project.Acl.ProjectPerm + +data ProjectVisibility + = PrivateProjectVisibility + | VisibleViewProjectVisibility + | VisibleCommentProjectVisibility + | VisibleEditProjectVisibility + deriving (Show, Eq, Generic, Read) + +data ProjectSharing + = RestrictedProjectSharing + | AnyoneWithLinkViewProjectSharing + | AnyoneWithLinkCommentProjectSharing + | AnyoneWithLinkEditProjectSharing + deriving (Show, Eq, Generic, Read) + +data Project = Project + { uuid :: U.UUID + , name :: String + , description :: Maybe String + , visibility :: ProjectVisibility + , sharing :: ProjectSharing + , knowledgeModelPackageId :: String + , selectedQuestionTagUuids :: [U.UUID] + , projectTags :: [String] + , documentTemplateId :: Maybe String + , formatUuid :: Maybe U.UUID + , creatorUuid :: Maybe U.UUID + , permissions :: [ProjectPerm] + , isTemplate :: Bool + , squashed :: Bool + , tenantUuid :: U.UUID + , createdAt :: UTCTime + , updatedAt :: UTCTime + } + deriving (Generic, Show) + +instance Eq Project where + a == b = + a.uuid == b.uuid + && a.name == b.name + && a.description == b.description + && a.visibility == b.visibility + && a.sharing == b.sharing + && a.knowledgeModelPackageId == b.knowledgeModelPackageId + && a.selectedQuestionTagUuids == b.selectedQuestionTagUuids + && a.projectTags == b.projectTags + && a.documentTemplateId == b.documentTemplateId + && a.formatUuid == b.formatUuid + && a.creatorUuid == b.creatorUuid + && a.permissions == b.permissions + && a.isTemplate == b.isTemplate + && a.squashed == b.squashed + && a.tenantUuid == b.tenantUuid diff --git a/wizard-server/src/Wizard/Model/Project/ProjectContent.hs b/wizard-server/src/Wizard/Model/Project/ProjectContent.hs new file mode 100644 index 000000000..57144f331 --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/ProjectContent.hs @@ -0,0 +1,14 @@ +module Wizard.Model.Project.ProjectContent where + +import qualified Data.Map.Strict as M +import qualified Data.UUID as U +import GHC.Generics + +import Wizard.Model.Project.ProjectReply + +data ProjectContent = ProjectContent + { phaseUuid :: Maybe U.UUID + , replies :: M.Map String Reply + , labels :: M.Map String [U.UUID] + } + deriving (Generic, Eq, Show) diff --git a/wizard-server/src/Wizard/Model/Project/ProjectContentDM.hs b/wizard-server/src/Wizard/Model/Project/ProjectContentDM.hs new file mode 100644 index 000000000..ff6986ca4 --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/ProjectContentDM.hs @@ -0,0 +1,13 @@ +module Wizard.Model.Project.ProjectContentDM where + +import qualified Data.Map.Strict as M + +import Wizard.Model.Project.ProjectContent + +defaultProjectContent :: ProjectContent +defaultProjectContent = + ProjectContent + { phaseUuid = Nothing + , replies = M.empty + , labels = M.empty + } diff --git a/wizard-server/src/Wizard/Model/Project/ProjectList.hs b/wizard-server/src/Wizard/Model/Project/ProjectList.hs new file mode 100644 index 000000000..ac851228a --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/ProjectList.hs @@ -0,0 +1,37 @@ +module Wizard.Model.Project.ProjectList where + +import Data.Time +import qualified Data.UUID as U +import GHC.Generics + +import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackageSimple +import Wizard.Api.Resource.Project.Acl.ProjectPermDTO +import Wizard.Model.Project.Project +import Wizard.Model.Project.ProjectState + +data ProjectList = ProjectList + { uuid :: U.UUID + , name :: String + , description :: Maybe String + , visibility :: ProjectVisibility + , sharing :: ProjectSharing + , state :: ProjectState + , knowledgeModelPackage :: KnowledgeModelPackageSimple + , permissions :: [ProjectPermDTO] + , isTemplate :: Bool + , createdAt :: UTCTime + , updatedAt :: UTCTime + } + deriving (Generic, Show) + +instance Eq ProjectList where + a == b = + a.uuid == b.uuid + && a.name == b.name + && a.description == b.description + && a.visibility == b.visibility + && a.sharing == b.sharing + && a.state == b.state + && a.knowledgeModelPackage == b.knowledgeModelPackage + && a.permissions == b.permissions + && a.isTemplate == b.isTemplate diff --git a/wizard-server/src/Wizard/Model/Project/ProjectReply.hs b/wizard-server/src/Wizard/Model/Project/ProjectReply.hs new file mode 100644 index 000000000..80077e317 --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/ProjectReply.hs @@ -0,0 +1,63 @@ +module Wizard.Model.Project.ProjectReply where + +import Data.Aeson +import Data.Hashable +import Data.Time +import qualified Data.UUID as U +import GHC.Generics + +import Wizard.Util.Hashable () +import WizardLib.Public.Model.User.UserSuggestion + +type ReplyTuple = (String, Reply) + +data Reply = Reply + { value :: ReplyValue + , createdBy :: Maybe UserSuggestion + , createdAt :: UTCTime + } + deriving (Show, Eq, Generic) + +instance Hashable Reply + +data ReplyValue + = StringReply + { sValue :: String + } + | AnswerReply + { aValue :: U.UUID + } + | MultiChoiceReply + { mcValue :: [U.UUID] + } + | ItemListReply + { ilValue :: [U.UUID] + } + | IntegrationReply + { iValue :: IntegrationReplyType + } + | ItemSelectReply + { isValue :: U.UUID + } + | FileReply + { fValue :: U.UUID + } + deriving (Show, Eq, Generic) + +instance Hashable ReplyValue + +data IntegrationReplyType + = PlainType + { value :: String + } + | IntegrationLegacyType + { intId :: Maybe String + , value :: String + } + | IntegrationType + { value :: String + , raw :: Value + } + deriving (Show, Eq, Generic) + +instance Hashable IntegrationReplyType diff --git a/wizard-server/src/Wizard/Model/Project/ProjectSimple.hs b/wizard-server/src/Wizard/Model/Project/ProjectSimple.hs new file mode 100644 index 000000000..20eabbd04 --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/ProjectSimple.hs @@ -0,0 +1,10 @@ +module Wizard.Model.Project.ProjectSimple where + +import qualified Data.UUID as U +import GHC.Generics + +data ProjectSimple = ProjectSimple + { uuid :: U.UUID + , name :: String + } + deriving (Generic, Eq, Show) diff --git a/wizard-server/src/Wizard/Model/Project/ProjectSimpleWithPerm.hs b/wizard-server/src/Wizard/Model/Project/ProjectSimpleWithPerm.hs new file mode 100644 index 000000000..29ee0c6a3 --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/ProjectSimpleWithPerm.hs @@ -0,0 +1,16 @@ +module Wizard.Model.Project.ProjectSimpleWithPerm where + +import qualified Data.UUID as U +import GHC.Generics + +import Wizard.Model.Project.Acl.ProjectPerm +import Wizard.Model.Project.Project + +data ProjectSimpleWithPerm = ProjectSimpleWithPerm + { uuid :: U.UUID + , visibility :: ProjectVisibility + , sharing :: ProjectSharing + , tenantUuid :: U.UUID + , permissions :: [ProjectPerm] + } + deriving (Generic, Eq, Show) diff --git a/wizard-server/src/Wizard/Model/Project/ProjectState.hs b/wizard-server/src/Wizard/Model/Project/ProjectState.hs new file mode 100644 index 000000000..fc8bd36d5 --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/ProjectState.hs @@ -0,0 +1,9 @@ +module Wizard.Model.Project.ProjectState where + +import GHC.Generics + +data ProjectState + = DefaultProjectState + | MigratingProjectState + | OutdatedProjectState + deriving (Show, Eq, Generic, Read) diff --git a/wizard-server/src/Wizard/Model/Project/ProjectSuggestion.hs b/wizard-server/src/Wizard/Model/Project/ProjectSuggestion.hs new file mode 100644 index 000000000..b328a822e --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/ProjectSuggestion.hs @@ -0,0 +1,11 @@ +module Wizard.Model.Project.ProjectSuggestion where + +import qualified Data.UUID as U +import GHC.Generics + +data ProjectSuggestion = ProjectSuggestion + { uuid :: U.UUID + , name :: String + , description :: Maybe String + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/Project/ProjectUtil.hs b/wizard-server/src/Wizard/Model/Project/ProjectUtil.hs new file mode 100644 index 000000000..374a0d43b --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/ProjectUtil.hs @@ -0,0 +1,16 @@ +module Wizard.Model.Project.ProjectUtil where + +import qualified Data.List as L +import Data.Maybe (fromJust) +import qualified Data.UUID as U + +import Shared.Common.Util.String (splitOn) + +createReplyKey :: [U.UUID] -> String +createReplyKey = L.intercalate "." . fmap U.toString + +readReplyKey :: String -> [U.UUID] +readReplyKey = fmap (fromJust . U.fromString) . splitOn "." + +replyKeyContains :: String -> U.UUID -> Bool +replyKeyContains replyKey uuid = uuid `elem` readReplyKey replyKey diff --git a/wizard-server/src/Wizard/Model/Project/Version/ProjectVersion.hs b/wizard-server/src/Wizard/Model/Project/Version/ProjectVersion.hs new file mode 100644 index 000000000..ba34fd0aa --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/Version/ProjectVersion.hs @@ -0,0 +1,32 @@ +module Wizard.Model.Project.Version.ProjectVersion where + +import Data.Aeson () +import Data.Hashable +import Data.Time +import qualified Data.UUID as U +import GHC.Generics + +import Wizard.Util.Hashable () + +data ProjectVersion = ProjectVersion + { uuid :: U.UUID + , name :: String + , description :: Maybe String + , eventUuid :: U.UUID + , projectUuid :: U.UUID + , tenantUuid :: U.UUID + , createdBy :: Maybe U.UUID + , createdAt :: UTCTime + , updatedAt :: UTCTime + } + deriving (Show, Generic) + +instance Eq ProjectVersion where + a == b = + a.uuid == b.uuid + && a.name == b.name + && a.description == b.description + && a.eventUuid == b.eventUuid + && a.createdBy == b.createdBy + +instance Hashable ProjectVersion diff --git a/wizard-server/src/Wizard/Model/Project/Version/ProjectVersionList.hs b/wizard-server/src/Wizard/Model/Project/Version/ProjectVersionList.hs new file mode 100644 index 000000000..6f76481d8 --- /dev/null +++ b/wizard-server/src/Wizard/Model/Project/Version/ProjectVersionList.hs @@ -0,0 +1,26 @@ +module Wizard.Model.Project.Version.ProjectVersionList where + +import Data.Time +import qualified Data.UUID as U +import GHC.Generics + +import WizardLib.Public.Model.User.UserSuggestion + +data ProjectVersionList = ProjectVersionList + { uuid :: U.UUID + , name :: String + , description :: Maybe String + , eventUuid :: U.UUID + , createdBy :: Maybe UserSuggestion + , createdAt :: UTCTime + , updatedAt :: UTCTime + } + deriving (Show, Generic) + +instance Eq ProjectVersionList where + a == b = + a.uuid == b.uuid + && a.name == b.name + && a.description == b.description + && a.eventUuid == b.eventUuid + && a.createdBy == b.createdBy diff --git a/wizard-server/src/Wizard/Model/Questionnaire/MigratorState.hs b/wizard-server/src/Wizard/Model/Questionnaire/MigratorState.hs deleted file mode 100644 index 741d8d75f..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/MigratorState.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Model.Questionnaire.MigratorState where - -import qualified Data.UUID as U -import GHC.Generics - -data MigratorState = MigratorState - { oldQuestionnaireUuid :: U.UUID - , newQuestionnaireUuid :: U.UUID - , resolvedQuestionUuids :: [U.UUID] - , tenantUuid :: U.UUID - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/Questionnaire/Questionnaire.hs b/wizard-server/src/Wizard/Model/Questionnaire/Questionnaire.hs deleted file mode 100644 index 823a3faaa..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/Questionnaire.hs +++ /dev/null @@ -1,60 +0,0 @@ -module Wizard.Model.Questionnaire.Questionnaire where - -import Data.Time -import qualified Data.UUID as U -import GHC.Generics - -import Wizard.Model.Questionnaire.QuestionnairePerm - -data QuestionnaireVisibility - = PrivateQuestionnaire - | VisibleViewQuestionnaire - | VisibleCommentQuestionnaire - | VisibleEditQuestionnaire - deriving (Show, Eq, Generic, Read) - -data QuestionnaireSharing - = RestrictedQuestionnaire - | AnyoneWithLinkViewQuestionnaire - | AnyoneWithLinkCommentQuestionnaire - | AnyoneWithLinkEditQuestionnaire - deriving (Show, Eq, Generic, Read) - -data Questionnaire = Questionnaire - { uuid :: U.UUID - , name :: String - , description :: Maybe String - , visibility :: QuestionnaireVisibility - , sharing :: QuestionnaireSharing - , knowledgeModelPackageId :: String - , selectedQuestionTagUuids :: [U.UUID] - , projectTags :: [String] - , documentTemplateId :: Maybe String - , formatUuid :: Maybe U.UUID - , creatorUuid :: Maybe U.UUID - , permissions :: [QuestionnairePerm] - , isTemplate :: Bool - , squashed :: Bool - , tenantUuid :: U.UUID - , createdAt :: UTCTime - , updatedAt :: UTCTime - } - deriving (Generic, Show) - -instance Eq Questionnaire where - a == b = - a.uuid == b.uuid - && a.name == b.name - && a.description == b.description - && a.visibility == b.visibility - && a.sharing == b.sharing - && a.knowledgeModelPackageId == b.knowledgeModelPackageId - && a.selectedQuestionTagUuids == b.selectedQuestionTagUuids - && a.projectTags == b.projectTags - && a.documentTemplateId == b.documentTemplateId - && a.formatUuid == b.formatUuid - && a.creatorUuid == b.creatorUuid - && a.permissions == b.permissions - && a.isTemplate == b.isTemplate - && a.squashed == b.squashed - && a.tenantUuid == b.tenantUuid diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireAclHelpers.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireAclHelpers.hs deleted file mode 100644 index c5ab8c2f2..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireAclHelpers.hs +++ /dev/null @@ -1,63 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireAclHelpers where - -import qualified Data.UUID as U - -import Wizard.Model.Acl.Acl -import Wizard.Model.Questionnaire.QuestionnairePerm - -getUserUuidsForViewerPerm :: QuestionnairePermC questionnairePerm => [questionnairePerm] -> [U.UUID] -getUserUuidsForViewerPerm = getUserUuidsForPerm _VIEW_PERM - -getUserUuidsForCommenterPerm :: QuestionnairePermC questionnairePerm => [questionnairePerm] -> [U.UUID] -getUserUuidsForCommenterPerm = getUserUuidsForPerm _COMMENT_PERM - -getUserUuidsForEditorPerm :: QuestionnairePermC questionnairePerm => [questionnairePerm] -> [U.UUID] -getUserUuidsForEditorPerm = getUserUuidsForPerm _EDIT_PERM - -getUserUuidsForOwnerPerm :: QuestionnairePermC questionnairePerm => [questionnairePerm] -> [U.UUID] -getUserUuidsForOwnerPerm = getUserUuidsForPerm _ADMIN_PERM - -getUserUuidsForPerm :: QuestionnairePermC questionnairePerm => String -> [questionnairePerm] -> [U.UUID] -getUserUuidsForPerm desiredPerm = foldl go [] - where - go :: QuestionnairePermC questionnairePerm => [U.UUID] -> questionnairePerm -> [U.UUID] - go acc qtnPerm = - case qtnPerm.memberType of - UserQuestionnairePermType -> - if desiredPerm `elem` qtnPerm.perms - then acc ++ [qtnPerm.memberUuid] - else acc - _ -> acc - -getUserGroupUuidsForViewerPerm :: QuestionnairePermC questionnairePerm => [questionnairePerm] -> [U.UUID] -getUserGroupUuidsForViewerPerm = getUserGroupUuidsForPerm _VIEW_PERM - -getUserGroupUuidsForCommenterPerm :: QuestionnairePermC questionnairePerm => [questionnairePerm] -> [U.UUID] -getUserGroupUuidsForCommenterPerm = getUserGroupUuidsForPerm _COMMENT_PERM - -getUserGroupUuidsForEditorPerm :: QuestionnairePermC questionnairePerm => [questionnairePerm] -> [U.UUID] -getUserGroupUuidsForEditorPerm = getUserGroupUuidsForPerm _EDIT_PERM - -getUserGroupUuidsForOwnerPerm :: QuestionnairePermC questionnairePerm => [questionnairePerm] -> [U.UUID] -getUserGroupUuidsForOwnerPerm = getUserGroupUuidsForPerm _ADMIN_PERM - -getUserGroupUuidsForPerm :: QuestionnairePermC questionnairePerm => String -> [questionnairePerm] -> [U.UUID] -getUserGroupUuidsForPerm desiredPerm = foldl go [] - where - go :: QuestionnairePermC questionnairePerm => [U.UUID] -> questionnairePerm -> [U.UUID] - go acc qtnPerm = - case qtnPerm.memberType of - UserGroupQuestionnairePermType -> - if desiredPerm `elem` qtnPerm.perms - then acc ++ [qtnPerm.memberUuid] - else acc - _ -> acc - -removeUserPermission :: QuestionnairePermC questionnairePerm => U.UUID -> [questionnairePerm] -> [questionnairePerm] -removeUserPermission userUuidToDelete = filter go - where - go :: QuestionnairePermC questionnairePerm => questionnairePerm -> Bool - go qtnPerm = - case qtnPerm.memberType of - UserQuestionnairePermType -> qtnPerm.memberUuid /= userUuidToDelete - _ -> True diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireComment.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireComment.hs deleted file mode 100644 index caac58be8..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireComment.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireComment where - -import Data.Time -import qualified Data.UUID as U -import GHC.Generics - -data QuestionnaireCommentThread = QuestionnaireCommentThread - { uuid :: U.UUID - , path :: String - , resolved :: Bool - , comments :: [QuestionnaireComment] - , private :: Bool - , questionnaireUuid :: U.UUID - , assignedTo :: Maybe U.UUID - , assignedBy :: Maybe U.UUID - , notificationRequired :: Bool - , createdBy :: Maybe U.UUID - , tenantUuid :: U.UUID - , createdAt :: UTCTime - , updatedAt :: UTCTime - } - deriving (Show, Eq, Generic) - -data QuestionnaireComment = QuestionnaireComment - { uuid :: U.UUID - , text :: String - , threadUuid :: U.UUID - , tenantUuid :: U.UUID - , createdBy :: Maybe U.UUID - , createdAt :: UTCTime - , updatedAt :: UTCTime - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireCommentList.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireCommentList.hs deleted file mode 100644 index 59ee10235..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireCommentList.hs +++ /dev/null @@ -1,32 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireCommentList where - -import Data.Time -import qualified Data.UUID as U -import GHC.Generics - -import WizardLib.Public.Model.User.UserSuggestion - -data QuestionnaireCommentThreadList = QuestionnaireCommentThreadList - { uuid :: U.UUID - , path :: String - , resolved :: Bool - , comments :: [QuestionnaireCommentList] - , private :: Bool - , assignedTo :: Maybe UserSuggestion - , createdBy :: Maybe UserSuggestion - , createdAt :: UTCTime - , updatedAt :: UTCTime - } - deriving (Show, Eq, Generic) - -data QuestionnaireCommentList = QuestionnaireCommentList - { uuid :: U.UUID - , text :: String - , createdBy :: Maybe UserSuggestion - , createdAt :: UTCTime - , updatedAt :: UTCTime - } - deriving (Show, Eq, Generic) - -instance Ord QuestionnaireCommentList where - compare a b = compare a.uuid b.uuid diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireCommentThreadAssigned.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireCommentThreadAssigned.hs deleted file mode 100644 index e49edae0d..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireCommentThreadAssigned.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireCommentThreadAssigned where - -import Data.Time -import qualified Data.UUID as U -import GHC.Generics - -import WizardLib.Public.Model.User.UserSuggestion - -data QuestionnaireCommentThreadAssigned = QuestionnaireCommentThreadAssigned - { questionnaireUuid :: U.UUID - , questionnaireName :: String - , commentThreadUuid :: U.UUID - , path :: String - , resolved :: Bool - , private :: Bool - , text :: String - , createdBy :: Maybe UserSuggestion - , updatedAt :: UTCTime - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireCommentThreadNotification.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireCommentThreadNotification.hs deleted file mode 100644 index 8098fd412..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireCommentThreadNotification.hs +++ /dev/null @@ -1,30 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireCommentThreadNotification where - -import qualified Data.UUID as U -import GHC.Generics - -import WizardLib.Public.Model.User.UserSimple - -data QuestionnaireCommentThreadNotification = QuestionnaireCommentThreadNotification - { questionnaireUuid :: U.UUID - , questionnaireName :: String - , tenantUuid :: U.UUID - , commentThreadUuid :: U.UUID - , path :: String - , resolved :: Bool - , private :: Bool - , assignedTo :: UserSimple - , assignedBy :: Maybe UserSimple - , text :: String - , clientUrl :: String - , appTitle :: Maybe String - , logoUrl :: Maybe String - , primaryColor :: Maybe String - , illustrationsColor :: Maybe String - , supportEmail :: Maybe String - , mailConfigUuid :: Maybe U.UUID - } - deriving (Show, Eq, Generic) - -instance Ord QuestionnaireCommentThreadNotification where - compare a b = compare a.questionnaireUuid b.questionnaireUuid diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireContent.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireContent.hs deleted file mode 100644 index d0f5d483e..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireContent.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireContent where - -import qualified Data.Map.Strict as M -import qualified Data.UUID as U -import GHC.Generics - -import Wizard.Model.Questionnaire.QuestionnaireReply - -data QuestionnaireContent = QuestionnaireContent - { phaseUuid :: Maybe U.UUID - , replies :: M.Map String Reply - , labels :: M.Map String [U.UUID] - } - deriving (Generic, Eq, Show) diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireContentDM.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireContentDM.hs deleted file mode 100644 index 17b94167a..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireContentDM.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireContentDM where - -import qualified Data.Map.Strict as M - -import Wizard.Model.Questionnaire.QuestionnaireContent - -defaultQuestionnaireContent :: QuestionnaireContent -defaultQuestionnaireContent = - QuestionnaireContent - { phaseUuid = Nothing - , replies = M.empty - , labels = M.empty - } diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireDetail.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireDetail.hs deleted file mode 100644 index 7a0f230e9..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireDetail.hs +++ /dev/null @@ -1,23 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireDetail where - -import qualified Data.UUID as U -import GHC.Generics - -import Wizard.Api.Resource.Questionnaire.QuestionnairePermDTO -import Wizard.Model.Questionnaire.Questionnaire - -data QuestionnaireDetail = QuestionnaireDetail - { uuid :: U.UUID - , name :: String - , visibility :: QuestionnaireVisibility - , sharing :: QuestionnaireSharing - , knowledgeModelPackageId :: String - , selectedQuestionTagUuids :: [U.UUID] - , isTemplate :: Bool - , migrationUuid :: Maybe U.UUID - , permissions :: [QuestionnairePermDTO] - , questionnaireActionsAvailable :: Int - , questionnaireImportersAvailable :: Int - , fileCount :: Int - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireDetailPreview.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireDetailPreview.hs deleted file mode 100644 index a0387dccb..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireDetailPreview.hs +++ /dev/null @@ -1,23 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireDetailPreview where - -import qualified Data.UUID as U -import GHC.Generics - -import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplateFormatSimple -import Wizard.Api.Resource.Questionnaire.QuestionnairePermDTO -import Wizard.Model.Questionnaire.Questionnaire - -data QuestionnaireDetailPreview = QuestionnaireDetailPreview - { uuid :: U.UUID - , name :: String - , visibility :: QuestionnaireVisibility - , sharing :: QuestionnaireSharing - , knowledgeModelPackageId :: String - , isTemplate :: Bool - , migrationUuid :: Maybe U.UUID - , permissions :: [QuestionnairePermDTO] - , documentTemplateId :: Maybe String - , format :: Maybe DocumentTemplateFormatSimple - , fileCount :: Int - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireDetailQuestionnaire.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireDetailQuestionnaire.hs deleted file mode 100644 index d3a9fe0f7..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireDetailQuestionnaire.hs +++ /dev/null @@ -1,24 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireDetailQuestionnaire where - -import qualified Data.UUID as U -import GHC.Generics - -import Wizard.Api.Resource.Questionnaire.QuestionnairePermDTO -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireFileSimple - -data QuestionnaireDetailQuestionnaire = QuestionnaireDetailQuestionnaire - { uuid :: U.UUID - , name :: String - , visibility :: QuestionnaireVisibility - , sharing :: QuestionnaireSharing - , knowledgeModelPackageId :: String - , selectedQuestionTagUuids :: [U.UUID] - , isTemplate :: Bool - , migrationUuid :: Maybe U.UUID - , permissions :: [QuestionnairePermDTO] - , files :: [QuestionnaireFileSimple] - , questionnaireActionsAvailable :: Int - , questionnaireImportersAvailable :: Int - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireDetailSettings.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireDetailSettings.hs deleted file mode 100644 index 9a82d2f8a..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireDetailSettings.hs +++ /dev/null @@ -1,34 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireDetailSettings where - -import qualified Data.UUID as U -import GHC.Generics - -import Shared.DocumentTemplate.Api.Resource.DocumentTemplate.DocumentTemplateDTO -import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplate -import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel -import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSimpleDTO -import Wizard.Api.Resource.Questionnaire.QuestionnairePermDTO -import Wizard.Model.DocumentTemplate.DocumentTemplateState -import Wizard.Model.Questionnaire.Questionnaire - -data QuestionnaireDetailSettings = QuestionnaireDetailSettings - { uuid :: U.UUID - , name :: String - , description :: Maybe String - , visibility :: QuestionnaireVisibility - , sharing :: QuestionnaireSharing - , isTemplate :: Bool - , migrationUuid :: Maybe U.UUID - , permissions :: [QuestionnairePermDTO] - , projectTags :: [String] - , knowledgeModelPackageId :: String - , knowledgeModelPackage :: KnowledgeModelPackageSimpleDTO - , knowledgeModelTags :: [Tag] - , documentTemplate :: Maybe DocumentTemplateDTO - , documentTemplateState :: Maybe DocumentTemplateState - , documentTemplatePhase :: Maybe DocumentTemplatePhase - , formatUuid :: Maybe U.UUID - , selectedQuestionTagUuids :: [U.UUID] - , fileCount :: Int - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireEvent.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireEvent.hs deleted file mode 100644 index 0136449f8..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireEvent.hs +++ /dev/null @@ -1,90 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireEvent where - -import Data.Time -import qualified Data.UUID as U -import GHC.Generics - -import Wizard.Model.Questionnaire.QuestionnaireReply - -data QuestionnaireEvent - = SetReplyEvent' SetReplyEvent - | ClearReplyEvent' ClearReplyEvent - | SetPhaseEvent' SetPhaseEvent - | SetLabelsEvent' SetLabelsEvent - deriving (Show, Eq, Generic) - -data SetReplyEvent = SetReplyEvent - { uuid :: U.UUID - , path :: String - , value :: ReplyValue - , questionnaireUuid :: U.UUID - , tenantUuid :: U.UUID - , createdBy :: Maybe U.UUID - , createdAt :: UTCTime - } - deriving (Show, Generic) - -instance Eq SetReplyEvent where - a == b = - a.uuid == b.uuid - && a.path == b.path - && a.value == b.value - && a.questionnaireUuid == b.questionnaireUuid - && a.tenantUuid == b.tenantUuid - && a.createdBy == b.createdBy - -data ClearReplyEvent = ClearReplyEvent - { uuid :: U.UUID - , path :: String - , questionnaireUuid :: U.UUID - , tenantUuid :: U.UUID - , createdBy :: Maybe U.UUID - , createdAt :: UTCTime - } - deriving (Show, Generic) - -instance Eq ClearReplyEvent where - a == b = - a.uuid == b.uuid - && a.path == b.path - && a.questionnaireUuid == b.questionnaireUuid - && a.tenantUuid == b.tenantUuid - && a.createdBy == b.createdBy - -data SetPhaseEvent = SetPhaseEvent - { uuid :: U.UUID - , phaseUuid :: Maybe U.UUID - , questionnaireUuid :: U.UUID - , tenantUuid :: U.UUID - , createdBy :: Maybe U.UUID - , createdAt :: UTCTime - } - deriving (Show, Generic) - -instance Eq SetPhaseEvent where - a == b = - a.uuid == b.uuid - && a.phaseUuid == b.phaseUuid - && a.questionnaireUuid == b.questionnaireUuid - && a.tenantUuid == b.tenantUuid - && a.createdBy == b.createdBy - -data SetLabelsEvent = SetLabelsEvent - { uuid :: U.UUID - , path :: String - , value :: [U.UUID] - , questionnaireUuid :: U.UUID - , tenantUuid :: U.UUID - , createdBy :: Maybe U.UUID - , createdAt :: UTCTime - } - deriving (Show, Generic) - -instance Eq SetLabelsEvent where - a == b = - a.uuid == b.uuid - && a.path == b.path - && a.value == b.value - && a.questionnaireUuid == b.questionnaireUuid - && a.tenantUuid == b.tenantUuid - && a.createdBy == b.createdBy diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireEventLenses.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireEventLenses.hs deleted file mode 100644 index e8d2ab8ea..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireEventLenses.hs +++ /dev/null @@ -1,45 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireEventLenses where - -import Shared.Common.Model.Common.Lens -import Wizard.Model.Common.Lens -import Wizard.Model.Questionnaire.QuestionnaireEvent - -instance HasUuid' QuestionnaireEvent where - getUuid (SetReplyEvent' entity) = entity.uuid - getUuid (ClearReplyEvent' entity) = entity.uuid - getUuid (SetPhaseEvent' entity) = entity.uuid - getUuid (SetLabelsEvent' entity) = entity.uuid - setUuid (SetReplyEvent' entity) newValue = SetReplyEvent' $ entity {uuid = newValue} - setUuid (ClearReplyEvent' entity) newValue = ClearReplyEvent' $ entity {uuid = newValue} - setUuid (SetPhaseEvent' entity) newValue = SetPhaseEvent' $ entity {uuid = newValue} - setUuid (SetLabelsEvent' entity) newValue = SetLabelsEvent' $ entity {uuid = newValue} - -instance HasQuestionnaireUuid' QuestionnaireEvent where - getQuestionnaireUuid (SetReplyEvent' entity) = entity.questionnaireUuid - getQuestionnaireUuid (ClearReplyEvent' entity) = entity.questionnaireUuid - getQuestionnaireUuid (SetPhaseEvent' entity) = entity.questionnaireUuid - getQuestionnaireUuid (SetLabelsEvent' entity) = entity.questionnaireUuid - setQuestionnaireUuid (SetReplyEvent' entity) newValue = SetReplyEvent' $ entity {questionnaireUuid = newValue} - setQuestionnaireUuid (ClearReplyEvent' entity) newValue = ClearReplyEvent' $ entity {questionnaireUuid = newValue} - setQuestionnaireUuid (SetPhaseEvent' entity) newValue = SetPhaseEvent' $ entity {questionnaireUuid = newValue} - setQuestionnaireUuid (SetLabelsEvent' entity) newValue = SetLabelsEvent' $ entity {questionnaireUuid = newValue} - -instance HasCreatedAt' QuestionnaireEvent where - getCreatedAt (SetReplyEvent' entity) = entity.createdAt - getCreatedAt (ClearReplyEvent' entity) = entity.createdAt - getCreatedAt (SetPhaseEvent' entity) = entity.createdAt - getCreatedAt (SetLabelsEvent' entity) = entity.createdAt - setCreatedAt (SetReplyEvent' entity) newValue = SetReplyEvent' $ entity {createdAt = newValue} - setCreatedAt (ClearReplyEvent' entity) newValue = ClearReplyEvent' $ entity {createdAt = newValue} - setCreatedAt (SetPhaseEvent' entity) newValue = SetPhaseEvent' $ entity {createdAt = newValue} - setCreatedAt (SetLabelsEvent' entity) newValue = SetLabelsEvent' $ entity {createdAt = newValue} - -instance HasCreatedBy' QuestionnaireEvent where - getCreatedBy (SetReplyEvent' entity) = entity.createdBy - getCreatedBy (ClearReplyEvent' entity) = entity.createdBy - getCreatedBy (SetPhaseEvent' entity) = entity.createdBy - getCreatedBy (SetLabelsEvent' entity) = entity.createdBy - setCreatedBy (SetReplyEvent' entity) newValue = SetReplyEvent' $ entity {createdBy = newValue} - setCreatedBy (ClearReplyEvent' entity) newValue = ClearReplyEvent' $ entity {createdBy = newValue} - setCreatedBy (SetPhaseEvent' entity) newValue = SetPhaseEvent' $ entity {createdBy = newValue} - setCreatedBy (SetLabelsEvent' entity) newValue = SetLabelsEvent' $ entity {createdBy = newValue} diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireEventList.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireEventList.hs deleted file mode 100644 index 28be6ea65..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireEventList.hs +++ /dev/null @@ -1,75 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireEventList where - -import Data.Time -import qualified Data.UUID as U -import GHC.Generics - -import Wizard.Model.Questionnaire.QuestionnaireReply -import WizardLib.Public.Model.User.UserSuggestion - -data QuestionnaireEventList - = SetReplyEventList' SetReplyEventList - | ClearReplyEventList' ClearReplyEventList - | SetPhaseEventList' SetPhaseEventList - | SetLabelsEventList' SetLabelsEventList - deriving (Show, Eq, Generic) - -data SetReplyEventList = SetReplyEventList - { uuid :: U.UUID - , path :: String - , value :: ReplyValue - , createdBy :: Maybe UserSuggestion - , createdAt :: UTCTime - } - deriving (Show, Generic) - -instance Eq SetReplyEventList where - a == b = - a.uuid == b.uuid - && a.path == b.path - && a.value == b.value - && a.createdBy == b.createdBy - -data ClearReplyEventList = ClearReplyEventList - { uuid :: U.UUID - , path :: String - , createdBy :: Maybe UserSuggestion - , createdAt :: UTCTime - } - deriving (Show, Generic) - -instance Eq ClearReplyEventList where - a == b = - a.uuid == b.uuid - && a.path == b.path - && a.createdBy == b.createdBy - -data SetPhaseEventList = SetPhaseEventList - { uuid :: U.UUID - , phaseUuid :: Maybe U.UUID - , createdBy :: Maybe UserSuggestion - , createdAt :: UTCTime - } - deriving (Show, Generic) - -instance Eq SetPhaseEventList where - a == b = - a.uuid == b.uuid - && a.phaseUuid == b.phaseUuid - && a.createdBy == b.createdBy - -data SetLabelsEventList = SetLabelsEventList - { uuid :: U.UUID - , path :: String - , value :: [U.UUID] - , createdBy :: Maybe UserSuggestion - , createdAt :: UTCTime - } - deriving (Show, Generic) - -instance Eq SetLabelsEventList where - a == b = - a.uuid == b.uuid - && a.path == b.path - && a.value == b.value - && a.createdBy == b.createdBy diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireEventListLenses.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireEventListLenses.hs deleted file mode 100644 index 1ca6956ef..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireEventListLenses.hs +++ /dev/null @@ -1,24 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireEventListLenses where - -import Shared.Common.Model.Common.Lens -import Wizard.Model.Questionnaire.QuestionnaireEventList - -instance HasUuid' QuestionnaireEventList where - getUuid (SetReplyEventList' entity) = entity.uuid - getUuid (ClearReplyEventList' entity) = entity.uuid - getUuid (SetPhaseEventList' entity) = entity.uuid - getUuid (SetLabelsEventList' entity) = entity.uuid - setUuid (SetReplyEventList' entity) newValue = SetReplyEventList' $ entity {uuid = newValue} - setUuid (ClearReplyEventList' entity) newValue = ClearReplyEventList' $ entity {uuid = newValue} - setUuid (SetPhaseEventList' entity) newValue = SetPhaseEventList' $ entity {uuid = newValue} - setUuid (SetLabelsEventList' entity) newValue = SetLabelsEventList' $ entity {uuid = newValue} - -instance HasCreatedAt' QuestionnaireEventList where - getCreatedAt (SetReplyEventList' entity) = entity.createdAt - getCreatedAt (ClearReplyEventList' entity) = entity.createdAt - getCreatedAt (SetPhaseEventList' entity) = entity.createdAt - getCreatedAt (SetLabelsEventList' entity) = entity.createdAt - setCreatedAt (SetReplyEventList' entity) newValue = SetReplyEventList' $ entity {createdAt = newValue} - setCreatedAt (ClearReplyEventList' entity) newValue = ClearReplyEventList' $ entity {createdAt = newValue} - setCreatedAt (SetPhaseEventList' entity) newValue = SetPhaseEventList' $ entity {createdAt = newValue} - setCreatedAt (SetLabelsEventList' entity) newValue = SetLabelsEventList' $ entity {createdAt = newValue} diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireFile.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireFile.hs deleted file mode 100644 index ae4bf1f86..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireFile.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireFile where - -import Data.Time -import qualified Data.UUID as U -import GHC.Generics -import GHC.Int - -data QuestionnaireFile = QuestionnaireFile - { uuid :: U.UUID - , fileName :: String - , contentType :: String - , fileSize :: Int64 - , questionnaireUuid :: U.UUID - , createdBy :: Maybe U.UUID - , tenantUuid :: U.UUID - , createdAt :: UTCTime - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireFileList.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireFileList.hs deleted file mode 100644 index 2ccb428a2..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireFileList.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireFileList where - -import Data.Time -import qualified Data.UUID as U -import GHC.Generics -import GHC.Int - -import Wizard.Model.Questionnaire.QuestionnaireSimple -import WizardLib.Public.Model.User.UserSuggestion - -data QuestionnaireFileList = QuestionnaireFileList - { uuid :: U.UUID - , fileName :: String - , contentType :: String - , fileSize :: Int64 - , questionnaire :: QuestionnaireSimple - , createdBy :: Maybe UserSuggestion - , createdAt :: UTCTime - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireFileSimple.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireFileSimple.hs deleted file mode 100644 index e0a92d741..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireFileSimple.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireFileSimple where - -import qualified Data.UUID as U -import GHC.Generics -import GHC.Int - -data QuestionnaireFileSimple = QuestionnaireFileSimple - { uuid :: U.UUID - , fileName :: String - , contentType :: String - , fileSize :: Int64 - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireList.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireList.hs deleted file mode 100644 index 47173c119..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireList.hs +++ /dev/null @@ -1,37 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireList where - -import Data.Time -import qualified Data.UUID as U -import GHC.Generics - -import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackageSimple -import Wizard.Api.Resource.Questionnaire.QuestionnairePermDTO -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireState - -data QuestionnaireList = QuestionnaireList - { uuid :: U.UUID - , name :: String - , description :: Maybe String - , visibility :: QuestionnaireVisibility - , sharing :: QuestionnaireSharing - , state :: QuestionnaireState - , knowledgeModelPackage :: KnowledgeModelPackageSimple - , permissions :: [QuestionnairePermDTO] - , isTemplate :: Bool - , createdAt :: UTCTime - , updatedAt :: UTCTime - } - deriving (Generic, Show) - -instance Eq QuestionnaireList where - a == b = - a.uuid == b.uuid - && a.name == b.name - && a.description == b.description - && a.visibility == b.visibility - && a.sharing == b.sharing - && a.state == b.state - && a.knowledgeModelPackage == b.knowledgeModelPackage - && a.permissions == b.permissions - && a.isTemplate == b.isTemplate diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnairePerm.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnairePerm.hs deleted file mode 100644 index 49b3c6eb1..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnairePerm.hs +++ /dev/null @@ -1,38 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnairePerm where - -import qualified Data.UUID as U -import GHC.Generics -import GHC.Records - -import Wizard.Model.Acl.Acl - -data QuestionnairePermType - = UserQuestionnairePermType - | UserGroupQuestionnairePermType - deriving (Show, Eq, Generic, Read) - -data QuestionnairePerm = QuestionnairePerm - { questionnaireUuid :: U.UUID - , memberType :: QuestionnairePermType - , memberUuid :: U.UUID - , perms :: [String] - , tenantUuid :: U.UUID - } - deriving (Generic, Eq, Show) - -class - ( HasField "perms" questionnairePerm [String] - , HasField "memberUuid" questionnairePerm U.UUID - , HasField "memberType" questionnairePerm QuestionnairePermType - ) => - QuestionnairePermC questionnairePerm - -instance QuestionnairePermC QuestionnairePerm - -ownerPermissions = [_VIEW_PERM, _COMMENT_PERM, _EDIT_PERM, _ADMIN_PERM] - -editorPermissions = [_VIEW_PERM, _COMMENT_PERM, _EDIT_PERM] - -commentatorPermissions = [_VIEW_PERM, _COMMENT_PERM] - -viewerPermissions = [_VIEW_PERM] diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireReply.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireReply.hs deleted file mode 100644 index ce5bd7dac..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireReply.hs +++ /dev/null @@ -1,63 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireReply where - -import Data.Aeson -import Data.Hashable -import Data.Time -import qualified Data.UUID as U -import GHC.Generics - -import Wizard.Util.Hashable () -import WizardLib.Public.Model.User.UserSuggestion - -type ReplyTuple = (String, Reply) - -data Reply = Reply - { value :: ReplyValue - , createdBy :: Maybe UserSuggestion - , createdAt :: UTCTime - } - deriving (Show, Eq, Generic) - -instance Hashable Reply - -data ReplyValue - = StringReply - { sValue :: String - } - | AnswerReply - { aValue :: U.UUID - } - | MultiChoiceReply - { mcValue :: [U.UUID] - } - | ItemListReply - { ilValue :: [U.UUID] - } - | IntegrationReply - { iValue :: IntegrationReplyType - } - | ItemSelectReply - { isValue :: U.UUID - } - | FileReply - { fValue :: U.UUID - } - deriving (Show, Eq, Generic) - -instance Hashable ReplyValue - -data IntegrationReplyType - = PlainType - { value :: String - } - | IntegrationLegacyType - { intId :: Maybe String - , value :: String - } - | IntegrationType - { value :: String - , raw :: Value - } - deriving (Show, Eq, Generic) - -instance Hashable IntegrationReplyType diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireSimple.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireSimple.hs deleted file mode 100644 index 533284c8d..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireSimple.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireSimple where - -import qualified Data.UUID as U -import GHC.Generics - -data QuestionnaireSimple = QuestionnaireSimple - { uuid :: U.UUID - , name :: String - } - deriving (Generic, Eq, Show) diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireSimpleWithPerm.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireSimpleWithPerm.hs deleted file mode 100644 index 90ece4922..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireSimpleWithPerm.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireSimpleWithPerm where - -import qualified Data.UUID as U -import GHC.Generics - -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnairePerm - -data QuestionnaireSimpleWithPerm = QuestionnaireSimpleWithPerm - { uuid :: U.UUID - , visibility :: QuestionnaireVisibility - , sharing :: QuestionnaireSharing - , tenantUuid :: U.UUID - , permissions :: [QuestionnairePerm] - } - deriving (Generic, Eq, Show) diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireState.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireState.hs deleted file mode 100644 index 532816b73..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireState.hs +++ /dev/null @@ -1,9 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireState where - -import GHC.Generics - -data QuestionnaireState - = QSDefault - | QSMigrating - | QSOutdated - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireSuggestion.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireSuggestion.hs deleted file mode 100644 index 9bc850bd7..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireSuggestion.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireSuggestion where - -import qualified Data.UUID as U -import GHC.Generics - -data QuestionnaireSuggestion = QuestionnaireSuggestion - { uuid :: U.UUID - , name :: String - , description :: Maybe String - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireUtil.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireUtil.hs deleted file mode 100644 index 237f6d176..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireUtil.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireUtil where - -import qualified Data.List as L -import Data.Maybe (fromJust) -import qualified Data.UUID as U - -import Shared.Common.Util.String (splitOn) - -createReplyKey :: [U.UUID] -> String -createReplyKey = L.intercalate "." . fmap U.toString - -readReplyKey :: String -> [U.UUID] -readReplyKey = fmap (fromJust . U.fromString) . splitOn "." - -replyKeyContains :: String -> U.UUID -> Bool -replyKeyContains replyKey uuid = uuid `elem` readReplyKey replyKey diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireVersion.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireVersion.hs deleted file mode 100644 index 6e0063436..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireVersion.hs +++ /dev/null @@ -1,32 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireVersion where - -import Data.Aeson () -import Data.Hashable -import Data.Time -import qualified Data.UUID as U -import GHC.Generics - -import Wizard.Util.Hashable () - -data QuestionnaireVersion = QuestionnaireVersion - { uuid :: U.UUID - , name :: String - , description :: Maybe String - , eventUuid :: U.UUID - , questionnaireUuid :: U.UUID - , tenantUuid :: U.UUID - , createdBy :: Maybe U.UUID - , createdAt :: UTCTime - , updatedAt :: UTCTime - } - deriving (Show, Generic) - -instance Eq QuestionnaireVersion where - a == b = - a.uuid == b.uuid - && a.name == b.name - && a.description == b.description - && a.eventUuid == b.eventUuid - && a.createdBy == b.createdBy - -instance Hashable QuestionnaireVersion diff --git a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireVersionList.hs b/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireVersionList.hs deleted file mode 100644 index 8a5680ed7..000000000 --- a/wizard-server/src/Wizard/Model/Questionnaire/QuestionnaireVersionList.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Wizard.Model.Questionnaire.QuestionnaireVersionList where - -import Data.Time -import qualified Data.UUID as U -import GHC.Generics - -import WizardLib.Public.Model.User.UserSuggestion - -data QuestionnaireVersionList = QuestionnaireVersionList - { uuid :: U.UUID - , name :: String - , description :: Maybe String - , eventUuid :: U.UUID - , createdBy :: Maybe UserSuggestion - , createdAt :: UTCTime - , updatedAt :: UTCTime - } - deriving (Show, Generic) - -instance Eq QuestionnaireVersionList where - a == b = - a.uuid == b.uuid - && a.name == b.name - && a.description == b.description - && a.eventUuid == b.eventUuid - && a.createdBy == b.createdBy diff --git a/wizard-server/src/Wizard/Model/QuestionnaireAction/QuestionnaireAction.hs b/wizard-server/src/Wizard/Model/QuestionnaireAction/QuestionnaireAction.hs deleted file mode 100644 index eb0db91ae..000000000 --- a/wizard-server/src/Wizard/Model/QuestionnaireAction/QuestionnaireAction.hs +++ /dev/null @@ -1,28 +0,0 @@ -module Wizard.Model.QuestionnaireAction.QuestionnaireAction where - -import Data.Aeson -import Data.Time -import qualified Data.UUID as U -import GHC.Generics - -import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackagePattern - -data QuestionnaireAction = QuestionnaireAction - { qaId :: String - , name :: String - , organizationId :: String - , actionId :: String - , version :: String - , metamodelVersion :: Int - , description :: String - , readme :: String - , license :: String - , allowedPackages :: [KnowledgeModelPackagePattern] - , url :: String - , config :: Object - , enabled :: Bool - , tenantUuid :: U.UUID - , createdAt :: UTCTime - , updatedAt :: UTCTime - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/QuestionnaireImporter/QuestionnaireImporter.hs b/wizard-server/src/Wizard/Model/QuestionnaireImporter/QuestionnaireImporter.hs deleted file mode 100644 index fe02ab4b8..000000000 --- a/wizard-server/src/Wizard/Model/QuestionnaireImporter/QuestionnaireImporter.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Wizard.Model.QuestionnaireImporter.QuestionnaireImporter where - -import Data.Time -import qualified Data.UUID as U -import GHC.Generics - -import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackagePattern - -data QuestionnaireImporter = QuestionnaireImporter - { qiId :: String - , name :: String - , organizationId :: String - , importerId :: String - , version :: String - , metamodelVersion :: Int - , description :: String - , readme :: String - , license :: String - , allowedPackages :: [KnowledgeModelPackagePattern] - , url :: String - , enabled :: Bool - , tenantUuid :: U.UUID - , createdAt :: UTCTime - , updatedAt :: UTCTime - } - deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Model/Statistics/InstanceStatistics.hs b/wizard-server/src/Wizard/Model/Statistics/InstanceStatistics.hs index a26beaf41..249b76ee5 100644 --- a/wizard-server/src/Wizard/Model/Statistics/InstanceStatistics.hs +++ b/wizard-server/src/Wizard/Model/Statistics/InstanceStatistics.hs @@ -5,7 +5,7 @@ import GHC.Generics data InstanceStatistics = InstanceStatistics { userCount :: Int , pkgCount :: Int - , qtnCount :: Int + , prjCount :: Int , knowledgeModelEditorCount :: Int , docCount :: Int , tmlCount :: Int diff --git a/wizard-server/src/Wizard/Model/Tenant/Config/TenantConfig.hs b/wizard-server/src/Wizard/Model/Tenant/Config/TenantConfig.hs index 64872a4bd..8e228510d 100644 --- a/wizard-server/src/Wizard/Model/Tenant/Config/TenantConfig.hs +++ b/wizard-server/src/Wizard/Model/Tenant/Config/TenantConfig.hs @@ -9,7 +9,7 @@ import GHC.Generics import Shared.Common.Model.Config.SimpleFeature import Shared.OpenId.Model.OpenId.OpenIdClientParameter import Shared.OpenId.Model.OpenId.OpenIdClientStyle -import Wizard.Model.Questionnaire.Questionnaire hiding (uuid) +import Wizard.Model.Project.Project hiding (uuid) import WizardLib.Public.Model.Tenant.Config.TenantConfig data TenantConfig = TenantConfig @@ -21,7 +21,7 @@ data TenantConfig = TenantConfig , lookAndFeel :: TenantConfigLookAndFeel , registry :: TenantConfigRegistry , knowledgeModel :: TenantConfigKnowledgeModel - , questionnaire :: TenantConfigQuestionnaire + , project :: TenantConfigProject , submission :: TenantConfigSubmission , features :: TenantConfigFeatures , owl :: TenantConfigOwl @@ -40,7 +40,7 @@ instance Eq TenantConfig where && dashboardAndLoginScreen a == dashboardAndLoginScreen b && lookAndFeel a == lookAndFeel b && registry a == registry b - && questionnaire a == questionnaire b + && project a == project b && submission a == submission b && features a == features b && owl a == owl b @@ -230,54 +230,54 @@ instance Eq TenantConfigKnowledgeModelPublicPackagePattern where && a.minVersion == b.minVersion && a.maxVersion == b.maxVersion -data TenantConfigQuestionnaire = TenantConfigQuestionnaire +data TenantConfigProject = TenantConfigProject { tenantUuid :: U.UUID - , questionnaireVisibility :: TenantConfigQuestionnaireVisibility - , questionnaireSharing :: TenantConfigQuestionnaireSharing - , questionnaireCreation :: QuestionnaireCreation - , projectTagging :: TenantConfigQuestionnaireProjectTagging + , projectVisibility :: TenantConfigProjectVisibility + , projectSharing :: TenantConfigProjectSharing + , projectCreation :: ProjectCreation + , projectTagging :: TenantConfigProjectProjectTagging , summaryReport :: SimpleFeature - , feedback :: TenantConfigQuestionnaireFeedback + , feedback :: TenantConfigProjectFeedback , createdAt :: UTCTime , updatedAt :: UTCTime } deriving (Generic, Show) -instance Eq TenantConfigQuestionnaire where +instance Eq TenantConfigProject where a == b = - a.questionnaireVisibility == b.questionnaireVisibility - && a.questionnaireSharing == b.questionnaireSharing - && a.questionnaireCreation == b.questionnaireCreation + a.projectVisibility == b.projectVisibility + && a.projectSharing == b.projectSharing + && a.projectCreation == b.projectCreation && a.projectTagging == b.projectTagging && a.summaryReport == b.summaryReport && a.feedback == b.feedback -data TenantConfigQuestionnaireVisibility = TenantConfigQuestionnaireVisibility +data TenantConfigProjectVisibility = TenantConfigProjectVisibility { enabled :: Bool - , defaultValue :: QuestionnaireVisibility + , defaultValue :: ProjectVisibility } deriving (Generic, Eq, Show) -data TenantConfigQuestionnaireSharing = TenantConfigQuestionnaireSharing +data TenantConfigProjectSharing = TenantConfigProjectSharing { enabled :: Bool - , defaultValue :: QuestionnaireSharing + , defaultValue :: ProjectSharing , anonymousEnabled :: Bool } deriving (Generic, Eq, Show) -data QuestionnaireCreation - = CustomQuestionnaireCreation - | TemplateQuestionnaireCreation - | TemplateAndCustomQuestionnaireCreation +data ProjectCreation + = CustomProjectCreation + | TemplateProjectCreation + | TemplateAndCustomProjectCreation deriving (Generic, Eq, Show, Read) -data TenantConfigQuestionnaireProjectTagging = TenantConfigQuestionnaireProjectTagging +data TenantConfigProjectProjectTagging = TenantConfigProjectProjectTagging { enabled :: Bool , tags :: [String] } deriving (Generic, Eq, Show) -data TenantConfigQuestionnaireFeedback = TenantConfigQuestionnaireFeedback +data TenantConfigProjectFeedback = TenantConfigProjectFeedback { enabled :: Bool , token :: String , owner :: String diff --git a/wizard-server/src/Wizard/Model/Tenant/Config/TenantConfigDM.hs b/wizard-server/src/Wizard/Model/Tenant/Config/TenantConfigDM.hs index 6a9d73a0e..7e3d59621 100644 --- a/wizard-server/src/Wizard/Model/Tenant/Config/TenantConfigDM.hs +++ b/wizard-server/src/Wizard/Model/Tenant/Config/TenantConfigDM.hs @@ -4,7 +4,7 @@ import qualified Data.UUID as U import Shared.Common.Model.Config.SimpleFeature import Shared.Common.Util.Date -import Wizard.Model.Questionnaire.Questionnaire +import Wizard.Model.Project.Project import Wizard.Model.Tenant.Config.TenantConfig import Wizard.Model.User.User @@ -98,45 +98,45 @@ defaultKnowledgeModelPublic = , knowledgeModelPackages = [] } -defaultQuestionnaire :: TenantConfigQuestionnaire -defaultQuestionnaire = - TenantConfigQuestionnaire +defaultProject :: TenantConfigProject +defaultProject = + TenantConfigProject { tenantUuid = U.nil - , questionnaireVisibility = defaultQuestionnaireVisibility - , questionnaireSharing = defaultQuestionnaireSharing - , questionnaireCreation = TemplateAndCustomQuestionnaireCreation - , projectTagging = defaultQuestionnaireProjectTagging + , projectVisibility = defaultProjectVisibility + , projectSharing = defaultProjectSharing + , projectCreation = TemplateAndCustomProjectCreation + , projectTagging = defaultProjectProjectTagging , summaryReport = SimpleFeature True , feedback = defaultFeedback , createdAt = dt' 2018 1 20 , updatedAt = dt' 2018 1 20 } -defaultQuestionnaireVisibility :: TenantConfigQuestionnaireVisibility -defaultQuestionnaireVisibility = - TenantConfigQuestionnaireVisibility +defaultProjectVisibility :: TenantConfigProjectVisibility +defaultProjectVisibility = + TenantConfigProjectVisibility { enabled = True - , defaultValue = PrivateQuestionnaire + , defaultValue = PrivateProjectVisibility } -defaultQuestionnaireSharing :: TenantConfigQuestionnaireSharing -defaultQuestionnaireSharing = - TenantConfigQuestionnaireSharing +defaultProjectSharing :: TenantConfigProjectSharing +defaultProjectSharing = + TenantConfigProjectSharing { enabled = True - , defaultValue = RestrictedQuestionnaire + , defaultValue = RestrictedProjectSharing , anonymousEnabled = True } -defaultQuestionnaireProjectTagging :: TenantConfigQuestionnaireProjectTagging -defaultQuestionnaireProjectTagging = - TenantConfigQuestionnaireProjectTagging +defaultProjectProjectTagging :: TenantConfigProjectProjectTagging +defaultProjectProjectTagging = + TenantConfigProjectProjectTagging { enabled = True , tags = [] } -defaultFeedback :: TenantConfigQuestionnaireFeedback +defaultFeedback :: TenantConfigProjectFeedback defaultFeedback = - TenantConfigQuestionnaireFeedback + TenantConfigProjectFeedback { enabled = False , token = "" , owner = "" diff --git a/wizard-server/src/Wizard/Model/Tenant/Config/TenantConfigEM.hs b/wizard-server/src/Wizard/Model/Tenant/Config/TenantConfigEM.hs index 63a2db30c..4ec31d37f 100644 --- a/wizard-server/src/Wizard/Model/Tenant/Config/TenantConfigEM.hs +++ b/wizard-server/src/Wizard/Model/Tenant/Config/TenantConfigEM.hs @@ -47,10 +47,10 @@ instance SensitiveData TenantConfigKnowledgeModel where process key entity = entity {integrationConfig = encryptAES256WithB64 key entity.integrationConfig} -instance SensitiveData TenantConfigQuestionnaire where +instance SensitiveData TenantConfigProject where process key entity = entity {feedback = process key entity.feedback} -instance SensitiveData TenantConfigQuestionnaireFeedback where +instance SensitiveData TenantConfigProjectFeedback where process key entity = entity {token = encryptAES256WithB64 key entity.token} instance SensitiveData TenantConfigFeatures diff --git a/wizard-server/src/Wizard/Model/Tenant/Limit/TenantLimitBundle.hs b/wizard-server/src/Wizard/Model/Tenant/Limit/TenantLimitBundle.hs index 1f6688acd..90ed50689 100644 --- a/wizard-server/src/Wizard/Model/Tenant/Limit/TenantLimitBundle.hs +++ b/wizard-server/src/Wizard/Model/Tenant/Limit/TenantLimitBundle.hs @@ -13,7 +13,7 @@ data TenantLimitBundle = TenantLimitBundle , knowledgeModelEditors :: Int , documentTemplates :: Int , documentTemplateDrafts :: Int - , questionnaires :: Int + , projects :: Int , documents :: Int , locales :: Int , storage :: Int64 diff --git a/wizard-server/src/Wizard/S3/Project/ProjectFileS3.hs b/wizard-server/src/Wizard/S3/Project/ProjectFileS3.hs new file mode 100644 index 000000000..edf057e84 --- /dev/null +++ b/wizard-server/src/Wizard/S3/Project/ProjectFileS3.hs @@ -0,0 +1,43 @@ +module Wizard.S3.Project.ProjectFileS3 where + +import qualified Data.ByteString.Char8 as BS +import qualified Data.Conduit as C +import qualified Data.UUID as U +import Network.Minio + +import Shared.Common.S3.Common +import Shared.Common.Util.String (f') +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.ContextLenses () + +folderName = "project-files" + +retrieveFile :: U.UUID -> U.UUID -> AppContextM BS.ByteString +retrieveFile projectUuid fileUuid = createGetObjectFn (f' "%s/%s/%s" [folderName, U.toString projectUuid, U.toString fileUuid]) + +retrieveFileConduitAction :: U.UUID -> U.UUID -> AppContextM (Minio (C.ConduitM () BS.ByteString Minio ())) +retrieveFileConduitAction projectUuid fileUuid = createGetObjectConduitActionFn (f' "%s/%s/%s" [folderName, U.toString projectUuid, U.toString fileUuid]) + +putFile :: U.UUID -> U.UUID -> String -> BS.ByteString -> AppContextM String +putFile projectUuid fileUuid contentType = createPutObjectFn (f' "%s/%s/%s" [folderName, U.toString projectUuid, U.toString fileUuid]) (Just contentType) Nothing + +putFileConduit :: U.UUID -> U.UUID -> String -> String -> Minio (C.ConduitM () BS.ByteString Minio ()) -> AppContextM String +putFileConduit projectUuid fileUuid contentType contentDisposition = createPutObjectConduitFn (f' "%s/%s/%s" [folderName, U.toString projectUuid, U.toString fileUuid]) (Just contentType) (Just contentDisposition) + +presignGetFileUrl :: U.UUID -> U.UUID -> Int -> AppContextM String +presignGetFileUrl projectUuid fileUuid = createPresignedGetObjectUrl (f' "%s/%s/%s" [folderName, U.toString projectUuid, U.toString fileUuid]) + +removeFiles :: U.UUID -> AppContextM () +removeFiles projectUuid = createRemoveObjectFn (f' "%s/%s" [folderName, U.toString projectUuid]) + +removeFile :: U.UUID -> U.UUID -> AppContextM () +removeFile projectUuid fileUuid = createRemoveObjectFn (f' "%s/%s/%s" [folderName, U.toString projectUuid, U.toString fileUuid]) + +makeBucket :: AppContextM () +makeBucket = createMakeBucketFn + +purgeBucket :: AppContextM () +purgeBucket = createPurgeBucketFn + +removeBucket :: AppContextM () +removeBucket = createRemoveBucketFn diff --git a/wizard-server/src/Wizard/S3/Questionnaire/QuestionnaireFileS3.hs b/wizard-server/src/Wizard/S3/Questionnaire/QuestionnaireFileS3.hs deleted file mode 100644 index 42c8ba0cf..000000000 --- a/wizard-server/src/Wizard/S3/Questionnaire/QuestionnaireFileS3.hs +++ /dev/null @@ -1,43 +0,0 @@ -module Wizard.S3.Questionnaire.QuestionnaireFileS3 where - -import qualified Data.ByteString.Char8 as BS -import qualified Data.Conduit as C -import qualified Data.UUID as U -import Network.Minio - -import Shared.Common.S3.Common -import Shared.Common.Util.String (f') -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.ContextLenses () - -folderName = "questionnaire-files" - -retrieveFile :: U.UUID -> U.UUID -> AppContextM BS.ByteString -retrieveFile questionnaireUuid fileUuid = createGetObjectFn (f' "%s/%s/%s" [folderName, U.toString questionnaireUuid, U.toString fileUuid]) - -retrieveFileConduitAction :: U.UUID -> U.UUID -> AppContextM (Minio (C.ConduitM () BS.ByteString Minio ())) -retrieveFileConduitAction questionnaireUuid fileUuid = createGetObjectConduitActionFn (f' "%s/%s/%s" [folderName, U.toString questionnaireUuid, U.toString fileUuid]) - -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) - -presignGetFileUrl :: U.UUID -> U.UUID -> Int -> AppContextM String -presignGetFileUrl questionnaireUuid fileUuid = createPresignedGetObjectUrl (f' "%s/%s/%s" [folderName, U.toString questionnaireUuid, U.toString fileUuid]) - -removeFiles :: U.UUID -> AppContextM () -removeFiles questionnaireUuid = createRemoveObjectFn (f' "%s/%s" [folderName, U.toString questionnaireUuid]) - -removeFile :: U.UUID -> U.UUID -> AppContextM () -removeFile questionnaireUuid fileUuid = createRemoveObjectFn (f' "%s/%s/%s" [folderName, U.toString questionnaireUuid, U.toString fileUuid]) - -makeBucket :: AppContextM () -makeBucket = createMakeBucketFn - -purgeBucket :: AppContextM () -purgeBucket = createPurgeBucketFn - -removeBucket :: AppContextM () -removeBucket = createRemoveBucketFn diff --git a/wizard-server/src/Wizard/Service/Config/Client/ClientConfigMapper.hs b/wizard-server/src/Wizard/Service/Config/Client/ClientConfigMapper.hs index 485c51a12..842d94176 100644 --- a/wizard-server/src/Wizard/Service/Config/Client/ClientConfigMapper.hs +++ b/wizard-server/src/Wizard/Service/Config/Client/ClientConfigMapper.hs @@ -11,8 +11,8 @@ import Wizard.Model.Tenant.Tenant import Wizard.Model.User.UserProfile import WizardLib.Public.Model.Tenant.Config.TenantConfig -toClientConfigDTO :: ServerConfig -> TenantConfigOrganization -> TenantConfigAuthentication -> TenantConfigPrivacyAndSupport -> TenantConfigDashboardAndLoginScreen -> TenantConfigLookAndFeel -> TenantConfigRegistry -> TenantConfigQuestionnaire -> TenantConfigSubmission -> TenantConfigFeatures -> TenantConfigOwl -> Maybe UserProfile -> [String] -> Tenant -> ClientConfigDTO -toClientConfigDTO serverConfig tcOrganization tcAuthentication tcPrivacyAndSupport tcDashboardAndLoginScreen tcLookAndFeel tcRegistry tcQuestionnaire tcSubmission tcFeatures tcOwl mUserProfile tours tenant = +toClientConfigDTO :: ServerConfig -> TenantConfigOrganization -> TenantConfigAuthentication -> TenantConfigPrivacyAndSupport -> TenantConfigDashboardAndLoginScreen -> TenantConfigLookAndFeel -> TenantConfigRegistry -> TenantConfigProject -> TenantConfigSubmission -> TenantConfigFeatures -> TenantConfigOwl -> Maybe UserProfile -> [String] -> Tenant -> ClientConfigDTO +toClientConfigDTO serverConfig tcOrganization tcAuthentication tcPrivacyAndSupport tcDashboardAndLoginScreen tcLookAndFeel tcRegistry tcProject tcSubmission tcFeatures tcOwl mUserProfile tours tenant = ClientConfigDTO { user = mUserProfile , tours = tours @@ -22,7 +22,7 @@ toClientConfigDTO serverConfig tcOrganization tcAuthentication tcPrivacyAndSuppo , dashboardAndLoginScreen = tcDashboardAndLoginScreen , lookAndFeel = tcLookAndFeel , registry = toClientConfigRegistryDTO serverConfig.registry tcRegistry - , questionnaire = toClientConfigQuestionnaireDTO tcQuestionnaire + , project = toClientConfigProjectDTO tcProject , submission = SimpleFeature $ tcSubmission.enabled , cloud = toClientConfigCloudDTO serverConfig.cloud tenant , owl = tcOwl @@ -87,12 +87,12 @@ toClientConfigRegistryDTO serverConfig tenantConfig = , url = serverConfig.clientUrl } -toClientConfigQuestionnaireDTO :: TenantConfigQuestionnaire -> ClientConfigQuestionnaireDTO -toClientConfigQuestionnaireDTO tenantConfig = - ClientConfigQuestionnaireDTO - { questionnaireVisibility = tenantConfig.questionnaireVisibility - , questionnaireSharing = tenantConfig.questionnaireSharing - , questionnaireCreation = tenantConfig.questionnaireCreation +toClientConfigProjectDTO :: TenantConfigProject -> ClientConfigProjectDTO +toClientConfigProjectDTO tenantConfig = + ClientConfigProjectDTO + { projectVisibility = tenantConfig.projectVisibility + , projectSharing = tenantConfig.projectSharing + , projectCreation = tenantConfig.projectCreation , projectTagging = SimpleFeature $ tenantConfig.projectTagging.enabled , summaryReport = tenantConfig.summaryReport , feedback = SimpleFeature $ tenantConfig.feedback.enabled diff --git a/wizard-server/src/Wizard/Service/Config/Client/ClientConfigService.hs b/wizard-server/src/Wizard/Service/Config/Client/ClientConfigService.hs index 60900997a..eaacb8ea9 100644 --- a/wizard-server/src/Wizard/Service/Config/Client/ClientConfigService.hs +++ b/wizard-server/src/Wizard/Service/Config/Client/ClientConfigService.hs @@ -14,7 +14,7 @@ import Wizard.Database.DAO.Tenant.Config.TenantConfigDashboardAndLoginScreenDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigOrganizationDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigOwlDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigPrivacyAndSupportDAO -import Wizard.Database.DAO.Tenant.Config.TenantConfigQuestionnaireDAO +import Wizard.Database.DAO.Tenant.Config.TenantConfigProjectDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigSubmissionDAO import Wizard.Database.DAO.Tenant.TenantDAO import Wizard.Database.DAO.User.UserGroupMembershipDAO @@ -51,7 +51,7 @@ getClientConfig mServerUrl mClientUrl = do return $ HousekeepingInProgressClientConfigDTO {message = "We’re currently upgrading the data to the latest version to enhance your experience"} ReadyForUseTenantState -> do throwErrorIfTenantIsDisabled mServerUrl tenant - (tcOrganization, tcAuthentication, tcPrivacyAndSupport, tcDashboardAndLoginScreen, tcLookAndFeel, tcRegistry, tcQuestionnaire, tcSubmission, tcFeatures, tcOwl) <- + (tcOrganization, tcAuthentication, tcPrivacyAndSupport, tcDashboardAndLoginScreen, tcLookAndFeel, tcRegistry, tcProject, tcSubmission, tcFeatures, tcOwl) <- case (serverConfig.cloud.enabled, mClientUrl) of (True, Just _) -> do tcOrganization <- findTenantConfigOrganizationByUuid tenant.uuid @@ -60,11 +60,11 @@ getClientConfig mServerUrl mClientUrl = do tcDashboardAndLoginScreen <- findTenantConfigDashboardAndLoginScreenByUuid tenant.uuid tcLookAndFeel <- findTenantConfigLookAndFeelByUuid tenant.uuid tcRegistry <- getTenantConfigRegistryByUuid tenant.uuid - tcQuestionnaire <- findTenantConfigQuestionnaireByUuid tenant.uuid + tcProject <- findTenantConfigProjectByUuid tenant.uuid tcSubmission <- findTenantConfigSubmissionByUuid tenant.uuid tcFeatures <- findTenantConfigFeaturesByUuid tenant.uuid tcOwl <- findTenantConfigOwlByUuid tenant.uuid - return (tcOrganization, tcAuthentication, tcPrivacyAndSupport, tcDashboardAndLoginScreen, tcLookAndFeel, tcRegistry, tcQuestionnaire, tcSubmission, tcFeatures, tcOwl) + return (tcOrganization, tcAuthentication, tcPrivacyAndSupport, tcDashboardAndLoginScreen, tcLookAndFeel, tcRegistry, tcProject, tcSubmission, tcFeatures, tcOwl) _ -> do tcOrganization <- findTenantConfigOrganization tcAuthentication <- getCurrentTenantConfigAuthentication @@ -72,11 +72,11 @@ getClientConfig mServerUrl mClientUrl = do tcDashboardAndLoginScreen <- findTenantConfigDashboardAndLoginScreen tcLookAndFeel <- findTenantConfigLookAndFeel tcRegistry <- getCurrentTenantConfigRegistry - tcQuestionnaire <- getCurrentTenantConfigQuestionnaire + tcProject <- getCurrentTenantConfigProject tcSubmission <- findTenantConfigSubmission tcFeatures <- findTenantConfigFeatures tcOwl <- findTenantConfigOwl - return (tcOrganization, tcAuthentication, tcPrivacyAndSupport, tcDashboardAndLoginScreen, tcLookAndFeel, tcRegistry, tcQuestionnaire, tcSubmission, tcFeatures, tcOwl) + return (tcOrganization, tcAuthentication, tcPrivacyAndSupport, tcDashboardAndLoginScreen, tcLookAndFeel, tcRegistry, tcProject, tcSubmission, tcFeatures, tcOwl) mUserProfile <- case mCurrentUser of Just currentUser -> do @@ -87,7 +87,7 @@ getClientConfig mServerUrl mClientUrl = do case mCurrentUser of Just currentUser -> findUserToursByUserUuid currentUser.uuid _ -> return [] - return $ toClientConfigDTO serverConfig tcOrganization tcAuthentication tcPrivacyAndSupport tcDashboardAndLoginScreen tcLookAndFeel tcRegistry tcQuestionnaire tcSubmission tcFeatures tcOwl mUserProfile tours tenant + return $ toClientConfigDTO serverConfig tcOrganization tcAuthentication tcPrivacyAndSupport tcDashboardAndLoginScreen tcLookAndFeel tcRegistry tcProject tcSubmission tcFeatures tcOwl mUserProfile tours tenant throwErrorIfTenantIsDisabled :: Maybe String -> Tenant -> AppContextM () throwErrorIfTenantIsDisabled mServerUrl tenant = unless tenant.enabled (throwError . NotExistsError $ _ERROR_VALIDATION__TENANT_OR_ACTIVE_PLAN_ABSENCE (fromMaybe "not-provided" mServerUrl)) diff --git a/wizard-server/src/Wizard/Service/Dev/DevOperationDefinitions.hs b/wizard-server/src/Wizard/Service/Dev/DevOperationDefinitions.hs index df33b6860..fcdc1776f 100644 --- a/wizard-server/src/Wizard/Service/Dev/DevOperationDefinitions.hs +++ b/wizard-server/src/Wizard/Service/Dev/DevOperationDefinitions.hs @@ -20,9 +20,9 @@ import Wizard.Service.KnowledgeModel.Editor.Event.EditorEventService import Wizard.Service.KnowledgeModel.Metamodel.MigrationService import Wizard.Service.Owl.OwlService import Wizard.Service.PersistentCommand.PersistentCommandService -import Wizard.Service.Questionnaire.Comment.QuestionnaireCommentService -import Wizard.Service.Questionnaire.Event.QuestionnaireEventService -import Wizard.Service.Questionnaire.QuestionnaireService +import Wizard.Service.Project.Comment.ProjectCommentService +import Wizard.Service.Project.Event.ProjectEventService +import Wizard.Service.Project.ProjectService import Wizard.Service.Registry.RegistryService import Wizard.Service.UserToken.ApiKey.ApiKeyService import WizardLib.Public.Service.TemporaryFile.TemporaryFileService @@ -39,8 +39,8 @@ sections = , metamodelMigrator , owl , persistentCommand + , project , registry - , questionnaire , temporaryFile , user ] @@ -387,145 +387,145 @@ persistentCommand_run = } -- --------------------------------------------------------------------------------------------------------------------- --- REGISTRY +-- PROJECT -- --------------------------------------------------------------------------------------------------------------------- -registry :: DevSection AppContextM -registry = +project :: DevSection AppContextM +project = DevSection - { name = "Registry" + { name = "Project" , description = Nothing - , operations = [registry_syncWithRegistry, registry_pushKnowledgeModelBundle, registry_pushDocumentTemplateBundle, registry_pushLocaleBundle] + , operations = + [ project_cleanProjects + , project_squashAllEvents + , project_squashEventsForProject + , project_sendNotificationToNewAssignees + ] } -- --------------------------------------------------------------------------------------------------------------------- -registry_syncWithRegistry :: DevOperation AppContextM -registry_syncWithRegistry = +project_cleanProjects :: DevOperation AppContextM +project_cleanProjects = DevOperation - { name = "Sync with registry" + { name = "Clean Projects" , description = Nothing , parameters = [] , function = \reqDto -> do - synchronizeData + cleanProjects return "Done" } -- --------------------------------------------------------------------------------------------------------------------- -registry_pushKnowledgeModelBundle :: DevOperation AppContextM -registry_pushKnowledgeModelBundle = +project_squashAllEvents :: DevOperation AppContextM +project_squashAllEvents = DevOperation - { name = "Push Knowledge model Bundle" + { name = "Squash All Events" , description = Nothing - , parameters = - [ DevOperationParameter - { name = "id" - , aType = StringDevOperationParameterType - } - ] + , parameters = [] , function = \reqDto -> do - pushKnowledgeModelBundle (head reqDto.parameters) + squashProjectEvents return "Done" } -- --------------------------------------------------------------------------------------------------------------------- -registry_pushDocumentTemplateBundle :: DevOperation AppContextM -registry_pushDocumentTemplateBundle = +project_squashEventsForProject :: DevOperation AppContextM +project_squashEventsForProject = DevOperation - { name = "Push Document Template Bundle" + { name = "Squash Events for Project" , description = Nothing , parameters = [ DevOperationParameter - { name = "id" + { name = "projectUuid" , aType = StringDevOperationParameterType } ] , function = \reqDto -> do - pushDocumentTemplateBundle (head reqDto.parameters) + squashProjectEventsForProject (u' . head $ reqDto.parameters) return "Done" } -- --------------------------------------------------------------------------------------------------------------------- -registry_pushLocaleBundle :: DevOperation AppContextM -registry_pushLocaleBundle = +project_sendNotificationToNewAssignees :: DevOperation AppContextM +project_sendNotificationToNewAssignees = DevOperation - { name = "Push Locale Bundle" + { name = "Send Notification to New Assignees" , description = Nothing - , parameters = - [ DevOperationParameter - { name = "id" - , aType = StringDevOperationParameterType - } - ] + , parameters = [] , function = \reqDto -> do - pushLocaleBundle (head reqDto.parameters) + sendNotificationToNewAssignees return "Done" } -- --------------------------------------------------------------------------------------------------------------------- --- QUESTIONNAIRE +-- REGISTRY -- --------------------------------------------------------------------------------------------------------------------- -questionnaire :: DevSection AppContextM -questionnaire = +registry :: DevSection AppContextM +registry = DevSection - { name = "Questionnaire" + { name = "Registry" , description = Nothing - , operations = - [ questionnaire_cleanQuestionnaires - , questionnaire_squashAllEvents - , questionnaire_squashEventsForQuestionnaire - , questionnaire_sendNotificationToNewAssignees - ] + , operations = [registry_syncWithRegistry, registry_pushKnowledgeModelBundle, registry_pushDocumentTemplateBundle, registry_pushLocaleBundle] } -- --------------------------------------------------------------------------------------------------------------------- -questionnaire_cleanQuestionnaires :: DevOperation AppContextM -questionnaire_cleanQuestionnaires = +registry_syncWithRegistry :: DevOperation AppContextM +registry_syncWithRegistry = DevOperation - { name = "Clean Questionnaires" + { name = "Sync with registry" , description = Nothing , parameters = [] , function = \reqDto -> do - cleanQuestionnaires + synchronizeData return "Done" } -- --------------------------------------------------------------------------------------------------------------------- -questionnaire_squashAllEvents :: DevOperation AppContextM -questionnaire_squashAllEvents = +registry_pushKnowledgeModelBundle :: DevOperation AppContextM +registry_pushKnowledgeModelBundle = DevOperation - { name = "Squash All Events" + { name = "Push Knowledge model Bundle" , description = Nothing - , parameters = [] + , parameters = + [ DevOperationParameter + { name = "id" + , aType = StringDevOperationParameterType + } + ] , function = \reqDto -> do - squashQuestionnaireEvents + pushKnowledgeModelBundle (head reqDto.parameters) return "Done" } -- --------------------------------------------------------------------------------------------------------------------- -questionnaire_squashEventsForQuestionnaire :: DevOperation AppContextM -questionnaire_squashEventsForQuestionnaire = +registry_pushDocumentTemplateBundle :: DevOperation AppContextM +registry_pushDocumentTemplateBundle = DevOperation - { name = "Squash Events for Questionnaire" + { name = "Push Document Template Bundle" , description = Nothing , parameters = [ DevOperationParameter - { name = "questionnaireUuid" + { name = "id" , aType = StringDevOperationParameterType } ] , function = \reqDto -> do - squashQuestionnaireEventsForQuestionnaire (u' . head $ reqDto.parameters) + pushDocumentTemplateBundle (head reqDto.parameters) return "Done" } -- --------------------------------------------------------------------------------------------------------------------- -questionnaire_sendNotificationToNewAssignees :: DevOperation AppContextM -questionnaire_sendNotificationToNewAssignees = +registry_pushLocaleBundle :: DevOperation AppContextM +registry_pushLocaleBundle = DevOperation - { name = "Send Notification to New Assignees" + { name = "Push Locale Bundle" , description = Nothing - , parameters = [] + , parameters = + [ DevOperationParameter + { name = "id" + , aType = StringDevOperationParameterType + } + ] , function = \reqDto -> do - sendNotificationToNewAssignees + pushLocaleBundle (head reqDto.parameters) return "Done" } diff --git a/wizard-server/src/Wizard/Service/Document/Context/DocumentContextMapper.hs b/wizard-server/src/Wizard/Service/Document/Context/DocumentContextMapper.hs index 638193a60..53abad31f 100644 --- a/wizard-server/src/Wizard/Service/Document/Context/DocumentContextMapper.hs +++ b/wizard-server/src/Wizard/Service/Document/Context/DocumentContextMapper.hs @@ -9,11 +9,11 @@ import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackage import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSimpleDTO import Wizard.Model.Document.Document import Wizard.Model.Document.DocumentContext -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireFileSimple -import Wizard.Model.Questionnaire.QuestionnaireReply -import Wizard.Model.Questionnaire.QuestionnaireVersion -import Wizard.Model.Questionnaire.QuestionnaireVersionList +import Wizard.Model.Project.File.ProjectFileSimple +import Wizard.Model.Project.Project +import Wizard.Model.Project.ProjectReply +import Wizard.Model.Project.Version.ProjectVersion +import Wizard.Model.Project.Version.ProjectVersionList import Wizard.Model.Report.Report import Wizard.Model.Tenant.Config.TenantConfig import Wizard.Model.User.User @@ -23,13 +23,13 @@ import qualified Wizard.Service.User.UserMapper as USR_Mapper toDocumentContext :: Document -> String - -> Questionnaire + -> Project -> Maybe U.UUID -> M.Map String Reply -> M.Map String [U.UUID] - -> Maybe QuestionnaireVersion - -> [QuestionnaireVersionList] - -> [QuestionnaireFileSimple] + -> Maybe ProjectVersion + -> [ProjectVersionList] + -> [ProjectFileSimple] -> KnowledgeModel -> Report -> KnowledgeModelPackage @@ -39,7 +39,7 @@ toDocumentContext -> [DocumentContextUserPerm] -> [DocumentContextUserGroupPerm] -> DocumentContext -toDocumentContext doc appClientUrl qtn phaseUuid replies labels mQtnVersion qtnVersionDtos qtnFiles km report pkg org mQtnCreatedBy mDocCreatedBy users groups = +toDocumentContext doc appClientUrl project phaseUuid replies labels mProjectVersion projectVersionDtos projectFiles km report pkg org mProjectCreatedBy mDocCreatedBy users groups = DocumentContext { config = DocumentContextConfig {clientUrl = appClientUrl} , document = @@ -51,21 +51,21 @@ toDocumentContext doc appClientUrl qtn phaseUuid replies labels mQtnVersion qtnV , createdBy = USR_Mapper.toDTO <$> mDocCreatedBy , createdAt = doc.createdAt } - , questionnaire = + , project = DocumentContextQuestionnaire - { uuid = qtn.uuid - , name = qtn.name - , description = qtn.description + { uuid = project.uuid + , name = project.name + , description = project.description , replies = replies , phaseUuid = phaseUuid , labels = labels - , versionUuid = fmap (.uuid) mQtnVersion - , versions = qtnVersionDtos - , projectTags = qtn.projectTags - , files = qtnFiles - , createdBy = USR_Mapper.toDTO <$> mQtnCreatedBy - , createdAt = qtn.createdAt - , updatedAt = qtn.updatedAt + , versionUuid = fmap (.uuid) mProjectVersion + , versions = projectVersionDtos + , projectTags = project.projectTags + , files = projectFiles + , createdBy = USR_Mapper.toDTO <$> mProjectCreatedBy + , createdAt = project.createdAt + , updatedAt = project.updatedAt } , knowledgeModel = km , report = report diff --git a/wizard-server/src/Wizard/Service/Document/Context/DocumentContextService.hs b/wizard-server/src/Wizard/Service/Document/Context/DocumentContextService.hs index 8a2423be2..f712262a5 100644 --- a/wizard-server/src/Wizard/Service/Document/Context/DocumentContextService.hs +++ b/wizard-server/src/Wizard/Service/Document/Context/DocumentContextService.hs @@ -13,24 +13,24 @@ import Shared.Common.Model.Common.Lens import Shared.Common.Util.List import Shared.KnowledgeModel.Model.KnowledgeModel.Event.KnowledgeModelEvent import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackage -import Wizard.Database.DAO.Questionnaire.QuestionnaireEventDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireFileDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireVersionDAO +import Wizard.Database.DAO.Project.ProjectEventDAO +import Wizard.Database.DAO.Project.ProjectFileDAO +import Wizard.Database.DAO.Project.ProjectVersionDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigOrganizationDAO import Wizard.Database.DAO.User.UserDAO import Wizard.Model.Context.AppContext import Wizard.Model.Document.Document import Wizard.Model.Document.DocumentContext import Wizard.Model.Document.DocumentContextJM () -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireContent -import Wizard.Model.Questionnaire.QuestionnaireEventListLenses () -import Wizard.Model.Questionnaire.QuestionnairePerm -import Wizard.Model.Questionnaire.QuestionnaireReply -import Wizard.Model.Questionnaire.QuestionnaireVersion +import Wizard.Model.Project.Acl.ProjectPerm +import Wizard.Model.Project.Event.ProjectEventListLenses () +import Wizard.Model.Project.Project +import Wizard.Model.Project.ProjectContent +import Wizard.Model.Project.ProjectReply +import Wizard.Model.Project.Version.ProjectVersion import Wizard.Service.Document.Context.DocumentContextMapper import Wizard.Service.KnowledgeModel.KnowledgeModelService -import Wizard.Service.Questionnaire.Compiler.CompilerService +import Wizard.Service.Project.Compiler.ProjectCompilerService import Wizard.Service.Report.ReportGenerator import Wizard.Service.Tenant.TenantHelper import qualified Wizard.Service.User.UserMapper as USR_Mapper @@ -38,10 +38,10 @@ import WizardLib.Public.Database.DAO.User.UserGroupDAO import WizardLib.Public.Model.User.UserGroup import qualified WizardLib.Public.Service.User.Group.UserGroupMapper as UGR_Mapper -createDocumentContext :: Document -> KnowledgeModelPackage -> [KnowledgeModelEvent] -> Questionnaire -> Maybe (M.Map String Reply) -> AppContextM DocumentContext -createDocumentContext doc pkg kmEditorEvents qtn mReplies = do - km <- compileKnowledgeModelWithCaching' kmEditorEvents (Just qtn.knowledgeModelPackageId) qtn.selectedQuestionTagUuids (not . null $ kmEditorEvents) - mQtnCreatedBy <- forM qtn.creatorUuid findUserByUuid +createDocumentContext :: Document -> KnowledgeModelPackage -> [KnowledgeModelEvent] -> Project -> Maybe (M.Map String Reply) -> AppContextM DocumentContext +createDocumentContext doc pkg kmEditorEvents project mReplies = do + km <- compileKnowledgeModelWithCaching' kmEditorEvents (Just project.knowledgeModelPackageId) project.selectedQuestionTagUuids (not . null $ kmEditorEvents) + mProjectCreatedBy <- forM project.creatorUuid findUserByUuid mDocCreatedBy <- forM doc.createdBy findUserByUuid tcOrganization <- findTenantConfigOrganization clientUrl <- getClientUrl @@ -50,40 +50,40 @@ createDocumentContext doc pkg kmEditorEvents qtn mReplies = do case mReplies of Just replies -> return (Nothing, replies, M.empty) _ -> do - qtnEvents <- findQuestionnaireEventListsByQuestionnaireUuid qtn.uuid - let filteredQtnEvents = - case doc.questionnaireEventUuid of - Just eventUuid -> takeWhileInclusive (\e -> getUuid e /= eventUuid) qtnEvents - Nothing -> qtnEvents - let qtnCtn = compileQuestionnaire filteredQtnEvents - return (qtnCtn.phaseUuid, qtnCtn.replies, qtnCtn.labels) + projectEvents <- findProjectEventListsByProjectUuid project.uuid + let filteredProjectEvents = + case doc.projectEventUuid of + Just eventUuid -> takeWhileInclusive (\e -> getUuid e /= eventUuid) projectEvents + Nothing -> projectEvents + let projectContent = compileProjectEvents filteredProjectEvents + return (projectContent.phaseUuid, projectContent.replies, projectContent.labels) report <- generateReport phaseUuid km replies - mQtnVersion <- - case doc.questionnaireEventUuid of - (Just eventUuid) -> findQuestionnaireVersionByEventUuid' qtn.uuid eventUuid + mProjectVersion <- + case doc.projectEventUuid of + (Just eventUuid) -> findProjectVersionByEventUuid' project.uuid eventUuid _ -> return Nothing - qtnVersionsList <- findQuestionnaireVersionListByQuestionnaireUuidAndCreatedAt qtn.uuid (fmap (.createdAt) mQtnVersion) - qtnFiles <- - case doc.questionnaireUuid of - Just questionnaireUuid -> findQuestionnaireFilesSimpleByQuestionnaire questionnaireUuid + projectVersionsList <- findProjectVersionListByProjectUuidAndCreatedAt project.uuid (fmap (.createdAt) mProjectVersion) + projectFiles <- + case doc.projectUuid of + Just projectUuid -> findProjectFilesSimpleByProject projectUuid Nothing -> return [] - (users, groups) <- heSettingsToPerms qtn + (users, groups) <- heSettingsToPerms project return $ toDocumentContext doc clientUrl - qtn + project phaseUuid replies labels - mQtnVersion - qtnVersionsList - qtnFiles + mProjectVersion + projectVersionsList + projectFiles km report pkg tcOrganization - mQtnCreatedBy + mProjectCreatedBy mDocCreatedBy users groups @@ -91,28 +91,28 @@ createDocumentContext doc pkg kmEditorEvents qtn mReplies = do -- -------------------------------- -- PRIVATE -- -------------------------------- -findQuestionnaireVersionUuid :: U.UUID -> [QuestionnaireVersion] -> Maybe U.UUID -findQuestionnaireVersionUuid _ [] = Nothing -findQuestionnaireVersionUuid desiredEventUuid (version : rest) +findProjectVersionUuid :: U.UUID -> [ProjectVersion] -> Maybe U.UUID +findProjectVersionUuid _ [] = Nothing +findProjectVersionUuid desiredEventUuid (version : rest) | desiredEventUuid == version.eventUuid = Just $ version.uuid - | otherwise = findQuestionnaireVersionUuid desiredEventUuid rest + | otherwise = findProjectVersionUuid desiredEventUuid rest -heSettingsToPerms :: Questionnaire -> AppContextM ([DocumentContextUserPerm], [DocumentContextUserGroupPerm]) -heSettingsToPerms qtn = do - perms <- traverse heToDocumentContextPerm qtn.permissions +heSettingsToPerms :: Project -> AppContextM ([DocumentContextUserPerm], [DocumentContextUserGroupPerm]) +heSettingsToPerms project = do + perms <- traverse heToDocumentContextPerm project.permissions return $ partitionEithers perms -heToDocumentContextPerm :: QuestionnairePerm -> AppContextM (Either DocumentContextUserPerm DocumentContextUserGroupPerm) +heToDocumentContextPerm :: ProjectPerm -> AppContextM (Either DocumentContextUserPerm DocumentContextUserGroupPerm) heToDocumentContextPerm perm = case perm.memberType of - UserQuestionnairePermType -> do + UserProjectPermType -> do user <- findUserByUuid perm.memberUuid return . Left $ DocumentContextUserPerm { user = USR_Mapper.toDTO user , perms = perm.perms } - UserGroupQuestionnairePermType -> do + UserGroupProjectPermType -> do userGroup <- findUserGroupByUuid perm.memberUuid members <- findUsersByUserGroupUuid userGroup.uuid return . Right $ diff --git a/wizard-server/src/Wizard/Service/Document/DocumentAcl.hs b/wizard-server/src/Wizard/Service/Document/DocumentAcl.hs index 0bfcf12c9..8f9e6a01c 100644 --- a/wizard-server/src/Wizard/Service/Document/DocumentAcl.hs +++ b/wizard-server/src/Wizard/Service/Document/DocumentAcl.hs @@ -5,28 +5,28 @@ import qualified Data.UUID as U import Shared.Common.Localization.Messages.Public import Shared.Common.Model.Error.Error -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO +import Wizard.Database.DAO.Project.ProjectDAO import Wizard.Model.Context.AppContext import Wizard.Model.Context.AppContextHelpers -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Service.Questionnaire.QuestionnaireAcl +import Wizard.Model.Project.Project +import Wizard.Service.Project.ProjectAcl checkViewPermissionToDoc :: Maybe U.UUID -> AppContextM () -checkViewPermissionToDoc mQtnUuid = do - case mQtnUuid of - Just qtnUuid -> do - qtn <- findQuestionnaireByUuid qtnUuid - checkViewPermissionToQtn qtn.visibility qtn.sharing qtn.permissions +checkViewPermissionToDoc mProjectUuid = do + case mProjectUuid of + Just projectUuid -> do + project <- findProjectByUuid projectUuid + checkViewPermissionToProject project.visibility project.sharing project.permissions Nothing -> throwError . ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN "Read Document" -checkViewPermissionToDoc' :: Questionnaire -> AppContextM () -checkViewPermissionToDoc' qtn = checkViewPermissionToQtn qtn.visibility qtn.sharing qtn.permissions +checkViewPermissionToDoc' :: Project -> AppContextM () +checkViewPermissionToDoc' project = checkViewPermissionToProject project.visibility project.sharing project.permissions checkEditPermissionToDoc :: Maybe U.UUID -> AppContextM () -checkEditPermissionToDoc mQtnUuid = do - case mQtnUuid of - Just qtnUuid -> do +checkEditPermissionToDoc mProjectUuid = do + case mProjectUuid of + Just projectUuid -> do _ <- getCurrentUser - qtn <- findQuestionnaireByUuid qtnUuid - checkEditPermissionToQtn qtn.visibility qtn.sharing qtn.permissions + project <- findProjectByUuid projectUuid + checkEditPermissionToProject project.visibility project.sharing project.permissions Nothing -> throwError . ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN "Edit Document" diff --git a/wizard-server/src/Wizard/Service/Document/DocumentMapper.hs b/wizard-server/src/Wizard/Service/Document/DocumentMapper.hs index dbc94a2fe..a198eaabf 100644 --- a/wizard-server/src/Wizard/Service/Document/DocumentMapper.hs +++ b/wizard-server/src/Wizard/Service/Document/DocumentMapper.hs @@ -23,10 +23,10 @@ import Wizard.Model.Document.DocumentContext import Wizard.Model.Document.DocumentContextJM () import Wizard.Model.Document.DocumentList import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditor -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireEventList -import Wizard.Model.Questionnaire.QuestionnaireEventListLenses () -import Wizard.Model.Questionnaire.QuestionnaireSimple +import Wizard.Model.Project.Event.ProjectEventList +import Wizard.Model.Project.Event.ProjectEventListLenses () +import Wizard.Model.Project.Project +import Wizard.Model.Project.ProjectSimple import Wizard.Model.Submission.SubmissionList toDTO :: DocumentList -> [SubmissionList] -> DocumentDTO @@ -35,9 +35,9 @@ toDTO doc submissions = { uuid = doc.uuid , name = doc.name , state = doc.state - , questionnaire = Just QuestionnaireSimple {uuid = doc.questionnaireUuid, name = doc.questionnaireName} - , questionnaireEventUuid = doc.questionnaireEventUuid - , questionnaireVersion = doc.questionnaireVersion + , project = Just ProjectSimple {uuid = doc.projectUuid, name = doc.projectName} + , projectEventUuid = doc.projectEventUuid + , projectVersion = doc.projectVersion , documentTemplateId = doc.documentTemplateId , documentTemplateName = doc.documentTemplateName , format = L.find (\f -> f.uuid == doc.formatUuid) $ doc.documentTemplateFormats @@ -51,15 +51,15 @@ toDTO doc submissions = , createdAt = doc.createdAt } -toDTOWithDocTemplate :: Document -> Questionnaire -> Maybe String -> [SubmissionList] -> DocumentTemplate -> DocumentTemplateFormatSimple -> DocumentDTO -toDTOWithDocTemplate doc qtn mQtnVersion submissions tml format = +toDTOWithDocTemplate :: Document -> Project -> Maybe String -> [SubmissionList] -> DocumentTemplate -> DocumentTemplateFormatSimple -> DocumentDTO +toDTOWithDocTemplate doc project mProjectVersion submissions tml format = DocumentDTO { uuid = doc.uuid , name = doc.name , state = doc.state - , questionnaire = Just $ QuestionnaireSimple {uuid = qtn.uuid, name = qtn.name} - , questionnaireEventUuid = doc.questionnaireEventUuid - , questionnaireVersion = mQtnVersion + , project = Just $ ProjectSimple {uuid = project.uuid, name = project.name} + , projectEventUuid = doc.projectEventUuid + , projectVersion = mProjectVersion , documentTemplateId = tml.tId , documentTemplateName = tml.name , format = Just format @@ -73,19 +73,19 @@ toDTOWithDocTemplate doc qtn mQtnVersion submissions tml format = , createdAt = doc.createdAt } -fromCreateDTO :: DocumentCreateDTO -> U.UUID -> Int -> [QuestionnaireEventList] -> Maybe UserDTO -> U.UUID -> UTCTime -> Document -fromCreateDTO dto docUuid repliesHash qtnEvents mCurrentUser tenantUuid now = +fromCreateDTO :: DocumentCreateDTO -> U.UUID -> Int -> [ProjectEventList] -> Maybe UserDTO -> U.UUID -> UTCTime -> Document +fromCreateDTO dto docUuid repliesHash projectEvents mCurrentUser tenantUuid now = Document { uuid = docUuid , name = trim dto.name , state = QueuedDocumentState , durability = PersistentDocumentDurability - , questionnaireUuid = Just dto.questionnaireUuid - , questionnaireEventUuid = - case dto.questionnaireEventUuid of - Just questionnaireEventUuid -> Just questionnaireEventUuid - Nothing -> fmap getUuid (lastSafe qtnEvents) - , questionnaireRepliesHash = repliesHash + , projectUuid = Just dto.projectUuid + , projectEventUuid = + case dto.projectEventUuid of + Just projectEventUuid -> Just projectEventUuid + Nothing -> fmap getUuid (lastSafe projectEvents) + , projectRepliesHash = repliesHash , documentTemplateId = dto.documentTemplateId , formatUuid = dto.formatUuid , createdBy = fmap (.uuid) mCurrentUser @@ -99,19 +99,19 @@ fromCreateDTO dto docUuid repliesHash qtnEvents mCurrentUser tenantUuid now = , createdAt = now } -fromTemporallyCreateDTO :: U.UUID -> Questionnaire -> Maybe U.UUID -> String -> U.UUID -> Int -> Maybe UserDTO -> U.UUID -> UTCTime -> Bool -> Document -fromTemporallyCreateDTO docUuid qtn questionnaireEventUuid documentTemplateId formatUuid repliesHash mCurrentUser tenantUuid now fromKnowledgeModelEditor = +fromTemporallyCreateDTO :: U.UUID -> Project -> Maybe U.UUID -> String -> U.UUID -> Int -> Maybe UserDTO -> U.UUID -> UTCTime -> Bool -> Document +fromTemporallyCreateDTO docUuid project projectEventUuid documentTemplateId formatUuid repliesHash mCurrentUser tenantUuid now fromKnowledgeModelEditor = Document { uuid = docUuid - , name = trim qtn.name + , name = trim project.name , state = QueuedDocumentState , durability = TemporallyDocumentDurability - , questionnaireUuid = + , projectUuid = if fromKnowledgeModelEditor then Nothing - else Just qtn.uuid - , questionnaireEventUuid = questionnaireEventUuid - , questionnaireRepliesHash = repliesHash + else Just project.uuid + , projectEventUuid = projectEventUuid + , projectRepliesHash = repliesHash , documentTemplateId = documentTemplateId , formatUuid = formatUuid , createdBy = fmap (.uuid) mCurrentUser @@ -146,14 +146,14 @@ toTemporaryPackage tenantUuid createdAt = , createdAt = createdAt } -toTemporaryQuestionnaire :: KnowledgeModelEditor -> KnowledgeModelPackage -> Maybe UserDTO -> Questionnaire -toTemporaryQuestionnaire kmEditor package mCurrentUser = - Questionnaire +toTemporaryProject :: KnowledgeModelEditor -> KnowledgeModelPackage -> Maybe UserDTO -> Project +toTemporaryProject kmEditor package mCurrentUser = + Project { uuid = kmEditor.uuid , name = kmEditor.name , description = Just kmEditor.description - , visibility = PrivateQuestionnaire - , sharing = RestrictedQuestionnaire + , visibility = PrivateProjectVisibility + , sharing = RestrictedProjectSharing , knowledgeModelPackageId = fromMaybe package.pId kmEditor.previousPackageId , selectedQuestionTagUuids = [] , projectTags = [] diff --git a/wizard-server/src/Wizard/Service/Document/DocumentService.hs b/wizard-server/src/Wizard/Service/Document/DocumentService.hs index defd41792..46963803d 100644 --- a/wizard-server/src/Wizard/Service/Document/DocumentService.hs +++ b/wizard-server/src/Wizard/Service/Document/DocumentService.hs @@ -32,9 +32,9 @@ import Wizard.Database.DAO.DocumentTemplate.DocumentTemplateDraftDataDAO import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelEditorDAO import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelEditorEventDAO import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelEditorReplyDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireEventDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireVersionDAO +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectEventDAO +import Wizard.Database.DAO.Project.ProjectVersionDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigOrganizationDAO import Wizard.Localization.Messages.Public import Wizard.Model.Context.AclContext @@ -42,11 +42,11 @@ import Wizard.Model.Context.AppContext import Wizard.Model.Context.AppContextHelpers import Wizard.Model.Document.Document import Wizard.Model.DocumentTemplate.DocumentTemplateDraftData -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireContent -import Wizard.Model.Questionnaire.QuestionnaireEventListLenses () -import Wizard.Model.Questionnaire.QuestionnaireReply -import Wizard.Model.Questionnaire.QuestionnaireVersion +import Wizard.Model.Project.Event.ProjectEventListLenses () +import Wizard.Model.Project.Project +import Wizard.Model.Project.ProjectContent +import Wizard.Model.Project.ProjectReply +import Wizard.Model.Project.Version.ProjectVersion import Wizard.Model.Tenant.Config.TenantConfig import Wizard.S3.Document.DocumentS3 import Wizard.Service.Document.Context.DocumentContextService @@ -57,66 +57,66 @@ import Wizard.Service.DocumentTemplate.DocumentTemplateService import Wizard.Service.DocumentTemplate.DocumentTemplateValidation import qualified Wizard.Service.KnowledgeModel.Editor.EditorMapper as EditorMapper import Wizard.Service.KnowledgeModel.Package.KnowledgeModelPackageService -import Wizard.Service.Questionnaire.Compiler.CompilerService -import Wizard.Service.Questionnaire.QuestionnaireAcl +import Wizard.Service.Project.Compiler.ProjectCompilerService +import Wizard.Service.Project.ProjectAcl import Wizard.Service.Tenant.Limit.LimitService import WizardLib.Public.Api.Resource.TemporaryFile.TemporaryFileDTO import qualified WizardLib.Public.Service.TemporaryFile.TemporaryFileMapper as TemporaryFileMapper import WizardLib.Public.Service.TemporaryFile.TemporaryFileService getDocumentsPageDto :: Maybe U.UUID -> Maybe String -> Maybe String -> Pageable -> [Sort] -> AppContextM (Page DocumentDTO) -getDocumentsPageDto mQuestionnaireUuid mDocumentTemplateId mQuery pageable sort = do +getDocumentsPageDto mProjectUuid mDocumentTemplateId mQuery pageable sort = do checkPermission _DOC_PERM - docPage <- findDocumentsPage mQuestionnaireUuid Nothing mDocumentTemplateId mQuery pageable sort + docPage <- findDocumentsPage mProjectUuid Nothing mDocumentTemplateId mQuery pageable sort traverse enhanceDocument docPage -getDocumentsForQtn :: U.UUID -> Maybe String -> Pageable -> [Sort] -> AppContextM (Page DocumentDTO) -getDocumentsForQtn qtnUuid mQuery pageable sort = do - qtn <- findQuestionnaireByUuid qtnUuid - checkViewPermissionToDoc' qtn - docPage <- findDocumentsPage (Just qtnUuid) (Just qtn.name) Nothing mQuery pageable sort +getDocumentsForProject :: U.UUID -> Maybe String -> Pageable -> [Sort] -> AppContextM (Page DocumentDTO) +getDocumentsForProject projectUuid mQuery pageable sort = do + project <- findProjectByUuid projectUuid + checkViewPermissionToDoc' project + docPage <- findDocumentsPage (Just projectUuid) (Just project.name) Nothing mQuery pageable sort traverse enhanceDocument docPage createDocument :: DocumentCreateDTO -> AppContextM DocumentDTO createDocument reqDto = runInTransaction $ do - checkEditPermissionToDoc (Just reqDto.questionnaireUuid) + checkEditPermissionToDoc (Just reqDto.projectUuid) checkDocumentLimit checkStorageSize 0 - qtn <- findQuestionnaireByUuid reqDto.questionnaireUuid - tml <- getDocumentTemplateByUuidAndPackageId reqDto.documentTemplateId (Just qtn.knowledgeModelPackageId) + project <- findProjectByUuid reqDto.projectUuid + tml <- getDocumentTemplateByUuidAndPackageId reqDto.documentTemplateId (Just project.knowledgeModelPackageId) format <- findDocumentTemplateFormatByDocumentTemplateIdAndUuid reqDto.documentTemplateId reqDto.formatUuid validateMetamodelVersion tml uuid <- liftIO generateUuid mCurrentUser <- asks currentUser now <- liftIO getCurrentTime - qtnEvents <- findQuestionnaireEventListsByQuestionnaireUuid qtn.uuid - let filteredQtnEvents = - case reqDto.questionnaireEventUuid of - Just eventUuid -> takeWhileInclusive (\e -> getUuid e /= eventUuid) qtnEvents - Nothing -> qtnEvents - let qtnCtn = compileQuestionnaire filteredQtnEvents + projectEvents <- findProjectEventListsByProjectUuid project.uuid + let filteredProjectEvents = + case reqDto.projectEventUuid of + Just eventUuid -> takeWhileInclusive (\e -> getUuid e /= eventUuid) projectEvents + Nothing -> projectEvents + let projectContent = compileProjectEvents filteredProjectEvents tcOrganization <- findTenantConfigOrganization - qtnVersions <- findQuestionnaireVersionsByQuestionnaireUuid qtn.uuid - let docContextHash = computeHash [] qtn qtnVersions qtnCtn.phaseUuid qtnCtn.replies tcOrganization mCurrentUser - let doc = fromCreateDTO reqDto uuid docContextHash filteredQtnEvents mCurrentUser qtn.tenantUuid now + projectVersions <- findProjectVersionsByProjectUuid project.uuid + let docContextHash = computeHash [] project projectVersions projectContent.phaseUuid projectContent.replies tcOrganization mCurrentUser + let doc = fromCreateDTO reqDto uuid docContextHash filteredProjectEvents mCurrentUser project.tenantUuid now insertDocument doc - pkg <- getPackageById qtn.knowledgeModelPackageId - publishToPersistentCommandQueue doc pkg [] qtn Nothing - return $ toDTOWithDocTemplate doc qtn Nothing [] tml format + pkg <- getPackageById project.knowledgeModelPackageId + publishToPersistentCommandQueue doc pkg [] project Nothing + return $ toDTOWithDocTemplate doc project Nothing [] tml format deleteDocument :: U.UUID -> AppContextM () deleteDocument docUuid = runInTransaction $ do doc <- findDocumentByUuid docUuid - checkEditPermissionToDoc doc.questionnaireUuid + checkEditPermissionToDoc doc.projectUuid void $ deleteDocumentByUuid docUuid downloadDocument :: U.UUID -> AppContextM TemporaryFileDTO downloadDocument docUuid = do runInTransaction $ do doc <- findDocumentByUuid docUuid - checkViewPermissionToDoc doc.questionnaireUuid + checkViewPermissionToDoc doc.projectUuid content <- retrieveDocumentContent docUuid let fileName = fromMaybe "export" doc.fileName let contentType = fromMaybe "text/plain" doc.contentType @@ -124,37 +124,37 @@ downloadDocument docUuid = do url <- createTemporaryFile fileName "application/octet-stream" mCurrentUserUuid (BSL.fromStrict content) return $ TemporaryFileMapper.toDTO url contentType -createDocumentPreviewForQtn :: U.UUID -> AppContextM (Document, TemporaryFileDTO) -createDocumentPreviewForQtn qtnUuid = +createDocumentPreviewForProject :: U.UUID -> AppContextM (Document, TemporaryFileDTO) +createDocumentPreviewForProject projectUuid = runInTransaction $ do - qtn <- findQuestionnaireByUuid qtnUuid - checkViewPermissionToQtn qtn.visibility qtn.sharing qtn.permissions - case (qtn.documentTemplateId, qtn.formatUuid) of + project <- findProjectByUuid projectUuid + checkViewPermissionToProject project.visibility project.sharing project.permissions + case (project.documentTemplateId, project.formatUuid) of (Just tmlId, Just formatUuid) -> do - tml <- getDocumentTemplateByUuidAndPackageId tmlId (Just qtn.knowledgeModelPackageId) - pkg <- getPackageById qtn.knowledgeModelPackageId - qtnEvents <- findQuestionnaireEventListsByQuestionnaireUuid qtnUuid - let questionnaireEventUuid = fmap getUuid (lastSafe qtnEvents) - let qtnCtn = compileQuestionnaire qtnEvents - qtnVersions <- findQuestionnaireVersionsByQuestionnaireUuid qtn.uuid - createDocumentPreview tml pkg [] qtn qtnVersions questionnaireEventUuid qtnCtn.phaseUuid qtnCtn.replies formatUuid False + tml <- getDocumentTemplateByUuidAndPackageId tmlId (Just project.knowledgeModelPackageId) + pkg <- getPackageById project.knowledgeModelPackageId + projectEvents <- findProjectEventListsByProjectUuid projectUuid + let projectEventUuid = fmap getUuid (lastSafe projectEvents) + let projectContent = compileProjectEvents projectEvents + projectVersions <- findProjectVersionsByProjectUuid project.uuid + createDocumentPreview tml pkg [] project projectVersions projectEventUuid projectContent.phaseUuid projectContent.replies formatUuid False _ -> throwError $ UserError _ERROR_SERVICE_DOCUMENT__TEMPLATE_OR_FORMAT_NOT_SET_UP createDocumentPreviewForDocTmlDraft :: String -> AppContextM (Document, TemporaryFileDTO) createDocumentPreviewForDocTmlDraft tmlId = runInTransaction $ do draftData <- findDraftDataById tmlId - case (draftData.questionnaireUuid, draftData.knowledgeModelEditorUuid, draftData.formatUuid) of - (Just qtnUuid, _, Just formatUuid) -> do + case (draftData.projectUuid, draftData.knowledgeModelEditorUuid, draftData.formatUuid) of + (Just projectUuid, _, Just formatUuid) -> do draft <- findDraftById tmlId - qtn <- findQuestionnaireByUuid qtnUuid - pkg <- getPackageById qtn.knowledgeModelPackageId - checkViewPermissionToQtn qtn.visibility qtn.sharing qtn.permissions - qtnEvents <- findQuestionnaireEventListsByQuestionnaireUuid qtn.uuid - let questionnaireEventUuid = fmap getUuid (lastSafe qtnEvents) - let qtnCtn = compileQuestionnaire qtnEvents - qtnVersions <- findQuestionnaireVersionsByQuestionnaireUuid qtn.uuid - createDocumentPreview draft pkg [] qtn qtnVersions questionnaireEventUuid qtnCtn.phaseUuid qtnCtn.replies formatUuid False + project <- findProjectByUuid projectUuid + pkg <- getPackageById project.knowledgeModelPackageId + checkViewPermissionToProject project.visibility project.sharing project.permissions + projectEvents <- findProjectEventListsByProjectUuid project.uuid + let projectEventUuid = fmap getUuid (lastSafe projectEvents) + let projectContent = compileProjectEvents projectEvents + projectVersions <- findProjectVersionsByProjectUuid project.uuid + createDocumentPreview draft pkg [] project projectVersions projectEventUuid projectContent.phaseUuid projectContent.replies formatUuid False (_, Just kmEditorUuid, Just formatUuid) -> do draft <- findDraftById tmlId let pkg = toTemporaryPackage draft.tenantUuid draft.createdAt @@ -165,21 +165,21 @@ createDocumentPreviewForDocTmlDraft tmlId = let replies = EditorMapper.toReplies kmEditorReplies checkPermission _KM_PERM mCurrentUser <- asks currentUser - let qtn = toTemporaryQuestionnaire editor pkg mCurrentUser - let questionnaireEventUuid = Nothing - createDocumentPreview draft pkg kmEvents qtn [] questionnaireEventUuid Nothing replies formatUuid True - _ -> throwError $ UserError _ERROR_SERVICE_DOCUMENT__QUESTIONNAIRE_OR_FORMAT_NOT_SET_UP + let project = toTemporaryProject editor pkg mCurrentUser + let projectEventUuid = Nothing + createDocumentPreview draft pkg kmEvents project [] projectEventUuid Nothing replies formatUuid True + _ -> throwError $ UserError _ERROR_SERVICE_DOCUMENT__PROJECT_OR_FORMAT_NOT_SET_UP -createDocumentPreview :: DocumentTemplate -> KnowledgeModelPackage -> [KnowledgeModelEvent] -> Questionnaire -> [QuestionnaireVersion] -> Maybe U.UUID -> Maybe U.UUID -> M.Map String Reply -> U.UUID -> Bool -> AppContextM (Document, TemporaryFileDTO) -createDocumentPreview tml pkg kmEditorEvents qtn qtnVersions questionnaireEventUuid phaseUuid replies formatUuid fromKnowledgeModelEditor = do +createDocumentPreview :: DocumentTemplate -> KnowledgeModelPackage -> [KnowledgeModelEvent] -> Project -> [ProjectVersion] -> Maybe U.UUID -> Maybe U.UUID -> M.Map String Reply -> U.UUID -> Bool -> AppContextM (Document, TemporaryFileDTO) +createDocumentPreview tml pkg kmEditorEvents project projectVersions projectEventUuid phaseUuid replies formatUuid fromKnowledgeModelEditor = do tcOrganization <- findTenantConfigOrganization mCurrentUser <- asks currentUser - let repliesHash = computeHash kmEditorEvents qtn qtnVersions phaseUuid replies tcOrganization mCurrentUser + let repliesHash = computeHash kmEditorEvents project projectVersions phaseUuid replies tcOrganization mCurrentUser logDebugI _CMP_SERVICE ("Replies hash: " ++ show repliesHash) docs <- if fromKnowledgeModelEditor - then findDocumentsForCurrentTenantFiltered [("questionnaire_replies_hash", show repliesHash), ("durability", "TemporallyDocumentDurability")] - else findDocumentsForCurrentTenantFiltered [("questionnaire_uuid", U.toString qtn.uuid), ("questionnaire_replies_hash", show repliesHash), ("durability", "TemporallyDocumentDurability")] + then findDocumentsForCurrentTenantFiltered [("project_replies_hash", show repliesHash), ("durability", "TemporallyDocumentDurability")] + else findDocumentsForCurrentTenantFiltered [("project_uuid", U.toString project.uuid), ("project_replies_hash", show repliesHash), ("durability", "TemporallyDocumentDurability")] case filter (filterAlreadyDoneDocument tml.tId formatUuid) docs of (doc : _) -> do logInfoI _CMP_SERVICE "Retrieving from cache" @@ -199,15 +199,15 @@ createDocumentPreview tml pkg kmEditorEvents qtn qtnVersions questionnaireEventU validateMetamodelVersion tml dUuid <- liftIO generateUuid now <- liftIO getCurrentTime - let doc = fromTemporallyCreateDTO dUuid qtn questionnaireEventUuid tml.tId formatUuid repliesHash mCurrentUser tcOrganization.tenantUuid now fromKnowledgeModelEditor + let doc = fromTemporallyCreateDTO dUuid project projectEventUuid tml.tId formatUuid repliesHash mCurrentUser tcOrganization.tenantUuid now fromKnowledgeModelEditor insertDocument doc let mReplies = if fromKnowledgeModelEditor then Just replies else Nothing - publishToPersistentCommandQueue doc pkg kmEditorEvents qtn mReplies + publishToPersistentCommandQueue doc pkg kmEditorEvents project mReplies return (doc, TemporaryFileMapper.emptyFileDTO) -publishToPersistentCommandQueue :: Document -> KnowledgeModelPackage -> [KnowledgeModelEvent] -> Questionnaire -> Maybe (M.Map String Reply) -> AppContextM () -publishToPersistentCommandQueue doc pkg kmEditorEvents qtn mReplies = do - docContext <- createDocumentContext doc pkg kmEditorEvents qtn mReplies +publishToPersistentCommandQueue :: Document -> KnowledgeModelPackage -> [KnowledgeModelEvent] -> Project -> Maybe (M.Map String Reply) -> AppContextM () +publishToPersistentCommandQueue doc pkg kmEditorEvents project mReplies = do + docContext <- createDocumentContext doc pkg kmEditorEvents project mReplies pUuid <- liftIO generateUuid let command = toDocPersistentCommand pUuid docContext doc insertPersistentCommand command diff --git a/wizard-server/src/Wizard/Service/Document/DocumentUtil.hs b/wizard-server/src/Wizard/Service/Document/DocumentUtil.hs index bef4efe7e..678975407 100644 --- a/wizard-server/src/Wizard/Service/Document/DocumentUtil.hs +++ b/wizard-server/src/Wizard/Service/Document/DocumentUtil.hs @@ -11,9 +11,9 @@ import Wizard.Database.DAO.Tenant.Config.TenantConfigSubmissionDAO import Wizard.Model.Context.AppContext import Wizard.Model.Document.Document import Wizard.Model.Document.DocumentList -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireReply -import Wizard.Model.Questionnaire.QuestionnaireVersion +import Wizard.Model.Project.Project +import Wizard.Model.Project.ProjectReply +import Wizard.Model.Project.Version.ProjectVersion import Wizard.Model.Tenant.Config.TenantConfig import Wizard.Service.Document.DocumentMapper import Wizard.Service.Submission.SubmissionService @@ -31,14 +31,14 @@ filterAlreadyDoneDocument :: String -> U.UUID -> Document -> Bool filterAlreadyDoneDocument documentTemplateId formatUuid doc = (doc.state == DoneDocumentState || doc.state == ErrorDocumentState) && Just doc.documentTemplateId == Just documentTemplateId && Just doc.formatUuid == Just formatUuid -computeHash :: [KnowledgeModelEvent] -> Questionnaire -> [QuestionnaireVersion] -> Maybe U.UUID -> M.Map String Reply -> TenantConfigOrganization -> Maybe UserDTO -> Int -computeHash kmEditorEvents qtn versions phaseUuid replies tcOrganization mCurrentUser = +computeHash :: [KnowledgeModelEvent] -> Project -> [ProjectVersion] -> Maybe U.UUID -> M.Map String Reply -> TenantConfigOrganization -> Maybe UserDTO -> Int +computeHash kmEditorEvents project versions phaseUuid replies tcOrganization mCurrentUser = sum [ hash kmEditorEvents - , hash qtn.name - , hash qtn.description + , hash project.name + , hash project.description , hash versions - , hash qtn.projectTags + , hash project.projectTags , maybe 0 hash phaseUuid , hash . M.toList $ replies , hash tcOrganization diff --git a/wizard-server/src/Wizard/Service/DocumentTemplate/Bundle/DocumentTemplateBundleAudit.hs b/wizard-server/src/Wizard/Service/DocumentTemplate/Bundle/DocumentTemplateBundleAudit.hs index 607c33fca..791736a08 100644 --- a/wizard-server/src/Wizard/Service/DocumentTemplate/Bundle/DocumentTemplateBundleAudit.hs +++ b/wizard-server/src/Wizard/Service/DocumentTemplate/Bundle/DocumentTemplateBundleAudit.hs @@ -5,10 +5,10 @@ import Wizard.Model.Context.AppContext import Wizard.Model.Context.ContextLenses () auditBundleExport :: String -> AppContextM () -auditBundleExport = logAudit "template_bundle" "export" +auditBundleExport = logAudit "document_template_bundle" "export" auditBundlePullFromRegistry :: String -> AppContextM () -auditBundlePullFromRegistry = logAudit "template_bundle" "pullFromRegistry" +auditBundlePullFromRegistry = logAudit "document_template_bundle" "pullFromRegistry" auditBundleImportFromFile :: String -> AppContextM () -auditBundleImportFromFile = logAudit "template_bundle" "importFromFile" +auditBundleImportFromFile = logAudit "document_template_bundle" "importFromFile" diff --git a/wizard-server/src/Wizard/Service/DocumentTemplate/DocumentTemplateValidation.hs b/wizard-server/src/Wizard/Service/DocumentTemplate/DocumentTemplateValidation.hs index 90757fd52..5249a2825 100644 --- a/wizard-server/src/Wizard/Service/DocumentTemplate/DocumentTemplateValidation.hs +++ b/wizard-server/src/Wizard/Service/DocumentTemplate/DocumentTemplateValidation.hs @@ -15,7 +15,7 @@ import Shared.DocumentTemplate.Localization.Messages.Public import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplate import Wizard.Api.Resource.DocumentTemplate.DocumentTemplateChangeDTO import Wizard.Database.DAO.Document.DocumentDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO +import Wizard.Database.DAO.Project.ProjectDAO import Wizard.Localization.Messages.Public import Wizard.Model.Context.AppContext import Wizard.Model.Context.ContextLenses () @@ -50,22 +50,22 @@ validateDocumentTemplateIdUniqueness tmlId = do validateDocumentTemplateDeletion :: String -> AppContextM () validateDocumentTemplateDeletion tmlId = do - validateUsageBySomeQuestionnaire tmlId + validateUsageBySomeProject tmlId validateUsageBySomeDocument tmlId -validateUsageBySomeQuestionnaire :: String -> AppContextM () -validateUsageBySomeQuestionnaire tmlId = do - questionnaires <- findQuestionnairesByDocumentTemplateId tmlId - case questionnaires of +validateUsageBySomeProject :: String -> AppContextM () +validateUsageBySomeProject tmlId = do + projects <- findProjectsByDocumentTemplateId tmlId + case projects of [] -> return () _ -> throwError . UserError $ - _ERROR_VALIDATION__TML_CANT_BE_DELETED_BECAUSE_IT_IS_USED_BY_SOME_OTHER_ENTITY tmlId "questionnaire" + _ERROR_VALIDATION__TML_CANT_BE_DELETED_BECAUSE_IT_IS_USED_BY_SOME_OTHER_ENTITY tmlId "project" validateUsageBySomeDocument :: String -> AppContextM () validateUsageBySomeDocument tmlId = do - questionnaires <- findDocumentsByDocumentTemplateId tmlId - case questionnaires of + projects <- findDocumentsByDocumentTemplateId tmlId + case projects of [] -> return () _ -> throwError . UserError $ diff --git a/wizard-server/src/Wizard/Service/DocumentTemplate/Draft/DocumentTemplateDraftMapper.hs b/wizard-server/src/Wizard/Service/DocumentTemplate/Draft/DocumentTemplateDraftMapper.hs index 1a8d8ed89..77de0dab9 100644 --- a/wizard-server/src/Wizard/Service/DocumentTemplate/Draft/DocumentTemplateDraftMapper.hs +++ b/wizard-server/src/Wizard/Service/DocumentTemplate/Draft/DocumentTemplateDraftMapper.hs @@ -14,7 +14,7 @@ import Wizard.Model.DocumentTemplate.DocumentTemplateDraftData import Wizard.Model.DocumentTemplate.DocumentTemplateDraftDetail import Wizard.Model.DocumentTemplate.DocumentTemplateDraftList import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditorSuggestion -import Wizard.Model.Questionnaire.QuestionnaireSuggestion +import Wizard.Model.Project.ProjectSuggestion toDraftList :: DocumentTemplate -> DocumentTemplateDraftList toDraftList tml = @@ -29,8 +29,8 @@ toDraftList tml = , updatedAt = tml.updatedAt } -toDraftDetail :: DocumentTemplate -> [DocumentTemplateFormat] -> DocumentTemplateDraftData -> Maybe QuestionnaireSuggestion -> Maybe KnowledgeModelEditorSuggestion -> DocumentTemplateDraftDetail -toDraftDetail draft formats draftData mQuestionnaire mKmEditor = +toDraftDetail :: DocumentTemplate -> [DocumentTemplateFormat] -> DocumentTemplateDraftData -> Maybe ProjectSuggestion -> Maybe KnowledgeModelEditorSuggestion -> DocumentTemplateDraftDetail +toDraftDetail draft formats draftData mProject mKmEditor = DocumentTemplateDraftDetail { tId = draft.tId , name = draft.name @@ -41,8 +41,8 @@ toDraftDetail draft formats draftData mQuestionnaire mKmEditor = , license = draft.license , allowedPackages = draft.allowedPackages , formats = formats - , questionnaireUuid = draftData.questionnaireUuid - , questionnaire = mQuestionnaire + , projectUuid = draftData.projectUuid + , project = mProject , knowledgeModelEditorUuid = draftData.knowledgeModelEditorUuid , knowledgeModelEditor = mKmEditor , formatUuid = draftData.formatUuid @@ -62,8 +62,8 @@ toDraftDetail' draft formats = , license = draft.license , allowedPackages = draft.allowedPackages , formats = formats - , questionnaireUuid = Nothing - , questionnaire = Nothing + , projectUuid = Nothing + , project = Nothing , knowledgeModelEditorUuid = Nothing , knowledgeModelEditor = Nothing , formatUuid = Nothing @@ -71,11 +71,11 @@ toDraftDetail' draft formats = , updatedAt = draft.updatedAt } -toDraftDataDTO :: DocumentTemplateDraftData -> Maybe QuestionnaireSuggestion -> Maybe KnowledgeModelEditorSuggestion -> DocumentTemplateDraftDataDTO -toDraftDataDTO draftData mQuestionnaire mKmEditor = +toDraftDataDTO :: DocumentTemplateDraftData -> Maybe ProjectSuggestion -> Maybe KnowledgeModelEditorSuggestion -> DocumentTemplateDraftDataDTO +toDraftDataDTO draftData mProject mKmEditor = DocumentTemplateDraftDataDTO - { questionnaireUuid = draftData.questionnaireUuid - , questionnaire = mQuestionnaire + { projectUuid = draftData.projectUuid + , project = mProject , knowledgeModelEditorUuid = draftData.knowledgeModelEditorUuid , knowledgeModelEditor = mKmEditor , formatUuid = draftData.formatUuid @@ -182,7 +182,7 @@ fromCreateDraftData :: DocumentTemplate -> DocumentTemplateDraftData fromCreateDraftData draft = DocumentTemplateDraftData { documentTemplateId = draft.tId - , questionnaireUuid = Nothing + , projectUuid = Nothing , knowledgeModelEditorUuid = Nothing , formatUuid = Nothing , tenantUuid = draft.tenantUuid @@ -194,7 +194,7 @@ fromDraftDataChangeDTO :: DocumentTemplateDraftData -> DocumentTemplateDraftData fromDraftDataChangeDTO draftData reqDto = DocumentTemplateDraftData { documentTemplateId = draftData.documentTemplateId - , questionnaireUuid = reqDto.questionnaireUuid + , projectUuid = reqDto.projectUuid , knowledgeModelEditorUuid = reqDto.knowledgeModelEditorUuid , formatUuid = reqDto.formatUuid , tenantUuid = draftData.tenantUuid diff --git a/wizard-server/src/Wizard/Service/DocumentTemplate/Draft/DocumentTemplateDraftService.hs b/wizard-server/src/Wizard/Service/DocumentTemplate/Draft/DocumentTemplateDraftService.hs index db5ffb233..4e7a39358 100644 --- a/wizard-server/src/Wizard/Service/DocumentTemplate/Draft/DocumentTemplateDraftService.hs +++ b/wizard-server/src/Wizard/Service/DocumentTemplate/Draft/DocumentTemplateDraftService.hs @@ -27,7 +27,7 @@ import Wizard.Database.DAO.Document.DocumentDAO import Wizard.Database.DAO.DocumentTemplate.DocumentTemplateDraftDAO import Wizard.Database.DAO.DocumentTemplate.DocumentTemplateDraftDataDAO import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelEditorDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO +import Wizard.Database.DAO.Project.ProjectDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigOrganizationDAO import Wizard.Model.Context.AclContext import Wizard.Model.Context.AppContext @@ -86,15 +86,15 @@ getDraft tmlId = do draft <- findDraftById tmlId formats <- findDocumentTemplateFormats draft.tId draftData <- findDraftDataById tmlId - mQtnSuggestion <- - case draftData.questionnaireUuid of - Just qtnUuid -> findQuestionnaireSuggestionByUuid' qtnUuid + mProjectSuggestion <- + case draftData.projectUuid of + Just projectUuid -> findProjectSuggestionByUuid' projectUuid Nothing -> return Nothing mKmEditorSuggestion <- case draftData.knowledgeModelEditorUuid of Just knowledgeModelEditorUuid -> findKnowledgeModelEditorSuggestionByUuid' knowledgeModelEditorUuid Nothing -> return Nothing - return $ toDraftDetail draft formats draftData mQtnSuggestion mKmEditorSuggestion + return $ toDraftDetail draft formats draftData mProjectSuggestion mKmEditorSuggestion modifyDraft :: String -> DocumentTemplateDraftChangeDTO -> AppContextM DocumentTemplateDraftDetail modifyDraft tmlId reqDto = @@ -138,15 +138,15 @@ modifyDraftData tmlId reqDto = draftData <- findDraftDataById tmlId let updatedDraftData = fromDraftDataChangeDTO draftData reqDto updateDraftDataById updatedDraftData - mQtnSuggestion <- - case updatedDraftData.questionnaireUuid of - Just qtnUuid -> findQuestionnaireSuggestionByUuid' qtnUuid + mProjectSuggestion <- + case updatedDraftData.projectUuid of + Just projectUuid -> findProjectSuggestionByUuid' projectUuid Nothing -> return Nothing mKmEditorSuggestion <- case draftData.knowledgeModelEditorUuid of Just knowledgeModelEditorUuid -> findKnowledgeModelEditorSuggestionByUuid' knowledgeModelEditorUuid Nothing -> return Nothing - return $ toDraftDataDTO updatedDraftData mQtnSuggestion mKmEditorSuggestion + return $ toDraftDataDTO updatedDraftData mProjectSuggestion mKmEditorSuggestion deleteDraft :: String -> AppContextM () deleteDraft tmlId = diff --git a/wizard-server/src/Wizard/Service/Feedback/FeedbackMapper.hs b/wizard-server/src/Wizard/Service/Feedback/FeedbackMapper.hs index bd7a637c6..ebc61afbf 100644 --- a/wizard-server/src/Wizard/Service/Feedback/FeedbackMapper.hs +++ b/wizard-server/src/Wizard/Service/Feedback/FeedbackMapper.hs @@ -12,12 +12,12 @@ import Wizard.Model.Feedback.Feedback import Wizard.Model.Tenant.Config.TenantConfig import Wizard.Service.Feedback.FeedbackUtil -toDTO :: ServerConfig -> TenantConfigQuestionnaire -> Feedback -> FeedbackDTO -toDTO serverConfig tcQuestionnaire f = +toDTO :: ServerConfig -> TenantConfigProject -> Feedback -> FeedbackDTO +toDTO serverConfig tcProject f = FeedbackDTO { uuid = f.uuid , issueId = f.issueId - , issueUrl = createIssueUrl serverConfig.feedback tcQuestionnaire.feedback f + , issueUrl = createIssueUrl serverConfig.feedback tcProject.feedback f , questionUuid = f.questionUuid , knowledgeModelPackageId = f.knowledgeModelPackageId , title = f.title diff --git a/wizard-server/src/Wizard/Service/Feedback/FeedbackService.hs b/wizard-server/src/Wizard/Service/Feedback/FeedbackService.hs index a96782289..ab8151f06 100644 --- a/wizard-server/src/Wizard/Service/Feedback/FeedbackService.hs +++ b/wizard-server/src/Wizard/Service/Feedback/FeedbackService.hs @@ -23,7 +23,7 @@ import Wizard.Api.Resource.Feedback.FeedbackCreateDTO import Wizard.Api.Resource.Feedback.FeedbackDTO import Wizard.Database.DAO.Common import Wizard.Database.DAO.Feedback.FeedbackDAO -import Wizard.Database.DAO.Tenant.Config.TenantConfigQuestionnaireDAO +import Wizard.Database.DAO.Tenant.Config.TenantConfigProjectDAO import Wizard.Integration.Http.GitHub.Runner import Wizard.Integration.Resource.GitHub.IssueIDTO import Wizard.Model.Context.AppContext @@ -39,8 +39,8 @@ getFeedbacksFiltered queryParams = do checkIfFeedbackIsEnabled feedbacks <- findFeedbacksFiltered queryParams serverConfig <- asks serverConfig - tcQuestionnaire <- getCurrentTenantConfigQuestionnaire - return . fmap (toDTO serverConfig tcQuestionnaire) $ feedbacks + tcProject <- getCurrentTenantConfigProject + return . fmap (toDTO serverConfig tcProject) $ feedbacks createFeedback :: FeedbackCreateDTO -> AppContextM FeedbackDTO createFeedback reqDto = @@ -59,16 +59,16 @@ createFeedbackWithGivenUuid fUuid reqDto = let feedback = fromCreateDTO reqDto fUuid issue.number tenantUuid now insertFeedback feedback serverConfig <- asks serverConfig - tcQuestionnaire <- getCurrentTenantConfigQuestionnaire - return $ toDTO serverConfig tcQuestionnaire feedback + tcProject <- getCurrentTenantConfigProject + return $ toDTO serverConfig tcProject feedback getFeedbackByUuid :: U.UUID -> AppContextM FeedbackDTO getFeedbackByUuid fUuid = do checkIfFeedbackIsEnabled feedback <- findFeedbackByUuid fUuid serverConfig <- asks serverConfig - tcQuestionnaire <- getCurrentTenantConfigQuestionnaire - return $ toDTO serverConfig tcQuestionnaire feedback + tcProject <- getCurrentTenantConfigProject + return $ toDTO serverConfig tcProject feedback synchronizeFeedbacksInAllApplications :: AppContextM () synchronizeFeedbacksInAllApplications = runFunctionForAllTenants "synchronizeFeedbacks" synchronizeFeedbacks @@ -81,8 +81,8 @@ synchronizeFeedbacks = catchError ( do runInTransaction $ do - tcQuestionnaire <- getCurrentTenantConfigQuestionnaire - if tcQuestionnaire.feedback.enabled + tcProject <- getCurrentTenantConfigProject + if tcProject.feedback.enabled then do logInfoI _CMP_WORKER "synchronizing feedback" issues <- getIssues @@ -103,4 +103,4 @@ synchronizeFeedbacks = Just issue -> updateFeedbackByUuid $ fromSimpleIssue feedback issue now Nothing -> deleteFeedbackByUuid feedback.uuid -checkIfFeedbackIsEnabled = checkIfTenantFeatureIsEnabled "Feedback" findTenantConfigQuestionnaire (.feedback.enabled) +checkIfFeedbackIsEnabled = checkIfTenantFeatureIsEnabled "Feedback" findTenantConfigProject (.feedback.enabled) diff --git a/wizard-server/src/Wizard/Service/Feedback/FeedbackUtil.hs b/wizard-server/src/Wizard/Service/Feedback/FeedbackUtil.hs index 1f8b5c31b..0618c12fa 100644 --- a/wizard-server/src/Wizard/Service/Feedback/FeedbackUtil.hs +++ b/wizard-server/src/Wizard/Service/Feedback/FeedbackUtil.hs @@ -5,6 +5,6 @@ import Wizard.Model.Config.ServerConfig import Wizard.Model.Feedback.Feedback import Wizard.Model.Tenant.Config.TenantConfig -createIssueUrl :: ServerConfigFeedback -> TenantConfigQuestionnaireFeedback -> Feedback -> String +createIssueUrl :: ServerConfigFeedback -> TenantConfigProjectFeedback -> Feedback -> String createIssueUrl serverConfig tenantConfig fbk = f' "%s/%s/%s/issues/%s" [serverConfig.webUrl, tenantConfig.owner, tenantConfig.repo, show fbk.issueId] diff --git a/wizard-server/src/Wizard/Service/KnowledgeModel/Editor/Collaboration/CollaborationMapper.hs b/wizard-server/src/Wizard/Service/KnowledgeModel/Editor/Collaboration/CollaborationMapper.hs index 85b523d82..879d752e4 100644 --- a/wizard-server/src/Wizard/Service/KnowledgeModel/Editor/Collaboration/CollaborationMapper.hs +++ b/wizard-server/src/Wizard/Service/KnowledgeModel/Editor/Collaboration/CollaborationMapper.hs @@ -6,11 +6,11 @@ import qualified Data.UUID as U import Shared.KnowledgeModel.Model.KnowledgeModel.Event.KnowledgeModelEvent import Wizard.Api.Resource.KnowledgeModel.Editor.Event.KnowledgeModelEditorWebSocketEventDTO import Wizard.Api.Resource.KnowledgeModel.Editor.Event.SetRepliesDTO -import Wizard.Api.Resource.Websocket.KnowledgeModelEditorActionDTO +import Wizard.Api.Resource.Websocket.KnowledgeModelEditorMessageDTO import Wizard.Api.Resource.Websocket.WebsocketActionDTO import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditorEvent import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditorReply -import Wizard.Model.Questionnaire.QuestionnaireReply +import Wizard.Model.Project.ProjectReply import Wizard.Model.Websocket.WebsocketMessage import Wizard.Model.Websocket.WebsocketRecord import Wizard.Util.Websocket @@ -25,19 +25,19 @@ toWebsocketMessage record content = } toSetUserListMessage - :: [WebsocketRecord] -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerKnowledgeModelEditorActionDTO) + :: [WebsocketRecord] -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerKnowledgeModelEditorMessageDTO) toSetUserListMessage records record = toWebsocketMessage record $ - Success_ServerActionDTO . SetUserList_ServerKnowledgeModelEditorActionDTO $ + Success_ServerActionDTO . SetUserList_ServerKnowledgeModelEditorMessageDTO $ getCollaborators record.connectionUuid record.entityId records -toAddKnowledgeModelEditorWebsocketMessage :: AddKnowledgeModelEditorWebSocketEventDTO -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerKnowledgeModelEditorActionDTO) +toAddKnowledgeModelEditorWebsocketMessage :: AddKnowledgeModelEditorWebSocketEventDTO -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerKnowledgeModelEditorMessageDTO) toAddKnowledgeModelEditorWebsocketMessage reqDto record = - toWebsocketMessage record $ Success_ServerActionDTO . SetContent_ServerKnowledgeModelEditorActionDTO . AddKnowledgeModelEditorWebSocketEventDTO' $ reqDto + toWebsocketMessage record $ Success_ServerActionDTO . SetContent_ServerKnowledgeModelEditorMessageDTO . AddKnowledgeModelEditorWebSocketEventDTO' $ reqDto -toSetRepliesMessage :: SetRepliesDTO -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerKnowledgeModelEditorActionDTO) +toSetRepliesMessage :: SetRepliesDTO -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerKnowledgeModelEditorMessageDTO) toSetRepliesMessage reqDto record = - toWebsocketMessage record $ Success_ServerActionDTO . SetReplies_ServerKnowledgeModelEditorActionDTO $ reqDto + toWebsocketMessage record $ Success_ServerActionDTO . SetReplies_ServerKnowledgeModelEditorMessageDTO $ reqDto fromAddKnowledgeModelEditorWebSocketEventDTO :: KnowledgeModelEvent -> U.UUID -> U.UUID -> KnowledgeModelEditorEvent fromAddKnowledgeModelEditorWebSocketEventDTO KnowledgeModelEvent {..} knowledgeModelEditorUuid tenantUuid = KnowledgeModelEditorEvent {..} diff --git a/wizard-server/src/Wizard/Service/KnowledgeModel/Editor/Collaboration/CollaborationService.hs b/wizard-server/src/Wizard/Service/KnowledgeModel/Editor/Collaboration/CollaborationService.hs index 330f8ba26..801544190 100644 --- a/wizard-server/src/Wizard/Service/KnowledgeModel/Editor/Collaboration/CollaborationService.hs +++ b/wizard-server/src/Wizard/Service/KnowledgeModel/Editor/Collaboration/CollaborationService.hs @@ -11,7 +11,7 @@ import Shared.Common.Model.Error.Error import Shared.Common.Util.Uuid import Wizard.Api.Resource.KnowledgeModel.Editor.Event.KnowledgeModelEditorWebSocketEventDTO import Wizard.Api.Resource.KnowledgeModel.Editor.Event.SetRepliesDTO -import Wizard.Api.Resource.Websocket.KnowledgeModelEditorActionJM () +import Wizard.Api.Resource.Websocket.KnowledgeModelEditorMessageJM () import Wizard.Api.Resource.Websocket.WebsocketActionJM () import Wizard.Cache.KnowledgeModelEditorWebsocketCache import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelEditorDAO diff --git a/wizard-server/src/Wizard/Service/KnowledgeModel/Editor/EditorMapper.hs b/wizard-server/src/Wizard/Service/KnowledgeModel/Editor/EditorMapper.hs index b2b912e53..c3a5d39ab 100644 --- a/wizard-server/src/Wizard/Service/KnowledgeModel/Editor/EditorMapper.hs +++ b/wizard-server/src/Wizard/Service/KnowledgeModel/Editor/EditorMapper.hs @@ -18,7 +18,7 @@ import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditorList import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditorRawEvent import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditorReply import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditorState -import Wizard.Model.Questionnaire.QuestionnaireReply +import Wizard.Model.Project.ProjectReply import Wizard.Service.KnowledgeModel.Package.KnowledgeModelPackageMapper toList :: KnowledgeModelEditor -> Maybe String -> KnowledgeModelEditorState -> KnowledgeModelEditorList diff --git a/wizard-server/src/Wizard/Service/KnowledgeModel/Editor/EditorUtil.hs b/wizard-server/src/Wizard/Service/KnowledgeModel/Editor/EditorUtil.hs index 72aa44826..7bb5be82d 100644 --- a/wizard-server/src/Wizard/Service/KnowledgeModel/Editor/EditorUtil.hs +++ b/wizard-server/src/Wizard/Service/KnowledgeModel/Editor/EditorUtil.hs @@ -42,7 +42,7 @@ getEditorMergeCheckpointPackageId editor = do getEditorState :: KnowledgeModelEditor -> Int -> Maybe String -> AppContextM KnowledgeModelEditorState getEditorState editor eventSize mForkOfPackageId = do - mMs <- findMigratorStateByEditorUuid' editor.uuid + mMs <- findKnowledgeModelMigrationByEditorUuid' editor.uuid isMigrating mMs $ isEditing $ isMigrated mMs $ isOutdated isDefault where isMigrating mMs continue = diff --git a/wizard-server/src/Wizard/Service/KnowledgeModel/KnowledgeModelService.hs b/wizard-server/src/Wizard/Service/KnowledgeModel/KnowledgeModelService.hs index 7148e3753..0d6e2ecb8 100644 --- a/wizard-server/src/Wizard/Service/KnowledgeModel/KnowledgeModelService.hs +++ b/wizard-server/src/Wizard/Service/KnowledgeModel/KnowledgeModelService.hs @@ -23,7 +23,7 @@ import Wizard.Service.KnowledgeModel.Package.KnowledgeModelPackageUtil createKnowledgeModelPreview :: KnowledgeModelChangeDTO -> AppContextM KnowledgeModel createKnowledgeModelPreview reqDto = do mResolvedPackageId <- traverse resolvePackageId reqDto.knowledgeModelPackageId - checkIfPackageIsPublic mResolvedPackageId _QTN_PERM + checkIfPackageIsPublic mResolvedPackageId _PRJ_PERM compileKnowledgeModel reqDto.events mResolvedPackageId reqDto.tagUuids compileKnowledgeModel :: [KnowledgeModelEvent] -> Maybe String -> [U.UUID] -> AppContextM KnowledgeModel diff --git a/wizard-server/src/Wizard/Service/KnowledgeModel/Migration/KnowledgeModelMigrationAudit.hs b/wizard-server/src/Wizard/Service/KnowledgeModel/Migration/KnowledgeModelMigrationAudit.hs new file mode 100644 index 000000000..de0a8f3cd --- /dev/null +++ b/wizard-server/src/Wizard/Service/KnowledgeModel/Migration/KnowledgeModelMigrationAudit.hs @@ -0,0 +1,39 @@ +module Wizard.Service.KnowledgeModel.Migration.KnowledgeModelMigrationAudit where + +import qualified Data.Map.Strict as M +import Data.Maybe +import qualified Data.UUID as U + +import Shared.Audit.Service.Audit.AuditService +import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationCreateDTO +import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationResolutionDTO +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.ContextLenses () +import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditor + +auditKmMigrationCreate :: KnowledgeModelMigrationCreateDTO -> KnowledgeModelEditor -> AppContextM () +auditKmMigrationCreate reqDto kmEditor = + logAuditWithBody + "knowledge_model_migration" + "create" + (U.toString kmEditor.uuid) + ( M.fromList + [("sourcePackageId", fromMaybe "" $ kmEditor.previousPackageId), ("targetPackageId", reqDto.targetPackageId)] + ) + +auditKmMigrationSolve :: U.UUID -> KnowledgeModelMigrationResolutionDTO -> AppContextM () +auditKmMigrationSolve editorUuid reqDto = + logAuditWithBody + "knowledge_model_migration" + "solve" + (U.toString editorUuid) + (M.fromList [("originalEventUuid", U.toString $ reqDto.originalEventUuid), ("action", show reqDto.action)]) + +auditKmMigrationApplyAll :: U.UUID -> AppContextM () +auditKmMigrationApplyAll editorUuid = logAudit "knowledge_model_migration" "applyAll" (U.toString editorUuid) + +auditKmMigrationCancel :: U.UUID -> AppContextM () +auditKmMigrationCancel editorUuid = logAudit "knowledge_model_migration" "cancel" (U.toString editorUuid) + +auditKmMigrationFinish :: U.UUID -> AppContextM () +auditKmMigrationFinish editorUuid = logAudit "knowledge_model_migration" "finish" (U.toString editorUuid) diff --git a/wizard-server/src/Wizard/Service/KnowledgeModel/Migration/KnowledgeModelMigrationMapper.hs b/wizard-server/src/Wizard/Service/KnowledgeModel/Migration/KnowledgeModelMigrationMapper.hs new file mode 100644 index 000000000..856795bda --- /dev/null +++ b/wizard-server/src/Wizard/Service/KnowledgeModel/Migration/KnowledgeModelMigrationMapper.hs @@ -0,0 +1,39 @@ +module Wizard.Service.KnowledgeModel.Migration.KnowledgeModelMigrationMapper where + +import Data.Time +import qualified Data.UUID as U + +import Shared.KnowledgeModel.Constant.KnowledgeModel +import Shared.KnowledgeModel.Model.KnowledgeModel.Event.KnowledgeModelEvent +import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel +import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackage +import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationDTO +import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditor +import Wizard.Model.KnowledgeModel.Migration.KnowledgeModelMigration + +toDTO :: KnowledgeModelMigration -> KnowledgeModelEditor -> KnowledgeModelMigrationDTO +toDTO ms kmEditor = + KnowledgeModelMigrationDTO + { editorUuid = ms.editorUuid + , editorName = kmEditor.name + , editorPreviousPackageId = ms.editorPreviousPackageId + , state = ms.state + , targetPackageId = ms.targetPackageId + , currentKnowledgeModel = ms.currentKnowledgeModel + } + +fromCreateDTO :: KnowledgeModelEditor -> KnowledgeModelPackage -> [KnowledgeModelEvent] -> String -> [KnowledgeModelEvent] -> KnowledgeModel -> U.UUID -> UTCTime -> KnowledgeModelMigration +fromCreateDTO kmEditor previousPkg editorPreviousPackageEvents targetPkgId targetPkgEvents km tenantUuid now = + KnowledgeModelMigration + { editorUuid = kmEditor.uuid + , metamodelVersion = knowledgeModelMetamodelVersion + , state = RunningKnowledgeModelMigrationState + , editorPreviousPackageId = previousPkg.pId + , targetPackageId = targetPkgId + , editorPreviousPackageEvents = editorPreviousPackageEvents + , targetPackageEvents = targetPkgEvents + , resultEvents = [] + , currentKnowledgeModel = Just km + , tenantUuid = tenantUuid + , createdAt = now + } diff --git a/wizard-server/src/Wizard/Service/KnowledgeModel/Migration/KnowledgeModelMigrationService.hs b/wizard-server/src/Wizard/Service/KnowledgeModel/Migration/KnowledgeModelMigrationService.hs new file mode 100644 index 000000000..c34b6eb6a --- /dev/null +++ b/wizard-server/src/Wizard/Service/KnowledgeModel/Migration/KnowledgeModelMigrationService.hs @@ -0,0 +1,164 @@ +module Wizard.Service.KnowledgeModel.Migration.KnowledgeModelMigrationService where + +import Control.Monad (when) +import Control.Monad.Except (throwError) +import Control.Monad.Reader (asks, liftIO) +import Data.Time +import qualified Data.UUID as U + +import Shared.Common.Model.Error.Error +import Shared.KnowledgeModel.Model.KnowledgeModel.Event.KnowledgeModelEvent +import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackage +import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationCreateDTO +import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationDTO +import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationResolutionDTO +import Wizard.Database.DAO.Common +import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelEditorDAO +import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelEditorEventDAO +import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelMigrationDAO +import Wizard.Localization.Messages.Public +import Wizard.Model.Context.AclContext +import Wizard.Model.Context.AppContext +import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditor +import Wizard.Model.KnowledgeModel.Migration.KnowledgeModelMigration +import Wizard.Service.KnowledgeModel.Editor.Collaboration.CollaborationService +import qualified Wizard.Service.KnowledgeModel.Editor.EditorMapper as EditorMapper +import Wizard.Service.KnowledgeModel.Editor.EditorUtil +import Wizard.Service.KnowledgeModel.KnowledgeModelService +import Wizard.Service.KnowledgeModel.Migration.KnowledgeModelMigrationAudit +import Wizard.Service.KnowledgeModel.Migration.KnowledgeModelMigrationMapper +import Wizard.Service.KnowledgeModel.Migration.KnowledgeModelMigrationValidation +import Wizard.Service.KnowledgeModel.Migration.Migrator.Migrator +import Wizard.Service.KnowledgeModel.Package.KnowledgeModelPackageService + +getCurrentMigrationDto :: U.UUID -> AppContextM KnowledgeModelMigrationDTO +getCurrentMigrationDto editorUuid = do + checkPermission _KM_UPGRADE_PERM + ms <- getCurrentMigration editorUuid + editor <- findKnowledgeModelEditorByUuid editorUuid + return $ toDTO ms editor + +getCurrentMigration :: U.UUID -> AppContextM KnowledgeModelMigration +getCurrentMigration editorUuid = do + ms <- findKnowledgeModelMigrationByEditorUuid editorUuid + knowledgeModel <- compileKnowledgeModel ms.resultEvents (Just ms.editorPreviousPackageId) [] + let stateWithEvent = + case ms.state of + (ConflictKnowledgeModelMigrationState Nothing) -> ConflictKnowledgeModelMigrationState . Just . head $ ms.targetPackageEvents + state -> state + return $ ms {currentKnowledgeModel = Just knowledgeModel, state = stateWithEvent} :: AppContextM KnowledgeModelMigration + +createMigration :: U.UUID -> KnowledgeModelMigrationCreateDTO -> AppContextM KnowledgeModelMigrationDTO +createMigration kmEditorUuid reqDto = + runInTransaction $ do + checkPermission _KM_UPGRADE_PERM + logOutOnlineUsersWhenKnowledgeModelEditorDramaticallyChanged kmEditorUuid + let targetPkgId = reqDto.targetPackageId + editor <- findKnowledgeModelEditorByUuid kmEditorUuid + previousPkg <- getPreviousPkg editor + mergeCheckpointPkgId <- getMergeCheckpointPackageId editor + forkOfPkgId <- getForkOfPackageId editor + validateMigrationUniqueness kmEditorUuid + validateIfTargetPackageVersionIsHigher forkOfPkgId targetPkgId + editorEvents <- getEditorEvents previousPkg.pId mergeCheckpointPkgId + targetPkgEvents <- getTargetPackageEvents targetPkgId forkOfPkgId + kmEditorEvents <- findKnowledgeModelEventsByEditorUuid kmEditorUuid + let kmEvents = fmap EditorMapper.toKnowledgeModelEvent kmEditorEvents + km <- compileKnowledgeModel kmEvents editor.previousPackageId [] + tenantUuid <- asks currentTenantUuid + now <- liftIO getCurrentTime + let ms = fromCreateDTO editor previousPkg editorEvents targetPkgId targetPkgEvents km tenantUuid now + insertKnowledgeModelMigration ms + migratedMs <- migrateState ms + auditKmMigrationCreate reqDto editor + return $ toDTO migratedMs editor + where + getEditorEvents = getAllPreviousEventsSincePackageIdAndUntilPackageId + getTargetPackageEvents = getAllPreviousEventsSincePackageIdAndUntilPackageId + getPreviousPkg editor = + case editor.previousPackageId of + Just previousPkgId -> getPackageById previousPkgId + Nothing -> throwError . UserError $ _ERROR_VALIDATION__KM_EDITOR_PREVIOUS_PKG_ABSENCE + getMergeCheckpointPackageId editor = do + mMergeCheckpointPackageId <- getEditorMergeCheckpointPackageId editor + case mMergeCheckpointPackageId of + Just mergeCheckpointPackageId -> return mergeCheckpointPackageId + Nothing -> throwError . UserError $ _ERROR_SERVICE_MIGRATION_KM__EDITOR_MISSING_MERGE_CHECKPOINT_PACKAGE_ID + getForkOfPackageId editor = do + mForkOfPackageId <- getEditorForkOfPackageId editor + case mForkOfPackageId of + Just forkOfPackageId -> return forkOfPackageId + Nothing -> throwError . UserError $ _ERROR_SERVICE_MIGRATION_KM__EDITOR_MISSING_FORK_OF_PACKAGE_ID + +deleteCurrentMigration :: U.UUID -> AppContextM () +deleteCurrentMigration editorUuid = + runInTransaction $ do + checkPermission _KM_UPGRADE_PERM + _ <- getCurrentMigration editorUuid + deleteKnowledgeModelMigrationByEditorUuid editorUuid + auditKmMigrationCancel editorUuid + return () + +solveConflictAndMigrate :: U.UUID -> KnowledgeModelMigrationResolutionDTO -> AppContextM () +solveConflictAndMigrate editorUuid reqDto = + runInTransaction $ do + checkPermission _KM_UPGRADE_PERM + ms <- getCurrentMigration editorUuid + validateMigrationState ms + validateTargetPackageEvent ms + validateReqDto ms.state reqDto + let stateWithSolvedConflicts = solveConflict ms reqDto + migrateState stateWithSolvedConflicts + auditKmMigrationSolve editorUuid reqDto + return () + where + validateMigrationState ms = + case ms.state of + ConflictKnowledgeModelMigrationState _ -> return () + _ -> throwError . UserError $ _ERROR_SERVICE_MIGRATION_KM__NO_CONFLICTS_TO_SOLVE + validateTargetPackageEvent ms = + case length ms.targetPackageEvents of + 0 -> throwError . UserError $ _ERROR_SERVICE_MIGRATION_KM__NO_EVENTS_IN_TARGET_PKG_EVENT_QUEUE + _ -> return () + validateReqDto (ConflictKnowledgeModelMigrationState (Just e)) reqDto = + when + (e.uuid /= reqDto.originalEventUuid) + (throwError . UserError $ _ERROR_SERVICE_MIGRATION_KM__EVENT_UUIDS_MISMATCH) + validateReqDto _ _ = error "Expected a ConflictKnowledgeModelMigrationState with CorrectorConflict containing an event" + +solveAllConflicts :: U.UUID -> AppContextM () +solveAllConflicts editorUuid = + runInTransaction $ do + checkPermission _KM_UPGRADE_PERM + migratorState <- getCurrentMigration editorUuid + updatedState <- go migratorState + updateKnowledgeModelMigration updatedState + auditKmMigrationApplyAll editorUuid + return () + where + go migratorState = do + case migratorState.state of + RunningKnowledgeModelMigrationState -> return migratorState + ConflictKnowledgeModelMigrationState mEvent -> + case mEvent of + Just event -> do + let conflictDto = + KnowledgeModelMigrationResolutionDTO + { originalEventUuid = event.uuid + , action = ApplyKnowledgeModelMigrationAction + } + nextState <- migrate (solveConflict migratorState conflictDto) + go nextState + Nothing -> do + let updatedKnowledgeModelMigration = migratorState {state = ErrorKnowledgeModelMigrationState} :: KnowledgeModelMigration + updateKnowledgeModelMigration updatedKnowledgeModelMigration + return updatedKnowledgeModelMigration + ErrorKnowledgeModelMigrationState -> return migratorState + CompletedKnowledgeModelMigrationState -> return migratorState + +migrateState :: KnowledgeModelMigration -> AppContextM KnowledgeModelMigration +migrateState ms = + runInTransaction $ do + migratedMs <- migrate ms + updateKnowledgeModelMigration migratedMs + return migratedMs diff --git a/wizard-server/src/Wizard/Service/KnowledgeModel/Migration/KnowledgeModelMigrationValidation.hs b/wizard-server/src/Wizard/Service/KnowledgeModel/Migration/KnowledgeModelMigrationValidation.hs new file mode 100644 index 000000000..d7ffe0607 --- /dev/null +++ b/wizard-server/src/Wizard/Service/KnowledgeModel/Migration/KnowledgeModelMigrationValidation.hs @@ -0,0 +1,26 @@ +module Wizard.Service.KnowledgeModel.Migration.KnowledgeModelMigrationValidation where + +import Control.Monad.Except (catchError, throwError) +import qualified Data.UUID as U + +import Shared.Common.Model.Error.Error +import Shared.Coordinate.Util.Coordinate +import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelMigrationDAO +import Wizard.Localization.Messages.Public +import Wizard.Model.Context.AppContext +import Wizard.Service.KnowledgeModel.Package.KnowledgeModelPackageValidation + +validateMigrationUniqueness :: U.UUID -> AppContextM () +validateMigrationUniqueness bUuid = do + mMs <- findKnowledgeModelMigrationByEditorUuid' bUuid + case mMs of + Nothing -> return () + Just _ -> throwError . UserError $ _ERROR_VALIDATION__KM_MIGRATION_UNIQUENESS + +validateIfTargetPackageVersionIsHigher :: String -> String -> AppContextM () +validateIfTargetPackageVersionIsHigher forkOfPackageId targetPackageId = do + let targetPackageVersion = getVersionFromCoordinate targetPackageId + let forkOfPackageIdVersion = getVersionFromCoordinate forkOfPackageId + catchError + (validateIsVersionHigher targetPackageVersion forkOfPackageIdVersion) + (\_ -> throwError . UserError $ _ERROR_SERVICE_MIGRATION_KM__TARGET_PKG_IS_NOT_HIGHER) diff --git a/wizard-server/src/Wizard/Service/KnowledgeModel/Migration/MigrationAudit.hs b/wizard-server/src/Wizard/Service/KnowledgeModel/Migration/MigrationAudit.hs deleted file mode 100644 index 0700e34fd..000000000 --- a/wizard-server/src/Wizard/Service/KnowledgeModel/Migration/MigrationAudit.hs +++ /dev/null @@ -1,39 +0,0 @@ -module Wizard.Service.KnowledgeModel.Migration.MigrationAudit where - -import qualified Data.Map.Strict as M -import Data.Maybe -import qualified Data.UUID as U - -import Shared.Audit.Service.Audit.AuditService -import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationCreateDTO -import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationResolutionDTO -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.ContextLenses () -import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditor - -auditKmMigrationCreate :: KnowledgeModelMigrationCreateDTO -> KnowledgeModelEditor -> AppContextM () -auditKmMigrationCreate reqDto kmEditor = - logAuditWithBody - "knowledge_model.migration" - "create" - (U.toString kmEditor.uuid) - ( M.fromList - [("sourcePackageId", fromMaybe "" $ kmEditor.previousPackageId), ("targetPackageId", reqDto.targetPackageId)] - ) - -auditKmMigrationSolve :: U.UUID -> KnowledgeModelMigrationResolutionDTO -> AppContextM () -auditKmMigrationSolve editorUuid reqDto = - logAuditWithBody - "knowledge_model.migration" - "solve" - (U.toString editorUuid) - (M.fromList [("originalEventUuid", U.toString $ reqDto.originalEventUuid), ("action", show reqDto.action)]) - -auditKmMigrationApplyAll :: U.UUID -> AppContextM () -auditKmMigrationApplyAll editorUuid = logAudit "knowledge_model.migration" "applyAll" (U.toString editorUuid) - -auditKmMigrationCancel :: U.UUID -> AppContextM () -auditKmMigrationCancel editorUuid = logAudit "knowledge_model.migration" "cancel" (U.toString editorUuid) - -auditKmMigrationFinish :: U.UUID -> AppContextM () -auditKmMigrationFinish editorUuid = logAudit "knowledge_model.migration" "finish" (U.toString editorUuid) diff --git a/wizard-server/src/Wizard/Service/KnowledgeModel/Migration/MigrationMapper.hs b/wizard-server/src/Wizard/Service/KnowledgeModel/Migration/MigrationMapper.hs deleted file mode 100644 index 8e1cc891a..000000000 --- a/wizard-server/src/Wizard/Service/KnowledgeModel/Migration/MigrationMapper.hs +++ /dev/null @@ -1,39 +0,0 @@ -module Wizard.Service.KnowledgeModel.Migration.MigrationMapper where - -import Data.Time -import qualified Data.UUID as U - -import Shared.KnowledgeModel.Constant.KnowledgeModel -import Shared.KnowledgeModel.Model.KnowledgeModel.Event.KnowledgeModelEvent -import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel -import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackage -import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationDTO -import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditor -import Wizard.Model.KnowledgeModel.Migration.KnowledgeModelMigration - -toDTO :: KnowledgeModelMigration -> KnowledgeModelEditor -> KnowledgeModelMigrationDTO -toDTO ms kmEditor = - KnowledgeModelMigrationDTO - { editorUuid = ms.editorUuid - , editorName = kmEditor.name - , editorPreviousPackageId = ms.editorPreviousPackageId - , state = ms.state - , targetPackageId = ms.targetPackageId - , currentKnowledgeModel = ms.currentKnowledgeModel - } - -fromCreateDTO :: KnowledgeModelEditor -> KnowledgeModelPackage -> [KnowledgeModelEvent] -> String -> [KnowledgeModelEvent] -> KnowledgeModel -> U.UUID -> UTCTime -> KnowledgeModelMigration -fromCreateDTO kmEditor previousPkg editorPreviousPackageEvents targetPkgId targetPkgEvents km tenantUuid now = - KnowledgeModelMigration - { editorUuid = kmEditor.uuid - , metamodelVersion = knowledgeModelMetamodelVersion - , state = RunningKnowledgeModelMigrationState - , editorPreviousPackageId = previousPkg.pId - , targetPackageId = targetPkgId - , editorPreviousPackageEvents = editorPreviousPackageEvents - , targetPackageEvents = targetPkgEvents - , resultEvents = [] - , currentKnowledgeModel = Just km - , tenantUuid = tenantUuid - , createdAt = now - } diff --git a/wizard-server/src/Wizard/Service/KnowledgeModel/Migration/MigrationService.hs b/wizard-server/src/Wizard/Service/KnowledgeModel/Migration/MigrationService.hs deleted file mode 100644 index ef4a38aab..000000000 --- a/wizard-server/src/Wizard/Service/KnowledgeModel/Migration/MigrationService.hs +++ /dev/null @@ -1,164 +0,0 @@ -module Wizard.Service.KnowledgeModel.Migration.MigrationService where - -import Control.Monad (when) -import Control.Monad.Except (throwError) -import Control.Monad.Reader (asks, liftIO) -import Data.Time -import qualified Data.UUID as U - -import Shared.Common.Model.Error.Error -import Shared.KnowledgeModel.Model.KnowledgeModel.Event.KnowledgeModelEvent -import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackage -import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationCreateDTO -import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationDTO -import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationResolutionDTO -import Wizard.Database.DAO.Common -import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelEditorDAO -import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelEditorEventDAO -import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelMigrationDAO -import Wizard.Localization.Messages.Public -import Wizard.Model.Context.AclContext -import Wizard.Model.Context.AppContext -import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditor -import Wizard.Model.KnowledgeModel.Migration.KnowledgeModelMigration -import Wizard.Service.KnowledgeModel.Editor.Collaboration.CollaborationService -import qualified Wizard.Service.KnowledgeModel.Editor.EditorMapper as EditorMapper -import Wizard.Service.KnowledgeModel.Editor.EditorUtil -import Wizard.Service.KnowledgeModel.KnowledgeModelService -import Wizard.Service.KnowledgeModel.Migration.MigrationAudit -import Wizard.Service.KnowledgeModel.Migration.MigrationMapper -import Wizard.Service.KnowledgeModel.Migration.MigrationValidation -import Wizard.Service.KnowledgeModel.Migration.Migrator.Migrator -import Wizard.Service.KnowledgeModel.Package.KnowledgeModelPackageService - -getCurrentMigrationDto :: U.UUID -> AppContextM KnowledgeModelMigrationDTO -getCurrentMigrationDto editorUuid = do - checkPermission _KM_UPGRADE_PERM - ms <- getCurrentMigration editorUuid - editor <- findKnowledgeModelEditorByUuid editorUuid - return $ toDTO ms editor - -getCurrentMigration :: U.UUID -> AppContextM KnowledgeModelMigration -getCurrentMigration editorUuid = do - ms <- findMigratorStateByEditorUuid editorUuid - knowledgeModel <- compileKnowledgeModel ms.resultEvents (Just ms.editorPreviousPackageId) [] - let stateWithEvent = - case ms.state of - (ConflictKnowledgeModelMigrationState Nothing) -> ConflictKnowledgeModelMigrationState . Just . head $ ms.targetPackageEvents - state -> state - return $ ms {currentKnowledgeModel = Just knowledgeModel, state = stateWithEvent} :: AppContextM KnowledgeModelMigration - -createMigration :: U.UUID -> KnowledgeModelMigrationCreateDTO -> AppContextM KnowledgeModelMigrationDTO -createMigration kmEditorUuid reqDto = - runInTransaction $ do - checkPermission _KM_UPGRADE_PERM - logOutOnlineUsersWhenKnowledgeModelEditorDramaticallyChanged kmEditorUuid - let targetPkgId = reqDto.targetPackageId - editor <- findKnowledgeModelEditorByUuid kmEditorUuid - previousPkg <- getPreviousPkg editor - mergeCheckpointPkgId <- getMergeCheckpointPackageId editor - forkOfPkgId <- getForkOfPackageId editor - validateMigrationUniqueness kmEditorUuid - validateIfTargetPackageVersionIsHigher forkOfPkgId targetPkgId - editorEvents <- getEditorEvents previousPkg.pId mergeCheckpointPkgId - targetPkgEvents <- getTargetPackageEvents targetPkgId forkOfPkgId - kmEditorEvents <- findKnowledgeModelEventsByEditorUuid kmEditorUuid - let kmEvents = fmap EditorMapper.toKnowledgeModelEvent kmEditorEvents - km <- compileKnowledgeModel kmEvents editor.previousPackageId [] - tenantUuid <- asks currentTenantUuid - now <- liftIO getCurrentTime - let ms = fromCreateDTO editor previousPkg editorEvents targetPkgId targetPkgEvents km tenantUuid now - insertMigratorState ms - migratedMs <- migrateState ms - auditKmMigrationCreate reqDto editor - return $ toDTO migratedMs editor - where - getEditorEvents = getAllPreviousEventsSincePackageIdAndUntilPackageId - getTargetPackageEvents = getAllPreviousEventsSincePackageIdAndUntilPackageId - getPreviousPkg editor = - case editor.previousPackageId of - Just previousPkgId -> getPackageById previousPkgId - Nothing -> throwError . UserError $ _ERROR_VALIDATION__KM_EDITOR_PREVIOUS_PKG_ABSENCE - getMergeCheckpointPackageId editor = do - mMergeCheckpointPackageId <- getEditorMergeCheckpointPackageId editor - case mMergeCheckpointPackageId of - Just mergeCheckpointPackageId -> return mergeCheckpointPackageId - Nothing -> throwError . UserError $ _ERROR_SERVICE_MIGRATION_KM__EDITOR_MISSING_MERGE_CHECKPOINT_PACKAGE_ID - getForkOfPackageId editor = do - mForkOfPackageId <- getEditorForkOfPackageId editor - case mForkOfPackageId of - Just forkOfPackageId -> return forkOfPackageId - Nothing -> throwError . UserError $ _ERROR_SERVICE_MIGRATION_KM__EDITOR_MISSING_FORK_OF_PACKAGE_ID - -deleteCurrentMigration :: U.UUID -> AppContextM () -deleteCurrentMigration editorUuid = - runInTransaction $ do - checkPermission _KM_UPGRADE_PERM - _ <- getCurrentMigration editorUuid - deleteMigratorStateByEditorUuid editorUuid - auditKmMigrationCancel editorUuid - return () - -solveConflictAndMigrate :: U.UUID -> KnowledgeModelMigrationResolutionDTO -> AppContextM () -solveConflictAndMigrate editorUuid reqDto = - runInTransaction $ do - checkPermission _KM_UPGRADE_PERM - ms <- getCurrentMigration editorUuid - validateMigrationState ms - validateTargetPackageEvent ms - validateReqDto ms.state reqDto - let stateWithSolvedConflicts = solveConflict ms reqDto - migrateState stateWithSolvedConflicts - auditKmMigrationSolve editorUuid reqDto - return () - where - validateMigrationState ms = - case ms.state of - ConflictKnowledgeModelMigrationState _ -> return () - _ -> throwError . UserError $ _ERROR_SERVICE_MIGRATION_KM__NO_CONFLICTS_TO_SOLVE - validateTargetPackageEvent ms = - case length ms.targetPackageEvents of - 0 -> throwError . UserError $ _ERROR_SERVICE_MIGRATION_KM__NO_EVENTS_IN_TARGET_PKG_EVENT_QUEUE - _ -> return () - validateReqDto (ConflictKnowledgeModelMigrationState (Just e)) reqDto = - when - (e.uuid /= reqDto.originalEventUuid) - (throwError . UserError $ _ERROR_SERVICE_MIGRATION_KM__EVENT_UUIDS_MISMATCH) - validateReqDto _ _ = error "Expected a ConflictKnowledgeModelMigrationState with CorrectorConflict containing an event" - -solveAllConflicts :: U.UUID -> AppContextM () -solveAllConflicts editorUuid = - runInTransaction $ do - checkPermission _KM_UPGRADE_PERM - migratorState <- getCurrentMigration editorUuid - updatedState <- go migratorState - updateMigratorState updatedState - auditKmMigrationApplyAll editorUuid - return () - where - go migratorState = do - case migratorState.state of - RunningKnowledgeModelMigrationState -> return migratorState - ConflictKnowledgeModelMigrationState mEvent -> - case mEvent of - Just event -> do - let conflictDto = - KnowledgeModelMigrationResolutionDTO - { originalEventUuid = event.uuid - , action = ApplyKnowledgeModelMigrationAction - } - nextState <- migrate (solveConflict migratorState conflictDto) - go nextState - Nothing -> do - let updatedMigratorState = migratorState {state = ErrorKnowledgeModelMigrationState} :: KnowledgeModelMigration - updateMigratorState updatedMigratorState - return updatedMigratorState - ErrorKnowledgeModelMigrationState -> return migratorState - CompletedKnowledgeModelMigrationState -> return migratorState - -migrateState :: KnowledgeModelMigration -> AppContextM KnowledgeModelMigration -migrateState ms = - runInTransaction $ do - migratedMs <- migrate ms - updateMigratorState migratedMs - return migratedMs diff --git a/wizard-server/src/Wizard/Service/KnowledgeModel/Migration/MigrationValidation.hs b/wizard-server/src/Wizard/Service/KnowledgeModel/Migration/MigrationValidation.hs deleted file mode 100644 index 2e38aacd3..000000000 --- a/wizard-server/src/Wizard/Service/KnowledgeModel/Migration/MigrationValidation.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Wizard.Service.KnowledgeModel.Migration.MigrationValidation where - -import Control.Monad.Except (catchError, throwError) -import qualified Data.UUID as U - -import Shared.Common.Model.Error.Error -import Shared.Coordinate.Util.Coordinate -import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelMigrationDAO -import Wizard.Localization.Messages.Public -import Wizard.Model.Context.AppContext -import Wizard.Service.KnowledgeModel.Package.KnowledgeModelPackageValidation - -validateMigrationUniqueness :: U.UUID -> AppContextM () -validateMigrationUniqueness bUuid = do - mMs <- findMigratorStateByEditorUuid' bUuid - case mMs of - Nothing -> return () - Just _ -> throwError . UserError $ _ERROR_VALIDATION__KM_MIGRATION_UNIQUENESS - -validateIfTargetPackageVersionIsHigher :: String -> String -> AppContextM () -validateIfTargetPackageVersionIsHigher forkOfPackageId targetPackageId = do - let targetPackageVersion = getVersionFromCoordinate targetPackageId - let forkOfPackageIdVersion = getVersionFromCoordinate forkOfPackageId - catchError - (validateIsVersionHigher targetPackageVersion forkOfPackageIdVersion) - (\_ -> throwError . UserError $ _ERROR_SERVICE_MIGRATION_KM__TARGET_PKG_IS_NOT_HIGHER) diff --git a/wizard-server/src/Wizard/Service/KnowledgeModel/Package/KnowledgeModelPackageAudit.hs b/wizard-server/src/Wizard/Service/KnowledgeModel/Package/KnowledgeModelPackageAudit.hs index 41382bc69..4e58ed8b6 100644 --- a/wizard-server/src/Wizard/Service/KnowledgeModel/Package/KnowledgeModelPackageAudit.hs +++ b/wizard-server/src/Wizard/Service/KnowledgeModel/Package/KnowledgeModelPackageAudit.hs @@ -8,7 +8,7 @@ import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackage import Wizard.Model.Context.AppContext import Wizard.Model.Context.ContextLenses () import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditor -import Wizard.Model.Questionnaire.Questionnaire +import Wizard.Model.Project.Project auditPackageFailedToDelete :: String -> String -> String -> AppContextM () auditPackageFailedToDelete entityId reasonType reasonId = @@ -26,6 +26,6 @@ auditPackageFailedToDeleteDueKmEditors :: String -> [KnowledgeModelEditor] -> Ap auditPackageFailedToDeleteDueKmEditors entityId knowledgeModelEditors = auditPackageFailedToDelete entityId "Knowledge Model Editor" (show $ fmap (\b -> U.toString $ b.uuid) knowledgeModelEditors) -auditPackageFailedToDeleteDueQuestionnaires :: String -> [Questionnaire] -> AppContextM () -auditPackageFailedToDeleteDueQuestionnaires entityId questionnaires = - auditPackageFailedToDelete entityId "Knowledge Model Editor" (show $ fmap (\qtn -> U.toString $ qtn.uuid) questionnaires) +auditPackageFailedToDeleteDueProjects :: String -> [Project] -> AppContextM () +auditPackageFailedToDeleteDueProjects entityId projects = + auditPackageFailedToDelete entityId "Knowledge Model Editor" (show $ fmap (\project -> U.toString $ project.uuid) projects) diff --git a/wizard-server/src/Wizard/Service/KnowledgeModel/Package/KnowledgeModelPackageValidation.hs b/wizard-server/src/Wizard/Service/KnowledgeModel/Package/KnowledgeModelPackageValidation.hs index 72f23bd10..a7609f5dd 100644 --- a/wizard-server/src/Wizard/Service/KnowledgeModel/Package/KnowledgeModelPackageValidation.hs +++ b/wizard-server/src/Wizard/Service/KnowledgeModel/Package/KnowledgeModelPackageValidation.hs @@ -8,7 +8,7 @@ import Shared.Coordinate.Util.Coordinate import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO import Shared.KnowledgeModel.Localization.Messages.Public import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelEditorDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO +import Wizard.Database.DAO.Project.ProjectDAO import Wizard.Localization.Messages.Public import Wizard.Model.Context.AppContext import Wizard.Service.KnowledgeModel.Package.KnowledgeModelPackageAudit @@ -43,7 +43,7 @@ validatePackagesDeletion pkgIds = forM_ pkgIds validateOnePackage validateOnePackage :: String -> AppContextM () validateOnePackage pkgId = do validateUsageBySomeKnowledgeModelEditor pkgId - validateUsageBySomeQuestionnaire pkgId + validateUsageBySomeProject pkgId validateUsageBySomeOtherPackage pkgId validateUsageBySomeOtherPackage pkgId = do pkgs <- findPackagesByForkOfPackageId pkgId @@ -57,7 +57,7 @@ validatePackagesDeletion pkgIds = forM_ pkgIds validateOnePackage validatePackageDeletion :: String -> AppContextM () validatePackageDeletion pkgId = do validateUsageBySomeKnowledgeModelEditor pkgId - validateUsageBySomeQuestionnaire pkgId + validateUsageBySomeProject pkgId validateUsageBySomeOtherPackage pkgId where validateUsageBySomeOtherPackage pkgId = do @@ -86,12 +86,12 @@ validateUsageBySomeKnowledgeModelEditor pkgId = do throwError . UserError $ _ERROR_SERVICE_PKG__PKG_CANT_BE_DELETED_BECAUSE_IT_IS_USED_BY_SOME_OTHER_ENTITY pkgId "knowledge model" -validateUsageBySomeQuestionnaire :: String -> AppContextM () -validateUsageBySomeQuestionnaire pkgId = do - questionnaires <- findQuestionnairesByPackageId pkgId - case questionnaires of +validateUsageBySomeProject :: String -> AppContextM () +validateUsageBySomeProject pkgId = do + projects <- findProjectsByKnowledgeModelPackageId pkgId + case projects of [] -> return () _ -> do - auditPackageFailedToDeleteDueQuestionnaires pkgId questionnaires + auditPackageFailedToDeleteDueProjects pkgId projects throwError . UserError $ - _ERROR_SERVICE_PKG__PKG_CANT_BE_DELETED_BECAUSE_IT_IS_USED_BY_SOME_OTHER_ENTITY pkgId "questionnaire" + _ERROR_SERVICE_PKG__PKG_CANT_BE_DELETED_BECAUSE_IT_IS_USED_BY_SOME_OTHER_ENTITY pkgId "project" diff --git a/wizard-server/src/Wizard/Service/KnowledgeModel/Publish/KnowledgeModelPublishService.hs b/wizard-server/src/Wizard/Service/KnowledgeModel/Publish/KnowledgeModelPublishService.hs index 77f28b3ad..642d82f99 100644 --- a/wizard-server/src/Wizard/Service/KnowledgeModel/Publish/KnowledgeModelPublishService.hs +++ b/wizard-server/src/Wizard/Service/KnowledgeModel/Publish/KnowledgeModelPublishService.hs @@ -26,7 +26,7 @@ import Wizard.Service.KnowledgeModel.Editor.Collaboration.CollaborationService import Wizard.Service.KnowledgeModel.Editor.EditorAudit import Wizard.Service.KnowledgeModel.Editor.EditorMapper import Wizard.Service.KnowledgeModel.Editor.EditorUtil -import Wizard.Service.KnowledgeModel.Migration.MigrationAudit +import Wizard.Service.KnowledgeModel.Migration.KnowledgeModelMigrationAudit import Wizard.Service.KnowledgeModel.Package.KnowledgeModelPackageService import Wizard.Service.KnowledgeModel.Publish.KnowledgeModelPublishMapper import Wizard.Service.KnowledgeModel.Publish.KnowledgeModelPublishValidation @@ -57,8 +57,8 @@ publishPackageFromMigration reqDto = do runInTransaction $ do checkPermission _KM_PUBLISH_PERM kmEditor <- findKnowledgeModelEditorByUuid reqDto.editorUuid - ms <- findMigratorStateByEditorUuid reqDto.editorUuid - deleteMigratorStateByEditorUuid reqDto.editorUuid + ms <- findKnowledgeModelMigrationByEditorUuid reqDto.editorUuid + deleteKnowledgeModelMigrationByEditorUuid reqDto.editorUuid auditKmMigrationFinish reqDto.editorUuid doPublishPackage reqDto.version diff --git a/wizard-server/src/Wizard/Service/KnowledgeModel/Publish/KnowledgeModelPublishValidation.hs b/wizard-server/src/Wizard/Service/KnowledgeModel/Publish/KnowledgeModelPublishValidation.hs index 02778ddf6..3c797a1f3 100644 --- a/wizard-server/src/Wizard/Service/KnowledgeModel/Publish/KnowledgeModelPublishValidation.hs +++ b/wizard-server/src/Wizard/Service/KnowledgeModel/Publish/KnowledgeModelPublishValidation.hs @@ -13,7 +13,7 @@ import Wizard.Service.KnowledgeModel.Package.KnowledgeModelPackageService import Wizard.Service.KnowledgeModel.Package.KnowledgeModelPackageValidation validateMigrationExistence editorUuid = do - mMs <- findMigratorStateByEditorUuid' editorUuid + mMs <- findKnowledgeModelMigrationByEditorUuid' editorUuid when (isJust mMs) (throwError . UserError $ _ERROR_SERVICE_KNOWLEDGE_MODEL_EDITOR__KM_MIGRATION_EXISTS) validateNewPackageVersion pkgVersion kmEditor org = do diff --git a/wizard-server/src/Wizard/Service/Mail/Mailer.hs b/wizard-server/src/Wizard/Service/Mail/Mailer.hs index 1e1ed57da..7a7ebef1c 100644 --- a/wizard-server/src/Wizard/Service/Mail/Mailer.hs +++ b/wizard-server/src/Wizard/Service/Mail/Mailer.hs @@ -17,7 +17,7 @@ import Shared.Common.Util.JSON import Shared.Common.Util.Uuid import Shared.PersistentCommand.Database.DAO.PersistentCommand.PersistentCommandDAO import Shared.PersistentCommand.Service.PersistentCommand.PersistentCommandMapper -import Wizard.Api.Resource.Questionnaire.QuestionnaireCommentThreadNotificationJM () +import Wizard.Api.Resource.Project.Comment.ProjectCommentThreadNotificationJM () import Wizard.Api.Resource.User.UserDTO import Wizard.Database.DAO.Common import Wizard.Database.DAO.Tenant.Config.TenantConfigPrivacyAndSupportDAO @@ -25,9 +25,9 @@ import Wizard.Database.DAO.User.UserDAO import Wizard.Model.Config.ServerConfig import Wizard.Model.Context.AppContext import Wizard.Model.Context.AppContextHelpers -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireCommentThreadNotification -import Wizard.Model.Questionnaire.QuestionnairePerm +import Wizard.Model.Project.Acl.ProjectPerm +import Wizard.Model.Project.Comment.ProjectCommentThreadNotification +import Wizard.Model.Project.Project import Wizard.Model.Tenant.Config.TenantConfig import Wizard.Model.User.User import Wizard.Service.Tenant.TenantHelper @@ -156,28 +156,28 @@ sendTwoFactorAuthMail user code = } sendEmail body user.uuid -sendQuestionnaireInvitationMail :: Questionnaire -> Questionnaire -> AppContextM () -sendQuestionnaireInvitationMail oldQtn newQtn = +sendProjectInvitationMail :: Project -> Project -> AppContextM () +sendProjectInvitationMail oldProject newProject = runInTransaction $ do tcPrivacyAndSupport <- findTenantConfigPrivacyAndSupport tcLookAndFeel <- findTenantConfigLookAndFeel tcMail <- findTenantConfigMail clientUrl <- getClientUrl currentUser <- getCurrentUser - traverse_ (sendOneEmail tcPrivacyAndSupport tcLookAndFeel tcMail clientUrl currentUser) (filter (filterPermissions currentUser) newQtn.permissions) + traverse_ (sendOneEmail tcPrivacyAndSupport tcLookAndFeel tcMail clientUrl currentUser) (filter (filterPermissions currentUser) newProject.permissions) where - filterPermissions :: UserDTO -> QuestionnairePerm -> Bool - filterPermissions currentUser perm = perm.memberUuid /= currentUser.uuid && perm.memberUuid `notElem` fmap (.memberUuid) oldQtn.permissions - sendOneEmail :: TenantConfigPrivacyAndSupport -> TenantConfigLookAndFeel -> TenantConfigMail -> String -> UserDTO -> QuestionnairePerm -> AppContextM () + filterPermissions :: UserDTO -> ProjectPerm -> Bool + filterPermissions currentUser perm = perm.memberUuid /= currentUser.uuid && perm.memberUuid `notElem` fmap (.memberUuid) oldProject.permissions + sendOneEmail :: TenantConfigPrivacyAndSupport -> TenantConfigLookAndFeel -> TenantConfigMail -> String -> UserDTO -> ProjectPerm -> AppContextM () sendOneEmail tcPrivacyAndSupport tcLookAndFeel tcMail clientUrl currentUser permission = case permission.memberType of - UserGroupQuestionnairePermType -> return () - UserQuestionnairePermType -> do + UserGroupProjectPermType -> return () + UserProjectPermType -> do user <- findUserByUuid permission.memberUuid let body = MC.MailCommand { mode = "wizard" - , template = "questionnaireInvitation" + , template = "projectInvitation" , recipients = [MC.MailRecipient {uuid = Just user.uuid, email = user.email}] , parameters = M.fromList @@ -193,8 +193,8 @@ sendQuestionnaireInvitationMail oldQtn newQtn = , ("inviteeFirstName", A.string user.firstName) , ("inviteeLastName", A.string user.lastName) , ("inviteeEmail", A.string user.email) - , ("questionnaireUuid", A.uuid newQtn.uuid) - , ("questionnaireName", A.string newQtn.name) + , ("projectUuid", A.uuid newProject.uuid) + , ("projectName", A.string newProject.name) , ("ownerUuid", A.uuid currentUser.uuid) , ("ownerFirstName", A.string currentUser.firstName) , ("ownerLastName", A.string currentUser.lastName) @@ -203,16 +203,16 @@ sendQuestionnaireInvitationMail oldQtn newQtn = } sendEmail body currentUser.uuid -sendQuestionnaireCommentThreadAssignedMail :: [QuestionnaireCommentThreadNotification] -> AppContextM () -sendQuestionnaireCommentThreadAssignedMail notifications = +sendProjectCommentThreadAssignedMail :: [ProjectCommentThreadNotification] -> AppContextM () +sendProjectCommentThreadAssignedMail notifications = runInTransaction $ do case notifications of [] -> return () notification : _ -> do let notificationFn n = A.Object . KM.fromList $ - [ ("questionnaireUuid", A.uuid n.questionnaireUuid) - , ("questionnaireName", A.string n.questionnaireName) + [ ("projectUuid", A.uuid n.projectUuid) + , ("projectName", A.string n.projectName) , ("commentThreadUuid", A.uuid n.commentThreadUuid) , ("path", A.string n.path) , ("resolved", A.bool n.resolved) diff --git a/wizard-server/src/Wizard/Service/PersistentCommand/PersistentCommandExecutor.hs b/wizard-server/src/Wizard/Service/PersistentCommand/PersistentCommandExecutor.hs index 304d17ebc..20ec72c93 100644 --- a/wizard-server/src/Wizard/Service/PersistentCommand/PersistentCommandExecutor.hs +++ b/wizard-server/src/Wizard/Service/PersistentCommand/PersistentCommandExecutor.hs @@ -11,8 +11,8 @@ import qualified Wizard.Service.Document.DocumentCommandExecutor as DocumentComm import qualified Wizard.Service.DocumentTemplate.Asset.DocumentTemplateAssetCommandExecutor as DocumentTemplateAssetCommandExecutor import qualified Wizard.Service.KnowledgeModel.Metamodel.MigrationCommandExecutor as MetamodelMigratorCommandExecutor import qualified Wizard.Service.Locale.LocaleCommandExecutor as LocaleCommandExecutor -import qualified Wizard.Service.Questionnaire.File.QuestionnaireFileCommandExecutor as QuestionnaireFileCommandExecutor -import qualified Wizard.Service.Questionnaire.QuestionnaireCommandExecutor as QuestionnaireCommandExecutor +import qualified Wizard.Service.Project.File.ProjectFileCommandExecutor as ProjectFileCommandExecutor +import qualified Wizard.Service.Project.ProjectCommandExecutor as ProjectCommandExecutor import qualified Wizard.Service.Tenant.Config.ConfigCommandExecutor as TenantConfigCommandExecutor import qualified Wizard.Service.Tenant.TenantCommandExecutor as TenantCommandExecutor import qualified Wizard.Service.User.Group.UserGroupCommandExecutor as UserGroupCommandExecutor @@ -27,8 +27,8 @@ execute command | command.component == LocaleCommandExecutor.cComponent = LocaleCommandExecutor.execute command | command.component == MetamodelMigratorCommandExecutor.cComponent = MetamodelMigratorCommandExecutor.execute command | command.component == PrefabCommandExecutor.cComponent = PrefabCommandExecutor.execute command - | command.component == QuestionnaireCommandExecutor.cComponent = QuestionnaireCommandExecutor.execute command - | command.component == QuestionnaireFileCommandExecutor.cComponent = QuestionnaireFileCommandExecutor.execute command + | command.component == ProjectCommandExecutor.cComponent = ProjectCommandExecutor.execute command + | command.component == ProjectFileCommandExecutor.cComponent = ProjectFileCommandExecutor.execute command | command.component == TenantCommandExecutor.cComponent = TenantCommandExecutor.execute command | command.component == TenantConfigCommandExecutor.cComponent = TenantConfigCommandExecutor.execute command | command.component == TourCommandExecutor.cComponent = TourCommandExecutor.execute command diff --git a/wizard-server/src/Wizard/Service/Project/Action/ProjectActionAudit.hs b/wizard-server/src/Wizard/Service/Project/Action/ProjectActionAudit.hs new file mode 100644 index 000000000..55d8b2ecd --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/Action/ProjectActionAudit.hs @@ -0,0 +1,8 @@ +module Wizard.Service.Project.Action.ProjectActionAudit where + +import Shared.Audit.Service.Audit.AuditService +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.ContextLenses () + +auditProjectActionStartEvent :: String -> AppContextM () +auditProjectActionStartEvent = logAudit "projectAction" "startEvent" diff --git a/wizard-server/src/Wizard/Service/Project/Action/ProjectActionMapper.hs b/wizard-server/src/Wizard/Service/Project/Action/ProjectActionMapper.hs new file mode 100644 index 000000000..9e341e66c --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/Action/ProjectActionMapper.hs @@ -0,0 +1,26 @@ +module Wizard.Service.Project.Action.ProjectActionMapper where + +import Data.Time + +import Wizard.Api.Resource.Project.Action.ProjectActionChangeDTO +import Wizard.Api.Resource.Project.Action.ProjectActionDTO +import Wizard.Model.Project.Action.ProjectAction + +toDTO :: ProjectAction -> ProjectActionDTO +toDTO action = + ProjectActionDTO + { paId = action.paId + , name = action.name + , description = action.description + , url = action.url + , enabled = action.enabled + , createdAt = action.createdAt + , updatedAt = action.updatedAt + } + +toChangeDTO :: ProjectAction -> ProjectActionChangeDTO +toChangeDTO action = ProjectActionChangeDTO {enabled = action.enabled} + +fromChangeDTO :: ProjectAction -> ProjectActionChangeDTO -> UTCTime -> ProjectAction +fromChangeDTO action reqDto now = + action {enabled = reqDto.enabled, updatedAt = now} diff --git a/wizard-server/src/Wizard/Service/Project/Action/ProjectActionService.hs b/wizard-server/src/Wizard/Service/Project/Action/ProjectActionService.hs new file mode 100644 index 000000000..b66e208c5 --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/Action/ProjectActionService.hs @@ -0,0 +1,74 @@ +module Wizard.Service.Project.Action.ProjectActionService where + +import Control.Monad.Reader (liftIO) +import Data.Maybe (fromMaybe) +import Data.Time +import qualified Data.UUID as U + +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.PageMetadata +import Shared.Common.Model.Common.Pageable +import Shared.Common.Model.Common.Sort +import Wizard.Api.Resource.Project.Action.ProjectActionChangeDTO +import Wizard.Api.Resource.Project.Action.ProjectActionDTO +import Wizard.Database.DAO.Common +import Wizard.Database.DAO.Project.ProjectActionDAO +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Model.Context.AclContext +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.AppContextHelpers +import Wizard.Model.Project.Action.ProjectAction +import Wizard.Model.Project.Project +import Wizard.Service.Project.Action.ProjectActionAudit +import Wizard.Service.Project.Action.ProjectActionMapper +import Wizard.Service.Project.Action.ProjectActionUtil + +getProjectActionsPageDto :: Maybe String -> Pageable -> [Sort] -> AppContextM (Page ProjectActionDTO) +getProjectActionsPageDto mQuery pageable sort = do + checkPermission _PRJ_PERM + currentUser <- getCurrentUser + importersPage <- findProjectActionsPage Nothing Nothing mQuery Nothing pageable sort + return $ fmap toDTO importersPage + +getProjectActionSuggestions + :: Maybe U.UUID -> Maybe String -> Maybe Bool -> Pageable -> [Sort] -> AppContextM (Page ProjectActionDTO) +getProjectActionSuggestions mProjectUuid mQuery mEnabled pageable sort = do + checkPermission _PRJ_PERM + mPkgId <- + case mProjectUuid of + Just projectUuid -> do + project <- findProjectByUuid projectUuid + return . Just $ project.knowledgeModelPackageId + Nothing -> return Nothing + page <- findProjectActionsPage Nothing Nothing mQuery mEnabled (Pageable (Just 0) (Just 999999999)) sort + return . fmap toDTO . updatePage page . filterImportersInGroup mPkgId $ page + where + updatePage :: Page ProjectAction -> [ProjectAction] -> Page ProjectAction + updatePage (Page name _ _) array = + let updatedArray = take updatedSize array + updatedSize = fromMaybe 20 pageable.size + updatedTotalElements = length updatedArray + updatedTotalPages = computeTotalPage updatedTotalElements updatedSize + updatedNumber = fromMaybe 0 pageable.page + in Page name (PageMetadata updatedSize updatedTotalElements updatedTotalPages updatedNumber) updatedArray + filterImportersInGroup :: Maybe String -> Page ProjectAction -> [ProjectAction] + filterImportersInGroup mPkgId page = + filter isProjectActionSupported . filterProjectActions mPkgId $ page.entities + +getProjectAction :: String -> AppContextM ProjectActionDTO +getProjectAction piId = + runInTransaction $ do + checkPermission _PRJ_PERM + importer <- findProjectActionById piId + auditProjectActionStartEvent piId + return $ toDTO importer + +modifyProjectAction :: String -> ProjectActionChangeDTO -> AppContextM ProjectActionDTO +modifyProjectAction piId reqDto = + runInTransaction $ do + checkPermission _PRJ_ACTION_PERM + importer <- findProjectActionById piId + now <- liftIO getCurrentTime + let updatedImporter = fromChangeDTO importer reqDto now + updateProjectActionById updatedImporter + return $ toDTO updatedImporter diff --git a/wizard-server/src/Wizard/Service/Project/Action/ProjectActionUtil.hs b/wizard-server/src/Wizard/Service/Project/Action/ProjectActionUtil.hs new file mode 100644 index 000000000..0a12fb113 --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/Action/ProjectActionUtil.hs @@ -0,0 +1,18 @@ +module Wizard.Service.Project.Action.ProjectActionUtil where + +import Shared.Coordinate.Util.Coordinate +import Shared.KnowledgeModel.Service.KnowledgeModel.Package.KnowledgeModelPackageUtil +import Wizard.Constant.ProjectAction +import Wizard.Model.Project.Action.ProjectAction + +isProjectActionSupported :: ProjectAction -> Bool +isProjectActionSupported importer = importer.metamodelVersion == projectActionMetamodelVersion + +filterProjectActions :: Maybe String -> [ProjectAction] -> [ProjectAction] +filterProjectActions mPkgId importers = + case mPkgId of + Just pkgId -> filter (filterProjectAction . splitCoordinate $ pkgId) importers + Nothing -> importers + where + filterProjectAction :: [String] -> ProjectAction -> Bool + filterProjectAction pkgIdSplit importer = fitsIntoKMSpecs pkgIdSplit importer.allowedPackages diff --git a/wizard-server/src/Wizard/Service/Project/Collaboration/ProjectCollaborationAcl.hs b/wizard-server/src/Wizard/Service/Project/Collaboration/ProjectCollaborationAcl.hs new file mode 100644 index 000000000..f8258eebb --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/Collaboration/ProjectCollaborationAcl.hs @@ -0,0 +1,75 @@ +module Wizard.Service.Project.Collaboration.ProjectCollaborationAcl where + +import Control.Monad.Except (throwError) +import Data.Maybe (isJust) +import qualified Data.UUID as U +import Prelude hiding (log) + +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Wizard.Model.Project.Acl.ProjectAclHelpers +import Wizard.Model.Project.Acl.ProjectPerm +import Wizard.Model.Project.Project +import Wizard.Model.User.User +import Wizard.Model.Websocket.WebsocketRecord + +getPermission + :: ProjectVisibility + -> ProjectSharing + -> [ProjectPerm] + -> Maybe U.UUID + -> Maybe String + -> [U.UUID] + -> WebsocketPerm +getPermission visibility sharing permissions mCurrentUserUuid mCurrentUserRole mCurrentUserGroupUuids + | or + [ isAdmin + , isLogged && isExplicitlyOwner + , isLogged && isExplicitlyEditor + , isLogged && isInOwnerGroup + , isLogged && isInEditorGroup + , isLogged && visibility == VisibleEditProjectVisibility + , sharing == AnyoneWithLinkEditProjectSharing + ] = + EditorWebsocketPerm + | or + [ isLogged && isExplicitlyCommenter + , isLogged && isInCommenterGroup + , isLogged && visibility == VisibleCommentProjectVisibility + , sharing == AnyoneWithLinkCommentProjectSharing + ] = + CommenterWebsocketPerm + | or + [ isLogged && isExplicitlyViewer + , isLogged && isInViewerGroup + , isLogged && visibility == VisibleViewProjectVisibility + , sharing == AnyoneWithLinkViewProjectSharing + ] = + ViewerWebsocketPerm + | otherwise = NoWebsocketPerm + where + isExplicitlyOwner = maybe False (`elem` getUserUuidsForOwnerPerm permissions) mCurrentUserUuid + isExplicitlyEditor = maybe False (`elem` getUserUuidsForEditorPerm permissions) mCurrentUserUuid + isExplicitlyCommenter = maybe False (`elem` getUserUuidsForCommenterPerm permissions) mCurrentUserUuid + isExplicitlyViewer = maybe False (`elem` getUserUuidsForViewerPerm permissions) mCurrentUserUuid + isInOwnerGroup = or (fmap (`elem` getUserGroupUuidsForOwnerPerm permissions) mCurrentUserGroupUuids) + isInEditorGroup = or (fmap (`elem` getUserGroupUuidsForEditorPerm permissions) mCurrentUserGroupUuids) + isInCommenterGroup = or (fmap (`elem` getUserGroupUuidsForCommenterPerm permissions) mCurrentUserGroupUuids) + isInViewerGroup = or (fmap (`elem` getUserGroupUuidsForViewerPerm permissions) mCurrentUserGroupUuids) + isLogged = isJust mCurrentUserUuid + isAdmin = mCurrentUserRole == Just _USER_ROLE_ADMIN + +checkViewPermission myself = + if myself.entityPerm == EditorWebsocketPerm || myself.entityPerm == CommenterWebsocketPerm || myself.entityPerm == ViewerWebsocketPerm + then return () + else throwError . ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN "View Project" + +checkCommentPermission myself = + if myself.entityPerm == EditorWebsocketPerm || myself.entityPerm == CommenterWebsocketPerm + then return () + else throwError . ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN "Comment Project" + +checkEditPermission myself = + if myself.entityPerm == EditorWebsocketPerm + then return () + else throwError . ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN "Edit Project" diff --git a/wizard-server/src/Wizard/Service/Project/Collaboration/ProjectCollaborationMapper.hs b/wizard-server/src/Wizard/Service/Project/Collaboration/ProjectCollaborationMapper.hs new file mode 100644 index 000000000..17cd511f7 --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/Collaboration/ProjectCollaborationMapper.hs @@ -0,0 +1,124 @@ +module Wizard.Service.Project.Collaboration.ProjectCollaborationMapper where + +import Wizard.Api.Resource.Project.Detail.ProjectDetailWsDTO +import Wizard.Api.Resource.Project.Event.ProjectEventDTO +import Wizard.Api.Resource.Websocket.ProjectMessageDTO +import Wizard.Api.Resource.Websocket.WebsocketActionDTO +import Wizard.Model.Project.File.ProjectFileSimple +import Wizard.Model.Websocket.WebsocketMessage +import Wizard.Model.Websocket.WebsocketRecord +import Wizard.Util.Websocket + +toWebsocketMessage :: WebsocketRecord -> content -> WebsocketMessage content +toWebsocketMessage record content = + WebsocketMessage + { connectionUuid = record.connectionUuid + , connection = record.connection + , entityId = record.entityId + , content = content + } + +toSetUserListMessage + :: [WebsocketRecord] -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerProjectMessageDTO) +toSetUserListMessage records record = + toWebsocketMessage record $ + Success_ServerActionDTO . SetUserList_ServerProjectMessageDTO $ + getCollaborators record.connectionUuid record.entityId records + +toSetReplyMessage + :: SetReplyEventDTO -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerProjectMessageDTO) +toSetReplyMessage reqDto record = + toWebsocketMessage record $ + Success_ServerActionDTO . SetContent_ServerProjectMessageDTO . SetReplyEventDTO' $ + reqDto + +toClearReplyMessage + :: ClearReplyEventDTO -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerProjectMessageDTO) +toClearReplyMessage reqDto record = + toWebsocketMessage record $ + Success_ServerActionDTO . SetContent_ServerProjectMessageDTO . ClearReplyEventDTO' $ + reqDto + +toSetPhaseMessage + :: SetPhaseEventDTO -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerProjectMessageDTO) +toSetPhaseMessage reqDto record = + toWebsocketMessage record $ + Success_ServerActionDTO . SetContent_ServerProjectMessageDTO . SetPhaseEventDTO' $ + reqDto + +toSetLabelMessage + :: SetLabelsEventDTO -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerProjectMessageDTO) +toSetLabelMessage reqDto record = + toWebsocketMessage record $ + Success_ServerActionDTO . SetContent_ServerProjectMessageDTO . SetLabelsEventDTO' $ + reqDto + +toResolveCommentThreadMessage + :: ResolveCommentThreadEventDTO + -> WebsocketRecord + -> WebsocketMessage (Success_ServerActionDTO ServerProjectMessageDTO) +toResolveCommentThreadMessage reqDto record = + toWebsocketMessage record $ + Success_ServerActionDTO . SetContent_ServerProjectMessageDTO . ResolveCommentThreadEventDTO' $ + reqDto + +toReopenCommentThreadMessage + :: ReopenCommentThreadEventDTO + -> WebsocketRecord + -> WebsocketMessage (Success_ServerActionDTO ServerProjectMessageDTO) +toReopenCommentThreadMessage reqDto record = + toWebsocketMessage record $ + Success_ServerActionDTO . SetContent_ServerProjectMessageDTO . ReopenCommentThreadEventDTO' $ + reqDto + +toAssignCommentThreadMessage + :: AssignCommentThreadEventDTO + -> WebsocketRecord + -> WebsocketMessage (Success_ServerActionDTO ServerProjectMessageDTO) +toAssignCommentThreadMessage reqDto record = + toWebsocketMessage record $ + Success_ServerActionDTO . SetContent_ServerProjectMessageDTO . AssignCommentThreadEventDTO' $ + reqDto + +toDeleteCommentThreadMessage + :: DeleteCommentThreadEventDTO + -> WebsocketRecord + -> WebsocketMessage (Success_ServerActionDTO ServerProjectMessageDTO) +toDeleteCommentThreadMessage reqDto record = + toWebsocketMessage record $ + Success_ServerActionDTO . SetContent_ServerProjectMessageDTO . DeleteCommentThreadEventDTO' $ + reqDto + +toAddCommentMessage + :: AddCommentEventDTO -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerProjectMessageDTO) +toAddCommentMessage reqDto record = + toWebsocketMessage record $ + Success_ServerActionDTO . SetContent_ServerProjectMessageDTO . AddCommentEventDTO' $ + reqDto + +toEditCommentMessage + :: EditCommentEventDTO -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerProjectMessageDTO) +toEditCommentMessage reqDto record = + toWebsocketMessage record $ + Success_ServerActionDTO . SetContent_ServerProjectMessageDTO . EditCommentEventDTO' $ + reqDto + +toDeleteCommentMessage + :: DeleteCommentEventDTO -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerProjectMessageDTO) +toDeleteCommentMessage reqDto record = + toWebsocketMessage record $ + Success_ServerActionDTO . SetContent_ServerProjectMessageDTO . DeleteCommentEventDTO' $ + reqDto + +toSetProjectMessage + :: ProjectDetailWsDTO -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerProjectMessageDTO) +toSetProjectMessage resWsDto record = + toWebsocketMessage record $ + Success_ServerActionDTO . SetProject_ServerProjectMessageDTO $ + resWsDto + +toAddFileMessage :: ProjectFileSimple -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerProjectMessageDTO) +toAddFileMessage file record = + toWebsocketMessage record $ + Success_ServerActionDTO . AddFile_ServerProjectMessageDTO $ + file diff --git a/wizard-server/src/Wizard/Service/Project/Collaboration/ProjectCollaborationService.hs b/wizard-server/src/Wizard/Service/Project/Collaboration/ProjectCollaborationService.hs new file mode 100644 index 000000000..8614cb95d --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/Collaboration/ProjectCollaborationService.hs @@ -0,0 +1,436 @@ +module Wizard.Service.Project.Collaboration.ProjectCollaborationService where + +import Control.Monad (when) +import Control.Monad.Except (catchError) +import Control.Monad.Reader (asks, liftIO) +import qualified Data.Aeson as A +import qualified Data.Aeson.KeyMap as AKM +import qualified Data.ByteString.Lazy.Char8 as BSL +import Data.Foldable (traverse_) +import Data.Maybe (isJust) +import Data.Time +import qualified Data.UUID as U +import Network.WebSockets (Connection) + +import Shared.Common.Integration.Aws.Lambda +import Shared.Common.Model.Error.Error +import Shared.Common.Util.Uuid +import Wizard.Api.Resource.Project.Detail.ProjectDetailWsDTO +import Wizard.Api.Resource.Project.Event.ProjectEventChangeDTO +import Wizard.Api.Resource.User.UserDTO +import Wizard.Api.Resource.Websocket.ProjectMessageJM () +import Wizard.Api.Resource.Websocket.WebsocketActionJM () +import Wizard.Cache.ProjectWebsocketCache +import Wizard.Database.DAO.Project.ProjectCommentDAO +import Wizard.Database.DAO.Project.ProjectCommentThreadDAO +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectEventDAO +import Wizard.Database.DAO.Tenant.TenantDAO +import Wizard.Localization.Messages.Public +import Wizard.Model.Config.ServerConfig +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Acl.ProjectPerm +import Wizard.Model.Project.File.ProjectFileSimple +import Wizard.Model.Project.Project +import Wizard.Model.Tenant.Tenant +import Wizard.Model.User.OnlineUserInfo +import Wizard.Model.Websocket.WebsocketMessage +import Wizard.Model.Websocket.WebsocketRecord +import Wizard.Service.Project.Collaboration.ProjectCollaborationAcl +import Wizard.Service.Project.Collaboration.ProjectCollaborationMapper +import Wizard.Service.Project.Comment.ProjectCommentMapper +import Wizard.Service.Project.Event.ProjectEventMapper +import Wizard.Service.Websocket.WebsocketService +import Wizard.Util.Websocket +import WizardLib.Public.Database.DAO.User.UserGroupMembershipDAO +import WizardLib.Public.Model.User.UserGroupMembership +import WizardLib.Public.Model.User.UserSuggestion + +putUserOnline :: U.UUID -> U.UUID -> Connection -> AppContextM () +putUserOnline projectUuid connectionUuid connection = do + myself <- createProjectRecord connectionUuid connection projectUuid + checkViewPermission myself + addToCache myself + logWS connectionUuid "New user added to the list" + setUserList projectUuid connectionUuid + +deleteUser :: U.UUID -> U.UUID -> AppContextM () +deleteUser projectUuid connectionUuid = do + deleteFromCache connectionUuid + setUserList projectUuid connectionUuid + +setUserList :: U.UUID -> U.UUID -> AppContextM () +setUserList projectUuid connectionUuid = do + logWS connectionUuid "Informing other users about user list changes" + records <- getAllFromCache + broadcast (U.toString projectUuid) records (toSetUserListMessage records) disconnectUser + logWS connectionUuid "Informed completed" + +updatePermsForOnlineUsers :: U.UUID -> ProjectVisibility -> ProjectSharing -> [ProjectPerm] -> AppContextM () +updatePermsForOnlineUsers projectUuid visibility sharing permissions = do + currentTenantUuid <- asks currentTenantUuid + tenant <- findTenantByUuid currentTenantUuid + if isJust tenant.signalBridgeUrl + then do + serverConfig <- asks serverConfig + let dto = AKM.fromList [("projectUuid", U.toString projectUuid), ("tenantUuid", U.toString currentTenantUuid)] + invokeLambda serverConfig.signalBridge.updatePermsArn (BSL.toStrict . A.encode $ dto) + return () + else do + records <- getAllFromCache + traverse_ updatePerm records + where + updatePerm :: WebsocketRecord -> AppContextM () + updatePerm record = + when + (record.entityId == U.toString projectUuid) + ( do + let permission = + case record.user of + user@LoggedOnlineUserInfo {uuid = uuid, role = role, groupUuids = groupUuids} -> + getPermission visibility sharing permissions (Just uuid) (Just role) groupUuids + user@AnonymousOnlineUserInfo {..} -> + getPermission visibility sharing permissions Nothing Nothing [] + let updatedRecord = record {entityPerm = permission} + updateCache updatedRecord + disconnectUserIfLostPermission updatedRecord + ) + +removeUserGroupFromUsers :: U.UUID -> [U.UUID] -> AppContextM () +removeUserGroupFromUsers userGroupUuid userUuids = do + currentTenantUuid <- asks currentTenantUuid + tenant <- findTenantByUuid currentTenantUuid + if isJust tenant.signalBridgeUrl + then do + serverConfig <- asks serverConfig + let dto = AKM.fromList [("userGroupUuid", U.toString userGroupUuid), ("tenantUuid", U.toString currentTenantUuid)] + invokeLambda serverConfig.signalBridge.updateUserGroupArn (BSL.toStrict . A.encode $ dto) + return () + else do + records <- getAllFromCache + traverse_ updatePerm records + where + updatePerm :: WebsocketRecord -> AppContextM () + updatePerm record = + case record.user of + user@LoggedOnlineUserInfo {uuid = uuid, role = role, groupUuids = groupUuids} -> do + when + (user.uuid `elem` userUuids) + ( do + let updatedRecord = record {user = user {groupUuids = filter (/= userGroupUuid) user.groupUuids}} + updateCache updatedRecord + ) + user@AnonymousOnlineUserInfo {..} -> return () + +setProject :: U.UUID -> ProjectDetailWsDTO -> AppContextM () +setProject projectUuid reqDto = do + currentTenantUuid <- asks currentTenantUuid + tenant <- findTenantByUuid currentTenantUuid + if isJust tenant.signalBridgeUrl + then do + serverConfig <- asks serverConfig + let dto = + AKM.fromList + [ ("projectUuid", A.String . U.toText $ projectUuid) + , ("tenantUuid", A.String . U.toText $ currentTenantUuid) + , ("message", A.toJSON reqDto) + ] + invokeLambda serverConfig.signalBridge.setProjectArn (BSL.toStrict . A.encode $ dto) + return () + else do + logWS U.nil "Informing other users about changed project" + records <- getAllFromCache + broadcast (U.toString projectUuid) records (toSetProjectMessage reqDto) disconnectUser + logWS U.nil "Informed completed" + +addFile :: U.UUID -> ProjectFileSimple -> AppContextM () +addFile projectUuid reqDto = do + currentTenantUuid <- asks currentTenantUuid + tenant <- findTenantByUuid currentTenantUuid + if isJust tenant.signalBridgeUrl + then do + serverConfig <- asks serverConfig + let dto = + AKM.fromList + [ ("projectUuid", A.String . U.toText $ projectUuid) + , ("tenantUuid", A.String . U.toText $ currentTenantUuid) + , ("message", A.toJSON reqDto) + ] + invokeLambda serverConfig.signalBridge.addFileArn (BSL.toStrict . A.encode $ dto) + return () + else do + logWS U.nil "Informing other users about added file" + records <- getAllFromCache + broadcast (U.toString projectUuid) records (toAddFileMessage reqDto) disconnectUser + logWS U.nil "Informed completed" + +logOutOnlineUsersWhenProjectDramaticallyChanged :: U.UUID -> AppContextM () +logOutOnlineUsersWhenProjectDramaticallyChanged projectUuid = do + currentTenantUuid <- asks currentTenantUuid + tenant <- findTenantByUuid currentTenantUuid + if isJust tenant.signalBridgeUrl + then do + serverConfig <- asks serverConfig + let dto = AKM.fromList [("projectUuid", U.toString projectUuid), ("tenantUuid", U.toString currentTenantUuid)] + invokeLambda serverConfig.signalBridge.logOutAllArn (BSL.toStrict . A.encode $ dto) + return () + else do + records <- getAllFromCache + let error = NotExistsError $ _ERROR_SERVICE_PROJECT_COLLABORATION__FORCE_DISCONNECT (U.toString projectUuid) + traverse_ (logOut error) records + where + logOut :: AppError -> WebsocketRecord -> AppContextM () + logOut error record = + when + (record.entityId == U.toString projectUuid) + (sendError record.connectionUuid record.connection record.entityId disconnectUser error) + +-- -------------------------------- +setContent :: U.UUID -> U.UUID -> ProjectEventChangeDTO -> AppContextM () +setContent projectUuid connectionUuid reqDto = + case reqDto of + SetReplyEventChangeDTO' event -> setReply projectUuid connectionUuid event + ClearReplyEventChangeDTO' event -> clearReply projectUuid connectionUuid event + SetPhaseEventChangeDTO' event -> setPhase projectUuid connectionUuid event + SetLabelsEventChangeDTO' event -> setLabel projectUuid connectionUuid event + ResolveCommentThreadEventChangeDTO' event -> resolveCommentThread projectUuid connectionUuid event + ReopenCommentThreadEventChangeDTO' event -> reopenCommentThread projectUuid connectionUuid event + AssignCommentThreadEventChangeDTO' event -> assignCommentThread projectUuid connectionUuid event + DeleteCommentThreadEventChangeDTO' event -> deleteCommentThread projectUuid connectionUuid event + AddCommentEventChangeDTO' event -> addComment projectUuid connectionUuid event + EditCommentEventChangeDTO' event -> editComment projectUuid connectionUuid event + DeleteCommentEventChangeDTO' event -> deleteComment projectUuid connectionUuid event + +setReply :: U.UUID -> U.UUID -> SetReplyEventChangeDTO -> AppContextM () +setReply projectUuid connectionUuid reqDto = do + myself <- getFromCache' connectionUuid + checkEditPermission myself + now <- liftIO getCurrentTime + tenantUuid <- asks currentTenantUuid + let mCreatedBy = getMaybeCreatedBy myself + let mCreatedByUuid = getMaybeCreatedByUuid myself + insertProjectEventWithTimestampUpdate + projectUuid + (fromEventChangeDTO (SetReplyEventChangeDTO' reqDto) projectUuid tenantUuid mCreatedByUuid now) + let resDto = toSetReplyEventDTO' reqDto mCreatedBy now + records <- getAllFromCache + broadcast (U.toString projectUuid) records (toSetReplyMessage resDto) disconnectUser + +clearReply :: U.UUID -> U.UUID -> ClearReplyEventChangeDTO -> AppContextM () +clearReply projectUuid connectionUuid reqDto = do + myself <- getFromCache' connectionUuid + checkEditPermission myself + now <- liftIO getCurrentTime + tenantUuid <- asks currentTenantUuid + let mCreatedBy = getMaybeCreatedBy myself + let mCreatedByUuid = getMaybeCreatedByUuid myself + insertProjectEventWithTimestampUpdate + projectUuid + (fromEventChangeDTO (ClearReplyEventChangeDTO' reqDto) projectUuid tenantUuid mCreatedByUuid now) + let resDto = toClearReplyEventDTO' reqDto mCreatedBy now + records <- getAllFromCache + broadcast (U.toString projectUuid) records (toClearReplyMessage resDto) disconnectUser + +setPhase :: U.UUID -> U.UUID -> SetPhaseEventChangeDTO -> AppContextM () +setPhase projectUuid connectionUuid reqDto = do + myself <- getFromCache' connectionUuid + checkEditPermission myself + now <- liftIO getCurrentTime + tenantUuid <- asks currentTenantUuid + let mCreatedBy = getMaybeCreatedBy myself + let mCreatedByUuid = getMaybeCreatedByUuid myself + insertProjectEventWithTimestampUpdate + projectUuid + (fromEventChangeDTO (SetPhaseEventChangeDTO' reqDto) projectUuid tenantUuid mCreatedByUuid now) + let resDto = toSetPhaseEventDTO' reqDto mCreatedBy now + records <- getAllFromCache + broadcast (U.toString projectUuid) records (toSetPhaseMessage resDto) disconnectUser + +setLabel :: U.UUID -> U.UUID -> SetLabelsEventChangeDTO -> AppContextM () +setLabel projectUuid connectionUuid reqDto = do + myself <- getFromCache' connectionUuid + checkEditPermission myself + now <- liftIO getCurrentTime + tenantUuid <- asks currentTenantUuid + let mCreatedBy = getMaybeCreatedBy myself + let mCreatedByUuid = getMaybeCreatedByUuid myself + insertProjectEventWithTimestampUpdate projectUuid (fromEventChangeDTO (SetLabelsEventChangeDTO' reqDto) projectUuid tenantUuid mCreatedByUuid now) + let resDto = toSetLabelsEventDTO' reqDto mCreatedBy now + records <- getAllFromCache + broadcast (U.toString projectUuid) records (toSetLabelMessage resDto) disconnectUser + +resolveCommentThread :: U.UUID -> U.UUID -> ResolveCommentThreadEventChangeDTO -> AppContextM () +resolveCommentThread projectUuid connectionUuid reqDto = do + myself <- getFromCache' connectionUuid + checkCommentPermission myself + now <- liftIO getCurrentTime + let mCreatedBy = getMaybeCreatedBy myself + let mCreatedByUuid = getMaybeCreatedByUuid myself + updateProjectCommentThreadResolvedById reqDto.threadUuid True + let resDto = toResolveCommentThreadEventDTO' reqDto mCreatedBy now + records <- getAllFromCache + let filteredRecords = + if reqDto.private + then filterEditors records + else filterCommenters records + broadcast (U.toString projectUuid) filteredRecords (toResolveCommentThreadMessage resDto) disconnectUser + +reopenCommentThread :: U.UUID -> U.UUID -> ReopenCommentThreadEventChangeDTO -> AppContextM () +reopenCommentThread projectUuid connectionUuid reqDto = do + myself <- getFromCache' connectionUuid + checkCommentPermission myself + now <- liftIO getCurrentTime + let mCreatedBy = getMaybeCreatedBy myself + let mCreatedByUuid = getMaybeCreatedByUuid myself + updateProjectCommentThreadResolvedById reqDto.threadUuid False + let resDto = toReopenCommentThreadEventDTO' reqDto mCreatedBy now + records <- getAllFromCache + let filteredRecords = + if reqDto.private + then filterEditors records + else filterCommenters records + broadcast (U.toString projectUuid) filteredRecords (toReopenCommentThreadMessage resDto) disconnectUser + +assignCommentThread :: U.UUID -> U.UUID -> AssignCommentThreadEventChangeDTO -> AppContextM () +assignCommentThread projectUuid connectionUuid reqDto = do + myself <- getFromCache' connectionUuid + checkCommentPermission myself + now <- liftIO getCurrentTime + let mCreatedBy = getMaybeCreatedBy myself + let mCreatedByUuid = getMaybeCreatedByUuid myself + updateProjectCommentThreadAssignee reqDto.threadUuid (fmap (.uuid) reqDto.assignedTo) mCreatedByUuid + let resDto = toAssignCommentThreadEventDTO' reqDto mCreatedBy now + records <- getAllFromCache + let filteredRecords = + if reqDto.private + then filterEditors records + else filterCommenters records + broadcast (U.toString projectUuid) filteredRecords (toAssignCommentThreadMessage resDto) disconnectUser + +deleteCommentThread :: U.UUID -> U.UUID -> DeleteCommentThreadEventChangeDTO -> AppContextM () +deleteCommentThread projectUuid connectionUuid reqDto = do + myself <- getFromCache' connectionUuid + checkCommentPermission myself + now <- liftIO getCurrentTime + let mCreatedBy = getMaybeCreatedBy myself + let mCreatedByUuid = getMaybeCreatedByUuid myself + deleteProjectCommentsByThreadUuid reqDto.threadUuid + deleteProjectCommentThreadById reqDto.threadUuid + let resDto = toDeleteCommentThreadEventDTO' reqDto mCreatedBy now + records <- getAllFromCache + let filteredRecords = + if reqDto.private + then filterEditors records + else filterCommenters records + broadcast (U.toString projectUuid) filteredRecords (toDeleteCommentThreadMessage resDto) disconnectUser + +addComment :: U.UUID -> U.UUID -> AddCommentEventChangeDTO -> AppContextM () +addComment projectUuid connectionUuid reqDto = do + myself <- getFromCache' connectionUuid + checkCommentPermission myself + tenantUuid <- asks currentTenantUuid + now <- liftIO getCurrentTime + let mCreatedBy = getMaybeCreatedBy myself + let mCreatedByUuid = getMaybeCreatedByUuid myself + let comment = toComment reqDto tenantUuid mCreatedByUuid now + if reqDto.newThread + then do + let thread = toCommentThread reqDto projectUuid tenantUuid mCreatedByUuid now + insertProjectThreadAndComment thread comment + else insertProjectComment comment + let resDto = toAddCommentEventDTO' reqDto mCreatedBy now + records <- getAllFromCache + let filteredRecords = + if reqDto.private + then filterEditors records + else filterCommenters records + broadcast (U.toString projectUuid) filteredRecords (toAddCommentMessage resDto) disconnectUser + +editComment :: U.UUID -> U.UUID -> EditCommentEventChangeDTO -> AppContextM () +editComment projectUuid connectionUuid reqDto = do + myself <- getFromCache' connectionUuid + checkCommentPermission myself + now <- liftIO getCurrentTime + let mCreatedBy = getMaybeCreatedBy myself + let mCreatedByUuid = getMaybeCreatedByUuid myself + updateProjectCommentTextById reqDto.commentUuid reqDto.text + let resDto = toEditCommentEventDTO' reqDto mCreatedBy now + records <- getAllFromCache + let filteredRecords = + if reqDto.private + then filterEditors records + else filterCommenters records + broadcast (U.toString projectUuid) filteredRecords (toEditCommentMessage resDto) disconnectUser + +deleteComment :: U.UUID -> U.UUID -> DeleteCommentEventChangeDTO -> AppContextM () +deleteComment projectUuid connectionUuid reqDto = do + myself <- getFromCache' connectionUuid + checkCommentPermission myself + now <- liftIO getCurrentTime + let mCreatedBy = getMaybeCreatedBy myself + let mCreatedByUuid = getMaybeCreatedByUuid myself + deleteProjectCommentById reqDto.commentUuid + let resDto = toDeleteCommentEventDTO' reqDto mCreatedBy now + records <- getAllFromCache + let filteredRecords = + if reqDto.private + then filterEditors records + else filterCommenters records + broadcast (U.toString projectUuid) filteredRecords (toDeleteCommentMessage resDto) disconnectUser + +-- -------------------------------- +-- PRIVATE +-- -------------------------------- +disconnectUser :: A.ToJSON resDto => WebsocketMessage resDto -> AppContextM () +disconnectUser msg = deleteUser (u' msg.entityId) msg.connectionUuid + +disconnectUserIfLostPermission :: WebsocketRecord -> AppContextM () +disconnectUserIfLostPermission record = catchError (checkViewPermission record) handleError + where + handleError = sendError record.connectionUuid record.connection record.entityId disconnectUser + +createProjectRecord :: U.UUID -> Connection -> U.UUID -> AppContextM WebsocketRecord +createProjectRecord connectionUuid connection projectUuid = do + mCurrentUser <- asks currentUser + project <- findProjectByUuid projectUuid + userGroupUuids <- + case mCurrentUser of + Just currentUser -> do + userGroupMemberships <- findUserGroupMembershipsByUserUuid currentUser.uuid + return . fmap (.userGroupUuid) $ userGroupMemberships + Nothing -> return [] + let permission = + getPermission + project.visibility + project.sharing + project.permissions + (fmap (.uuid) mCurrentUser) + (fmap (.uRole) mCurrentUser) + userGroupUuids + createRecord connectionUuid connection (U.toString projectUuid) permission userGroupUuids + +getMaybeCreatedBy :: WebsocketRecord -> Maybe UserSuggestion +getMaybeCreatedBy myself = + case myself.user of + u@LoggedOnlineUserInfo + { uuid = uuid + , firstName = firstName + , lastName = lastName + , gravatarHash = gravatarHash + , imageUrl = imageUrl + } -> + Just $ + UserSuggestion + { uuid = uuid + , firstName = firstName + , lastName = lastName + , gravatarHash = gravatarHash + , imageUrl = imageUrl + } + u@AnonymousOnlineUserInfo {..} -> Nothing + +getMaybeCreatedByUuid :: WebsocketRecord -> Maybe U.UUID +getMaybeCreatedByUuid myself = + case myself.user of + u@LoggedOnlineUserInfo {uuid = uuid} -> Just uuid + u@AnonymousOnlineUserInfo {..} -> Nothing diff --git a/wizard-server/src/Wizard/Service/Project/Comment/ProjectCommentMapper.hs b/wizard-server/src/Wizard/Service/Project/Comment/ProjectCommentMapper.hs new file mode 100644 index 000000000..4841f50f3 --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/Comment/ProjectCommentMapper.hs @@ -0,0 +1,80 @@ +module Wizard.Service.Project.Comment.ProjectCommentMapper where + +import qualified Data.Map.Strict as M +import Data.Time +import qualified Data.UUID as U + +import Wizard.Api.Resource.Project.Event.ProjectEventChangeDTO +import Wizard.Model.Project.Comment.ProjectComment +import Wizard.Model.Project.Comment.ProjectCommentList +import Wizard.Model.User.User +import qualified Wizard.Service.User.UserMapper as UM + +toCommentThreadsMap :: [ProjectCommentThreadList] -> M.Map String [ProjectCommentThreadList] +toCommentThreadsMap = foldl go M.empty + where + go + :: M.Map String [ProjectCommentThreadList] + -> ProjectCommentThreadList + -> M.Map String [ProjectCommentThreadList] + go commentThreadsMap thread = + let threads = + case M.lookup thread.path commentThreadsMap of + Nothing -> [] + Just [] -> [] + Just threads -> threads + in M.insert thread.path (thread : threads) commentThreadsMap + +toCommentThreadList :: ProjectCommentThread -> Maybe User -> Maybe User -> [ProjectCommentList] -> ProjectCommentThreadList +toCommentThreadList thread mAssignedTo mCreatedBy comments = + ProjectCommentThreadList + { uuid = thread.uuid + , path = thread.path + , resolved = thread.resolved + , comments = comments + , private = thread.private + , assignedTo = fmap (UM.toSuggestion . UM.toSimple) mAssignedTo + , createdBy = fmap (UM.toSuggestion . UM.toSimple) mCreatedBy + , createdAt = thread.createdAt + , updatedAt = thread.updatedAt + } + +toCommentThread :: AddCommentEventChangeDTO -> U.UUID -> U.UUID -> Maybe U.UUID -> UTCTime -> ProjectCommentThread +toCommentThread event projectUuid tenantUuid mCreatedByUuid now = + ProjectCommentThread + { uuid = event.threadUuid + , path = event.path + , resolved = False + , comments = [] + , private = event.private + , projectUuid = projectUuid + , tenantUuid = tenantUuid + , assignedTo = Nothing + , assignedBy = Nothing + , notificationRequired = False + , createdBy = mCreatedByUuid + , createdAt = now + , updatedAt = now + } + +toCommentList :: ProjectComment -> Maybe User -> ProjectCommentList +toCommentList comment mUser = + ProjectCommentList + { uuid = comment.uuid + , text = comment.text + , createdBy = fmap (UM.toSuggestion . UM.toSimple) mUser + , createdAt = comment.createdAt + , updatedAt = comment.updatedAt + } + +toComment :: AddCommentEventChangeDTO -> U.UUID -> Maybe U.UUID -> UTCTime -> ProjectComment +toComment event tenantUuid mCreatedByUuid now = + ProjectComment + { uuid = event.commentUuid + , text = event.text + , threadUuid = event.threadUuid + , tenantUuid = tenantUuid + , createdBy = mCreatedByUuid + , createdAt = now + , updatedAt = now + } diff --git a/wizard-server/src/Wizard/Service/Project/Comment/ProjectCommentService.hs b/wizard-server/src/Wizard/Service/Project/Comment/ProjectCommentService.hs new file mode 100644 index 000000000..2f6e99dec --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/Comment/ProjectCommentService.hs @@ -0,0 +1,77 @@ +module Wizard.Service.Project.Comment.ProjectCommentService where + +import Control.Monad.Except (catchError) +import Control.Monad.Reader (liftIO) +import Data.Foldable (traverse_) +import qualified Data.Map.Strict as M +import qualified Data.UUID as U + +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.List +import Shared.Common.Util.Uuid +import Wizard.Constant.Acl +import Wizard.Database.DAO.Common +import Wizard.Database.DAO.Project.ProjectCommentDAO +import Wizard.Database.DAO.Project.ProjectCommentThreadDAO +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Comment.ProjectComment +import Wizard.Model.Project.Comment.ProjectCommentList +import Wizard.Model.Project.Comment.ProjectCommentThreadAssigned +import Wizard.Model.Project.Comment.ProjectCommentThreadNotification +import Wizard.Model.Project.Project +import Wizard.Service.Mail.Mailer +import Wizard.Service.Project.Comment.ProjectCommentMapper +import Wizard.Service.Project.ProjectAcl +import WizardLib.Public.Model.User.UserSimple + +getProjectCommentThreadsPage :: Maybe String -> Maybe U.UUID -> Maybe Bool -> Pageable -> [Sort] -> AppContextM (Page ProjectCommentThreadAssigned) +getProjectCommentThreadsPage mQuery mProjectUuid resolved pageable sort = do + checkPermission _PRJ_PERM + findAssignedProjectCommentThreadsPage mQuery mProjectUuid resolved pageable sort + +getProjectCommentsByProjectUuid :: U.UUID -> Maybe String -> Maybe Bool -> AppContextM (M.Map String [ProjectCommentThreadList]) +getProjectCommentsByProjectUuid projectUuid mPath mResolved = do + project <- findProjectByUuid projectUuid + checkCommentPermissionToProject project.visibility project.sharing project.permissions + editor <- catchError (hasEditPermissionToProject project.visibility project.sharing project.permissions) (\_ -> return False) + threads <- findProjectCommentThreadsForProject project.uuid mPath mResolved editor + return . toCommentThreadsMap $ threads + +duplicateCommentThreads :: U.UUID -> U.UUID -> AppContextM () +duplicateCommentThreads oldProjectUuid newProjectUuid = do + threads <- findProjectCommentThreads oldProjectUuid + traverse_ (duplicateCommentThread newProjectUuid) threads + +duplicateCommentThread :: U.UUID -> ProjectCommentThread -> AppContextM () +duplicateCommentThread newProjectUuid thread = do + newUuid <- liftIO generateUuid + let updatedCommentThread = + thread + { uuid = newUuid + , projectUuid = newProjectUuid + } + insertProjectCommentThread updatedCommentThread + traverse_ (duplicateComment newUuid) thread.comments + +duplicateComment :: U.UUID -> ProjectComment -> AppContextM () +duplicateComment newThreadUuid comment = do + newUuid <- liftIO generateUuid + let updatedComment = + comment + { uuid = newUuid + , threadUuid = newThreadUuid + } + insertProjectComment updatedComment + return () + +sendNotificationToNewAssignees :: AppContextM () +sendNotificationToNewAssignees = + runInTransaction $ do + threads <- findProjectCommentThreadsForNotifying + let threadGroups = groupBy (\t1 t2 -> t1.assignedTo.uuid == t2.assignedTo.uuid && t1.tenantUuid == t2.tenantUuid) threads + traverse_ sendProjectCommentThreadAssignedMail threadGroups + unsetProjectCommentThreadNotificationRequired diff --git a/wizard-server/src/Wizard/Service/Project/Compiler/ProjectCompilerService.hs b/wizard-server/src/Wizard/Service/Project/Compiler/ProjectCompilerService.hs new file mode 100644 index 000000000..7bc7a4dfd --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/Compiler/ProjectCompilerService.hs @@ -0,0 +1,22 @@ +module Wizard.Service.Project.Compiler.ProjectCompilerService where + +import qualified Data.Map.Strict as M + +import Wizard.Model.Project.Event.ProjectEventList +import Wizard.Model.Project.ProjectContent +import Wizard.Model.Project.ProjectContentDM +import Wizard.Service.Project.Event.ProjectEventMapper + +compileProjectEvents :: [ProjectEventList] -> ProjectContent +compileProjectEvents = foldl applyEvent defaultProjectContent + +applyEvent :: ProjectContent -> ProjectEventList -> ProjectContent +applyEvent projectContent (SetReplyEventList' event) = projectContent {replies = M.insert event.path (toReply' event) projectContent.replies} +applyEvent projectContent (ClearReplyEventList' event) = projectContent {replies = M.delete event.path projectContent.replies} +applyEvent projectContent (SetPhaseEventList' event) = projectContent {phaseUuid = event.phaseUuid} +applyEvent projectContent (SetLabelsEventList' event) = + projectContent + { labels = case event.value of + [] -> M.delete event.path projectContent.labels + newValue -> M.insert event.path newValue projectContent.labels + } diff --git a/wizard-server/src/Wizard/Service/Project/Event/ProjectEventMapper.hs b/wizard-server/src/Wizard/Service/Project/Event/ProjectEventMapper.hs new file mode 100644 index 000000000..7212353fa --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/Event/ProjectEventMapper.hs @@ -0,0 +1,400 @@ +module Wizard.Service.Project.Event.ProjectEventMapper where + +import Data.Time +import qualified Data.UUID as U + +import Wizard.Api.Resource.Project.Event.ProjectEventChangeDTO +import Wizard.Api.Resource.Project.Event.ProjectEventDTO +import Wizard.Model.Project.Event.ProjectEvent +import Wizard.Model.Project.Event.ProjectEventList +import Wizard.Model.Project.ProjectReply +import Wizard.Model.User.User +import qualified Wizard.Service.User.UserMapper as UM +import WizardLib.Public.Model.User.UserSuggestion + +toEventDTO :: ProjectEvent -> Maybe User -> ProjectEventDTO +toEventDTO event' mCreatedBy = + case event' of + SetReplyEvent' event@SetReplyEvent {..} -> SetReplyEventDTO' $ toSetReplyEventDTO event mCreatedBy + ClearReplyEvent' event@ClearReplyEvent {..} -> ClearReplyEventDTO' $ toClearReplyEventDTO event mCreatedBy + SetPhaseEvent' event@SetPhaseEvent {..} -> SetPhaseEventDTO' $ toSetPhaseEventDTO event mCreatedBy + SetLabelsEvent' event@SetLabelsEvent {..} -> SetLabelsEventDTO' $ toSetLabelsEventDTO event mCreatedBy + +toEventList :: ProjectEvent -> Maybe User -> ProjectEventList +toEventList event' mCreatedBy = + case event' of + SetReplyEvent' event@SetReplyEvent {..} -> SetReplyEventList' $ toSetReplyEventList event mCreatedBy + ClearReplyEvent' event@ClearReplyEvent {..} -> ClearReplyEventList' $ toClearReplyEventList event mCreatedBy + SetPhaseEvent' event@SetPhaseEvent {..} -> SetPhaseEventList' $ toSetPhaseEventList event mCreatedBy + SetLabelsEvent' event@SetLabelsEvent {..} -> SetLabelsEventList' $ toSetLabelsEventList event mCreatedBy + +toEvent :: U.UUID -> U.UUID -> ProjectEventList -> ProjectEvent +toEvent projectUuid tenantUuid event' = + case event' of + SetReplyEventList' event@SetReplyEventList {..} -> SetReplyEvent' $ toSetReplyEvent projectUuid tenantUuid event + ClearReplyEventList' event@ClearReplyEventList {..} -> ClearReplyEvent' $ toClearReplyEvent projectUuid tenantUuid event + SetPhaseEventList' event@SetPhaseEventList {..} -> SetPhaseEvent' $ toSetPhaseEvent projectUuid tenantUuid event + SetLabelsEventList' event@SetLabelsEventList {..} -> SetLabelsEvent' $ toSetLabelsEvent projectUuid tenantUuid event + +toSetReplyEventDTO :: SetReplyEvent -> Maybe User -> SetReplyEventDTO +toSetReplyEventDTO event user = + SetReplyEventDTO + { uuid = event.uuid + , path = event.path + , value = event.value + , createdBy = fmap (UM.toSuggestion . UM.toSimple) user + , createdAt = event.createdAt + } + +toSetReplyEventList :: SetReplyEvent -> Maybe User -> SetReplyEventList +toSetReplyEventList event user = + SetReplyEventList + { uuid = event.uuid + , path = event.path + , value = event.value + , createdBy = fmap (UM.toSuggestion . UM.toSimple) user + , createdAt = event.createdAt + } + +toSetReplyEvent :: U.UUID -> U.UUID -> SetReplyEventList -> SetReplyEvent +toSetReplyEvent projectUuid tenantUuid event = + SetReplyEvent + { uuid = event.uuid + , path = event.path + , value = event.value + , projectUuid = projectUuid + , tenantUuid = tenantUuid + , createdBy = fmap (.uuid) event.createdBy + , createdAt = event.createdAt + } + +toClearReplyEventDTO :: ClearReplyEvent -> Maybe User -> ClearReplyEventDTO +toClearReplyEventDTO event user = + ClearReplyEventDTO + { uuid = event.uuid + , path = event.path + , createdBy = fmap (UM.toSuggestion . UM.toSimple) user + , createdAt = event.createdAt + } + +toClearReplyEventList :: ClearReplyEvent -> Maybe User -> ClearReplyEventList +toClearReplyEventList event user = + ClearReplyEventList + { uuid = event.uuid + , path = event.path + , createdBy = fmap (UM.toSuggestion . UM.toSimple) user + , createdAt = event.createdAt + } + +toClearReplyEvent :: U.UUID -> U.UUID -> ClearReplyEventList -> ClearReplyEvent +toClearReplyEvent projectUuid tenantUuid event = + ClearReplyEvent + { uuid = event.uuid + , path = event.path + , projectUuid = projectUuid + , tenantUuid = tenantUuid + , createdBy = fmap (.uuid) event.createdBy + , createdAt = event.createdAt + } + +toSetPhaseEventDTO :: SetPhaseEvent -> Maybe User -> SetPhaseEventDTO +toSetPhaseEventDTO event user = + SetPhaseEventDTO + { uuid = event.uuid + , phaseUuid = event.phaseUuid + , createdBy = fmap (UM.toSuggestion . UM.toSimple) user + , createdAt = event.createdAt + } + +toSetPhaseEventList :: SetPhaseEvent -> Maybe User -> SetPhaseEventList +toSetPhaseEventList event user = + SetPhaseEventList + { uuid = event.uuid + , phaseUuid = event.phaseUuid + , createdBy = fmap (UM.toSuggestion . UM.toSimple) user + , createdAt = event.createdAt + } + +toSetPhaseEvent :: U.UUID -> U.UUID -> SetPhaseEventList -> SetPhaseEvent +toSetPhaseEvent projectUuid tenantUuid event = + SetPhaseEvent + { uuid = event.uuid + , phaseUuid = event.phaseUuid + , projectUuid = projectUuid + , tenantUuid = tenantUuid + , createdBy = fmap (.uuid) event.createdBy + , createdAt = event.createdAt + } + +toSetLabelsEventDTO :: SetLabelsEvent -> Maybe User -> SetLabelsEventDTO +toSetLabelsEventDTO event user = + SetLabelsEventDTO + { uuid = event.uuid + , path = event.path + , value = event.value + , createdBy = fmap (UM.toSuggestion . UM.toSimple) user + , createdAt = event.createdAt + } + +toSetLabelsEventList :: SetLabelsEvent -> Maybe User -> SetLabelsEventList +toSetLabelsEventList event user = + SetLabelsEventList + { uuid = event.uuid + , path = event.path + , value = event.value + , createdBy = fmap (UM.toSuggestion . UM.toSimple) user + , createdAt = event.createdAt + } + +toSetLabelsEvent :: U.UUID -> U.UUID -> SetLabelsEventList -> SetLabelsEvent +toSetLabelsEvent projectUuid tenantUuid event = + SetLabelsEvent + { uuid = event.uuid + , path = event.path + , value = event.value + , projectUuid = projectUuid + , tenantUuid = tenantUuid + , createdBy = fmap (.uuid) event.createdBy + , createdAt = event.createdAt + } + +-- --------------------------------------------------------------------------------------------------------------------- +-- --------------------------------------------------------------------------------------------------------------------- +toSetReplyEventDTO' :: SetReplyEventChangeDTO -> Maybe UserSuggestion -> UTCTime -> SetReplyEventDTO +toSetReplyEventDTO' event mCreatedBy now = + SetReplyEventDTO + { uuid = event.uuid + , path = event.path + , value = event.value + , createdBy = mCreatedBy + , createdAt = now + } + +toClearReplyEventDTO' :: ClearReplyEventChangeDTO -> Maybe UserSuggestion -> UTCTime -> ClearReplyEventDTO +toClearReplyEventDTO' event mCreatedBy now = + ClearReplyEventDTO + { uuid = event.uuid + , path = event.path + , createdBy = mCreatedBy + , createdAt = now + } + +toSetPhaseEventDTO' :: SetPhaseEventChangeDTO -> Maybe UserSuggestion -> UTCTime -> SetPhaseEventDTO +toSetPhaseEventDTO' event mCreatedBy now = + SetPhaseEventDTO + { uuid = event.uuid + , phaseUuid = event.phaseUuid + , createdBy = mCreatedBy + , createdAt = now + } + +toSetLabelsEventDTO' :: SetLabelsEventChangeDTO -> Maybe UserSuggestion -> UTCTime -> SetLabelsEventDTO +toSetLabelsEventDTO' event mCreatedBy now = + SetLabelsEventDTO + { uuid = event.uuid + , path = event.path + , value = event.value + , createdBy = mCreatedBy + , createdAt = now + } + +toResolveCommentThreadEventDTO' + :: ResolveCommentThreadEventChangeDTO -> Maybe UserSuggestion -> UTCTime -> ResolveCommentThreadEventDTO +toResolveCommentThreadEventDTO' event mCreatedBy now = + ResolveCommentThreadEventDTO + { uuid = event.uuid + , path = event.path + , threadUuid = event.threadUuid + , commentCount = event.commentCount + , createdBy = mCreatedBy + , createdAt = now + } + +toReopenCommentThreadEventDTO' + :: ReopenCommentThreadEventChangeDTO -> Maybe UserSuggestion -> UTCTime -> ReopenCommentThreadEventDTO +toReopenCommentThreadEventDTO' event mCreatedBy now = + ReopenCommentThreadEventDTO + { uuid = event.uuid + , path = event.path + , threadUuid = event.threadUuid + , commentCount = event.commentCount + , createdBy = mCreatedBy + , createdAt = now + } + +toAssignCommentThreadEventDTO' :: AssignCommentThreadEventChangeDTO -> Maybe UserSuggestion -> UTCTime -> AssignCommentThreadEventDTO +toAssignCommentThreadEventDTO' event mCreatedBy now = + AssignCommentThreadEventDTO + { uuid = event.uuid + , path = event.path + , threadUuid = event.threadUuid + , private = event.private + , assignedTo = event.assignedTo + , createdBy = mCreatedBy + , createdAt = now + } + +toDeleteCommentThreadEventDTO' + :: DeleteCommentThreadEventChangeDTO -> Maybe UserSuggestion -> UTCTime -> DeleteCommentThreadEventDTO +toDeleteCommentThreadEventDTO' event mCreatedBy now = + DeleteCommentThreadEventDTO + { uuid = event.uuid + , path = event.path + , threadUuid = event.threadUuid + , createdBy = mCreatedBy + , createdAt = now + } + +toAddCommentEventDTO' :: AddCommentEventChangeDTO -> Maybe UserSuggestion -> UTCTime -> AddCommentEventDTO +toAddCommentEventDTO' event mCreatedBy now = + AddCommentEventDTO + { uuid = event.uuid + , path = event.path + , threadUuid = event.threadUuid + , commentUuid = event.commentUuid + , text = event.text + , private = event.private + , createdBy = mCreatedBy + , createdAt = now + } + +toEditCommentEventDTO' :: EditCommentEventChangeDTO -> Maybe UserSuggestion -> UTCTime -> EditCommentEventDTO +toEditCommentEventDTO' event mCreatedBy now = + EditCommentEventDTO + { uuid = event.uuid + , path = event.path + , threadUuid = event.threadUuid + , commentUuid = event.commentUuid + , text = event.text + , createdBy = mCreatedBy + , createdAt = now + } + +toDeleteCommentEventDTO' :: DeleteCommentEventChangeDTO -> Maybe UserSuggestion -> UTCTime -> DeleteCommentEventDTO +toDeleteCommentEventDTO' event mCreatedBy now = + DeleteCommentEventDTO + { uuid = event.uuid + , path = event.path + , threadUuid = event.threadUuid + , commentUuid = event.commentUuid + , createdBy = mCreatedBy + , createdAt = now + } + +-- --------------------------------------------------------------------------------------------------------------------- +-- --------------------------------------------------------------------------------------------------------------------- +toEventChangeDTO :: ProjectEvent -> ProjectEventChangeDTO +toEventChangeDTO event = + case event of + SetReplyEvent' event@SetReplyEvent {..} -> + SetReplyEventChangeDTO' $ toSetReplyEventChangeDTO event + ClearReplyEvent' event@ClearReplyEvent {..} -> + ClearReplyEventChangeDTO' $ toClearReplyEventChangeDTO event + SetPhaseEvent' event@SetPhaseEvent {..} -> + SetPhaseEventChangeDTO' $ toSetPhaseEventChangeDTO event + SetLabelsEvent' event@SetLabelsEvent {..} -> + SetLabelsEventChangeDTO' $ toSetLabelsEventChangeDTO event + +toSetReplyEventChangeDTO :: SetReplyEvent -> SetReplyEventChangeDTO +toSetReplyEventChangeDTO event = + SetReplyEventChangeDTO + { uuid = event.uuid + , path = event.path + , value = event.value + } + +toClearReplyEventChangeDTO :: ClearReplyEvent -> ClearReplyEventChangeDTO +toClearReplyEventChangeDTO event = + ClearReplyEventChangeDTO + { uuid = event.uuid + , path = event.path + } + +toSetPhaseEventChangeDTO :: SetPhaseEvent -> SetPhaseEventChangeDTO +toSetPhaseEventChangeDTO event = + SetPhaseEventChangeDTO + { uuid = event.uuid + , phaseUuid = event.phaseUuid + } + +toSetLabelsEventChangeDTO :: SetLabelsEvent -> SetLabelsEventChangeDTO +toSetLabelsEventChangeDTO event = + SetLabelsEventChangeDTO + { uuid = event.uuid + , path = event.path + , value = event.value + } + +-- --------------------------------------------------------------------------------------------------------------------- +-- --------------------------------------------------------------------------------------------------------------------- +fromEventChangeDTO :: ProjectEventChangeDTO -> U.UUID -> U.UUID -> Maybe U.UUID -> UTCTime -> ProjectEvent +fromEventChangeDTO event projectUuid tenantUuid createdBy now = + case event of + SetReplyEventChangeDTO' event@SetReplyEventChangeDTO {..} -> + SetReplyEvent' $ fromSetReplyEventChangeDTO event projectUuid tenantUuid createdBy now + ClearReplyEventChangeDTO' event@ClearReplyEventChangeDTO {..} -> + ClearReplyEvent' $ fromClearReplyEventChangeDTO event projectUuid tenantUuid createdBy now + SetPhaseEventChangeDTO' event@SetPhaseEventChangeDTO {..} -> + SetPhaseEvent' $ fromSetPhaseEventChangeDTO event projectUuid tenantUuid createdBy now + SetLabelsEventChangeDTO' event@SetLabelsEventChangeDTO {..} -> + SetLabelsEvent' $ fromSetLabelsEventChangeDTO event projectUuid tenantUuid createdBy now + _ -> error "Unsupported event type in fromEventChangeDTO" + +fromSetReplyEventChangeDTO :: SetReplyEventChangeDTO -> U.UUID -> U.UUID -> Maybe U.UUID -> UTCTime -> SetReplyEvent +fromSetReplyEventChangeDTO event projectUuid tenantUuid createdBy now = + SetReplyEvent + { uuid = event.uuid + , path = event.path + , value = event.value + , projectUuid = projectUuid + , tenantUuid = tenantUuid + , createdBy = createdBy + , createdAt = now + } + +fromClearReplyEventChangeDTO :: ClearReplyEventChangeDTO -> U.UUID -> U.UUID -> Maybe U.UUID -> UTCTime -> ClearReplyEvent +fromClearReplyEventChangeDTO event projectUuid tenantUuid createdBy now = + ClearReplyEvent + { uuid = event.uuid + , path = event.path + , projectUuid = projectUuid + , tenantUuid = tenantUuid + , createdBy = createdBy + , createdAt = now + } + +fromSetPhaseEventChangeDTO :: SetPhaseEventChangeDTO -> U.UUID -> U.UUID -> Maybe U.UUID -> UTCTime -> SetPhaseEvent +fromSetPhaseEventChangeDTO event projectUuid tenantUuid createdBy now = + SetPhaseEvent + { uuid = event.uuid + , phaseUuid = event.phaseUuid + , projectUuid = projectUuid + , tenantUuid = tenantUuid + , createdBy = createdBy + , createdAt = now + } + +fromSetLabelsEventChangeDTO :: SetLabelsEventChangeDTO -> U.UUID -> U.UUID -> Maybe U.UUID -> UTCTime -> SetLabelsEvent +fromSetLabelsEventChangeDTO event projectUuid tenantUuid createdBy now = + SetLabelsEvent + { uuid = event.uuid + , path = event.path + , value = event.value + , projectUuid = projectUuid + , tenantUuid = tenantUuid + , createdBy = createdBy + , createdAt = now + } + +-- --------------------------------------------------------------------------------------------------------------------- +-- --------------------------------------------------------------------------------------------------------------------- +toReply :: SetReplyEvent -> Maybe User -> Reply +toReply event mUser = + Reply + { value = event.value + , createdBy = fmap (UM.toSuggestion . UM.toSimple) mUser + , createdAt = event.createdAt + } + +toReply' :: SetReplyEventList -> Reply +toReply' SetReplyEventList {..} = Reply {..} diff --git a/wizard-server/src/Wizard/Service/Project/Event/ProjectEventService.hs b/wizard-server/src/Wizard/Service/Project/Event/ProjectEventService.hs new file mode 100644 index 000000000..45ff43228 --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/Event/ProjectEventService.hs @@ -0,0 +1,64 @@ +module Wizard.Service.Project.Event.ProjectEventService where + +import Data.Foldable (traverse_) +import qualified Data.List as L +import qualified Data.Map.Strict as M +import Data.Time +import qualified Data.UUID as U + +import Shared.Common.Model.Common.Lens +import Shared.Common.Util.List (groupBy) +import Shared.Common.Util.Logger +import Wizard.Database.DAO.Common +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectEventDAO +import Wizard.Database.DAO.Project.ProjectVersionDAO +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Event.ProjectEvent +import Wizard.Model.Project.Version.ProjectVersion + +squashProjectEvents :: AppContextM () +squashProjectEvents = do + projectUuids <- findProjectForSquashing + traverse_ squashProjectEventsForProject projectUuids + +squashProjectEventsForProject :: U.UUID -> AppContextM () +squashProjectEventsForProject projectUuid = + runInTransaction $ do + logInfoI _CMP_SERVICE (f' "Squashing events for project (projectUuid: '%s')" [U.toString projectUuid]) + events <- findProjectEventsByProjectUuid projectUuid + versions <- findProjectVersionsByProjectUuid projectUuid + let squashedEvents = squash versions events + syncProjectEventsWithDb events squashedEvents + updateProjectSquashedByUuid projectUuid True + logInfoI + _CMP_SERVICE + ( f' + "Squashing for project '%s' finished successfully (before: %s, after %s)" + [U.toString projectUuid, show . length $ events, show . length $ squashedEvents] + ) + +instance Ord ProjectEvent where + compare a b = compare (getCreatedAt a) (getCreatedAt b) + +squash :: [ProjectVersion] -> [ProjectEvent] -> [ProjectEvent] +squash versions events = + let groupedEvents = groupBy (\e1 e2 -> utctDay (getCreatedAt e1) == utctDay (getCreatedAt e2)) events + squashedEvents = fmap (squashOnePeriod versions) groupedEvents + in concat squashedEvents + +squashOnePeriod :: [ProjectVersion] -> [ProjectEvent] -> [ProjectEvent] +squashOnePeriod versions = snd . foldr go (M.empty, []) + where + go + :: ProjectEvent + -> (M.Map String (Maybe U.UUID), [ProjectEvent]) + -> (M.Map String (Maybe U.UUID), [ProjectEvent]) + go event' (questions, events) = + case event' of + SetReplyEvent' event -> + if not (L.any (\v -> v.eventUuid == event.uuid) versions) + && Just event.createdBy == M.lookup event.path questions + then (questions, events) + else (M.insert event.path event.createdBy questions, event' : events) + _ -> (questions, event' : events) diff --git a/wizard-server/src/Wizard/Service/Project/File/ProjectFileAcl.hs b/wizard-server/src/Wizard/Service/Project/File/ProjectFileAcl.hs new file mode 100644 index 000000000..5803c5c74 --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/File/ProjectFileAcl.hs @@ -0,0 +1,18 @@ +module Wizard.Service.Project.File.ProjectFileAcl where + +import qualified Data.UUID as U + +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Project +import Wizard.Service.Project.ProjectAcl + +checkViewPermissionToFile :: U.UUID -> AppContextM () +checkViewPermissionToFile projectUuid = do + project <- findProjectByUuid projectUuid + checkViewPermissionToProject project.visibility project.sharing project.permissions + +checkEditPermissionToFile :: U.UUID -> AppContextM () +checkEditPermissionToFile projectUuid = do + project <- findProjectByUuid projectUuid + checkEditPermissionToProject project.visibility project.sharing project.permissions diff --git a/wizard-server/src/Wizard/Service/Project/File/ProjectFileCommandExecutor.hs b/wizard-server/src/Wizard/Service/Project/File/ProjectFileCommandExecutor.hs new file mode 100644 index 000000000..2bd580f47 --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/File/ProjectFileCommandExecutor.hs @@ -0,0 +1,31 @@ +module Wizard.Service.Project.File.ProjectFileCommandExecutor where + +import Control.Monad.Except (throwError) +import Data.Aeson (eitherDecode) +import qualified Data.ByteString.Lazy.Char8 as BSL +import qualified Data.UUID as U + +import Shared.Common.Model.Error.Error +import Shared.Common.Util.Logger +import Shared.PersistentCommand.Model.PersistentCommand.PersistentCommand +import Wizard.Model.Context.AppContext +import Wizard.Model.PersistentCommand.Project.File.ProjectFileDeleteFromS3Command +import Wizard.S3.Project.ProjectFileS3 + +cComponent = "project_file" + +execute :: PersistentCommand U.UUID -> AppContextM (PersistentCommandState, Maybe String) +execute command + | command.function == cDeleteFromS3Name = cDeleteFromS3 command + | otherwise = throwError . GeneralServerError $ "Unknown command function: " <> command.function + +cDeleteFromS3Name = "deleteFromS3" + +cDeleteFromS3 :: PersistentCommand U.UUID -> AppContextM (PersistentCommandState, Maybe String) +cDeleteFromS3 persistentCommand = do + let eCommand = eitherDecode (BSL.pack persistentCommand.body) :: Either String ProjectFileDeleteFromS3Command + case eCommand of + Right command -> do + removeFile command.projectUuid command.fileUuid + return (DonePersistentCommandState, Nothing) + Left error -> return (ErrorPersistentCommandState, Just $ f' "Problem in deserialization of JSON: %s" [error]) diff --git a/wizard-server/src/Wizard/Service/Project/File/ProjectFileMapper.hs b/wizard-server/src/Wizard/Service/Project/File/ProjectFileMapper.hs new file mode 100644 index 000000000..df1055f4a --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/File/ProjectFileMapper.hs @@ -0,0 +1,48 @@ +module Wizard.Service.Project.File.ProjectFileMapper where + +import qualified Data.ByteString.Char8 as BS +import Data.Time +import qualified Data.UUID as U + +import Wizard.Api.Resource.File.FileCreateDTO +import Wizard.Api.Resource.User.UserDTO +import Wizard.Model.Project.File.ProjectFile +import Wizard.Model.Project.File.ProjectFileList +import Wizard.Model.Project.File.ProjectFileSimple +import Wizard.Model.Project.Project +import qualified Wizard.Service.Project.ProjectMapper as ProjectMapper +import qualified Wizard.Service.User.UserMapper as UserMapper + +toList :: ProjectFile -> Project -> Maybe UserDTO -> ProjectFileList +toList ProjectFile {..} project mCreatedBy = + ProjectFileList + { uuid = uuid + , fileName = fileName + , contentType = contentType + , fileSize = fileSize + , project = ProjectMapper.toSimple project + , createdBy = fmap UserMapper.toSuggestion' mCreatedBy + , createdAt = createdAt + } + +toSimple :: ProjectFile -> ProjectFileSimple +toSimple ProjectFile {..} = + ProjectFileSimple + { uuid = uuid + , fileName = fileName + , contentType = contentType + , fileSize = fileSize + } + +fromFileCreateDTO :: FileCreateDTO -> U.UUID -> U.UUID -> Maybe UserDTO -> U.UUID -> UTCTime -> ProjectFile +fromFileCreateDTO reqDto uuid projectUuid mCreatedBy tenantUuid now = + ProjectFile + { uuid = uuid + , fileName = reqDto.fileName + , contentType = reqDto.contentType + , fileSize = fromIntegral . BS.length $ reqDto.content + , projectUuid = projectUuid + , createdBy = fmap (.uuid) mCreatedBy + , tenantUuid = tenantUuid + , createdAt = now + } diff --git a/wizard-server/src/Wizard/Service/Project/File/ProjectFileService.hs b/wizard-server/src/Wizard/Service/Project/File/ProjectFileService.hs new file mode 100644 index 000000000..55691c554 --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/File/ProjectFileService.hs @@ -0,0 +1,90 @@ +module Wizard.Service.Project.File.ProjectFileService where + +import Control.Monad (void) +import Control.Monad.Reader (asks, liftIO) +import Data.Time +import qualified Data.UUID as U + +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.Constant.Acl +import Wizard.Database.DAO.Common +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectFileDAO +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.AppContextHelpers +import Wizard.Model.Project.File.ProjectFile +import Wizard.Model.Project.File.ProjectFileList +import Wizard.Model.Project.Project +import Wizard.S3.Project.ProjectFileS3 +import Wizard.Service.Project.Collaboration.ProjectCollaborationService +import Wizard.Service.Project.File.ProjectFileAcl +import Wizard.Service.Project.File.ProjectFileMapper +import Wizard.Service.Project.File.ProjectFileValidation +import Wizard.Service.Project.ProjectAcl +import WizardLib.Public.Api.Resource.TemporaryFile.TemporaryFileDTO +import qualified WizardLib.Public.Service.TemporaryFile.TemporaryFileMapper as TemporaryFileMapper +import WizardLib.Public.Service.TemporaryFile.TemporaryFileService + +getProjectFilesPage :: Maybe String -> Maybe U.UUID -> Pageable -> [Sort] -> AppContextM (Page ProjectFileList) +getProjectFilesPage mQuery mProjectUuid pageable sort = do + case mProjectUuid of + Just projectUuid -> do + project <- findProjectByUuid projectUuid + checkViewPermissionToProject project.visibility project.sharing project.permissions + Nothing -> checkPermission _PRJ_FILE_PERM + findProjectFilesPage mQuery mProjectUuid pageable sort + +createProjectFile :: U.UUID -> U.UUID -> FileCreateDTO -> AppContextM ProjectFileList +createProjectFile projectUuid questionUuid reqDto = + runInTransaction $ do + project <- findProjectByUuid projectUuid + checkViewPermissionToProject project.visibility project.sharing project.permissions + uuid <- liftIO generateUuid + mCurrentUser <- asks currentUser + tenantUuid <- asks currentTenantUuid + now <- liftIO getCurrentTime + let projectFile = fromFileCreateDTO reqDto uuid projectUuid mCurrentUser tenantUuid now + validateProjectFile project questionUuid projectFile + insertProjectFile projectFile + putFile projectUuid uuid reqDto.contentType reqDto.content + addFile projectUuid (toSimple projectFile) + return $ toList projectFile project mCurrentUser + +cloneProjectFiles :: U.UUID -> U.UUID -> AppContextM [(ProjectFile, ProjectFile)] +cloneProjectFiles oldProjectUuid newProjectUuid = do + runInTransaction $ do + oldFiles <- findProjectFilesByProject oldProjectUuid + traverse + ( \oldFile -> do + contentAction <- retrieveFileConduitAction oldProjectUuid oldFile.uuid + newFileUuid <- liftIO generateUuid + let newFile = oldFile {uuid = newFileUuid, projectUuid = newProjectUuid} + let contentDisposition = f' "attachment;filename=\"%s\"" [trim newFile.fileName] + insertProjectFile newFile + putFileConduit newProjectUuid newFile.uuid newFile.contentType contentDisposition contentAction + return (oldFile, newFile) + ) + oldFiles + +downloadProjectFile :: U.UUID -> U.UUID -> AppContextM TemporaryFileDTO +downloadProjectFile projectUuid fileUuid = do + runInTransaction $ do + projectFile <- findProjectFileByUuid fileUuid + checkViewPermissionToFile projectUuid + contentAction <- retrieveFileConduitAction projectUuid fileUuid + mCurrentUserUuid <- getCurrentUserUuid + url <- createTemporaryFileConduit projectFile.fileName "application/octet-stream" mCurrentUserUuid contentAction + return $ TemporaryFileMapper.toDTO url projectFile.contentType + +deleteProjectFile :: U.UUID -> U.UUID -> AppContextM () +deleteProjectFile projectUuid fileUuid = do + runInTransaction $ do + _ <- findProjectFileByUuid fileUuid + checkEditPermissionToFile projectUuid + void $ deleteProjectFileByUuid fileUuid diff --git a/wizard-server/src/Wizard/Service/Project/File/ProjectFileValidation.hs b/wizard-server/src/Wizard/Service/Project/File/ProjectFileValidation.hs new file mode 100644 index 000000000..f25189309 --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/File/ProjectFileValidation.hs @@ -0,0 +1,30 @@ +module Wizard.Service.Project.File.ProjectFileValidation where + +import Control.Monad (when) +import Control.Monad.Except (throwError) +import qualified Data.Map.Strict as M +import qualified Data.UUID as U + +import Shared.Common.Model.Error.Error +import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel +import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModelLenses +import Wizard.Localization.Messages.Public +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.File.ProjectFile +import Wizard.Model.Project.Project +import Wizard.Service.KnowledgeModel.KnowledgeModelService +import Wizard.Service.Tenant.Limit.LimitService + +validateProjectFile :: Project -> U.UUID -> ProjectFile -> AppContextM () +validateProjectFile project questionUuid projectFile = do + checkStorageSize projectFile.fileSize + km <- compileKnowledgeModel [] (Just project.knowledgeModelPackageId) project.selectedQuestionTagUuids + case M.lookup questionUuid (getQuestionsM km) of + Just (FileQuestion' question) -> + case question.maxSize of + (Just maxFileSize) -> + when + (maxFileSize < fromIntegral projectFile.fileSize) + (throwError . UserError $ _ERROR_VALIDATION__PROJECT_FILE_SIZE_EXCEEDS_LIMIT projectFile.fileSize maxFileSize) + Nothing -> return () + _ -> throwError . UserError $ _ERROR_VALIDATION__PROJECT_FILE_QUESTION_ABSENCE_OR_WRONG_TYPE diff --git a/wizard-server/src/Wizard/Service/Project/Importer/ProjectImporterAudit.hs b/wizard-server/src/Wizard/Service/Project/Importer/ProjectImporterAudit.hs new file mode 100644 index 000000000..b64563261 --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/Importer/ProjectImporterAudit.hs @@ -0,0 +1,8 @@ +module Wizard.Service.Project.Importer.ProjectImporterAudit where + +import Shared.Audit.Service.Audit.AuditService +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.ContextLenses () + +auditProjectImporterStartEvent :: String -> AppContextM () +auditProjectImporterStartEvent = logAudit "project_importer" "startEvent" diff --git a/wizard-server/src/Wizard/Service/Project/Importer/ProjectImporterMapper.hs b/wizard-server/src/Wizard/Service/Project/Importer/ProjectImporterMapper.hs new file mode 100644 index 000000000..dd72fa9f2 --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/Importer/ProjectImporterMapper.hs @@ -0,0 +1,26 @@ +module Wizard.Service.Project.Importer.ProjectImporterMapper where + +import Data.Time + +import Wizard.Api.Resource.Project.Importer.ProjectImporterChangeDTO +import Wizard.Api.Resource.Project.Importer.ProjectImporterDTO +import Wizard.Model.Project.Importer.ProjectImporter + +toDTO :: ProjectImporter -> ProjectImporterDTO +toDTO importer = + ProjectImporterDTO + { piId = importer.piId + , name = importer.name + , description = importer.description + , url = importer.url + , enabled = importer.enabled + , createdAt = importer.createdAt + , updatedAt = importer.updatedAt + } + +toChangeDTO :: ProjectImporter -> ProjectImporterChangeDTO +toChangeDTO importer = ProjectImporterChangeDTO {enabled = importer.enabled} + +fromChangeDTO :: ProjectImporter -> ProjectImporterChangeDTO -> UTCTime -> ProjectImporter +fromChangeDTO importer reqDto now = + importer {enabled = reqDto.enabled, updatedAt = now} diff --git a/wizard-server/src/Wizard/Service/Project/Importer/ProjectImporterService.hs b/wizard-server/src/Wizard/Service/Project/Importer/ProjectImporterService.hs new file mode 100644 index 000000000..74ea6fa49 --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/Importer/ProjectImporterService.hs @@ -0,0 +1,73 @@ +module Wizard.Service.Project.Importer.ProjectImporterService where + +import Control.Monad.Reader (liftIO) +import Data.Maybe (fromMaybe) +import Data.Time +import qualified Data.UUID as U + +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.PageMetadata +import Shared.Common.Model.Common.Pageable +import Shared.Common.Model.Common.Sort +import Wizard.Api.Resource.Project.Importer.ProjectImporterChangeDTO +import Wizard.Api.Resource.Project.Importer.ProjectImporterDTO +import Wizard.Database.DAO.Common +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectImporterDAO +import Wizard.Model.Context.AclContext +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.AppContextHelpers +import Wizard.Model.Project.Importer.ProjectImporter +import Wizard.Model.Project.Project +import Wizard.Service.Project.Importer.ProjectImporterAudit +import Wizard.Service.Project.Importer.ProjectImporterMapper +import Wizard.Service.Project.Importer.ProjectImporterUtil + +getProjectImportersPageDto :: Maybe String -> Pageable -> [Sort] -> AppContextM (Page ProjectImporterDTO) +getProjectImportersPageDto mQuery pageable sort = do + checkPermission _PRJ_PERM + currentUser <- getCurrentUser + importersPage <- findProjectImportersPage Nothing Nothing mQuery Nothing pageable sort + return $ fmap toDTO importersPage + +getProjectImporterSuggestions :: Maybe U.UUID -> Maybe String -> Maybe Bool -> Pageable -> [Sort] -> AppContextM (Page ProjectImporterDTO) +getProjectImporterSuggestions mProjectUuid mQuery mEnabled pageable sort = do + checkPermission _PRJ_PERM + mPkgId <- + case mProjectUuid of + Just projectUuid -> do + project <- findProjectByUuid projectUuid + return . Just $ project.knowledgeModelPackageId + Nothing -> return Nothing + page <- findProjectImportersPage Nothing Nothing mQuery mEnabled (Pageable (Just 0) (Just 999999999)) sort + return . fmap toDTO . updatePage page . filterImportersInGroup mPkgId $ page + where + updatePage :: Page ProjectImporter -> [ProjectImporter] -> Page ProjectImporter + updatePage (Page name _ _) array = + let updatedArray = take updatedSize array + updatedSize = fromMaybe 20 pageable.size + updatedTotalElements = length updatedArray + updatedTotalPages = computeTotalPage updatedTotalElements updatedSize + updatedNumber = fromMaybe 0 pageable.page + in Page name (PageMetadata updatedSize updatedTotalElements updatedTotalPages updatedNumber) updatedArray + filterImportersInGroup :: Maybe String -> Page ProjectImporter -> [ProjectImporter] + filterImportersInGroup mPkgId page = + filter isProjectImporterSupported . filterProjectImporters mPkgId $ page.entities + +getProjectImporter :: String -> AppContextM ProjectImporterDTO +getProjectImporter piId = + runInTransaction $ do + checkPermission _PRJ_PERM + importer <- findProjectImporterById piId + auditProjectImporterStartEvent piId + return $ toDTO importer + +modifyProjectImporter :: String -> ProjectImporterChangeDTO -> AppContextM ProjectImporterDTO +modifyProjectImporter piId reqDto = + runInTransaction $ do + checkPermission _PRJ_IMPORTER_PERM + importer <- findProjectImporterById piId + now <- liftIO getCurrentTime + let updatedImporter = fromChangeDTO importer reqDto now + updateProjectImporterById updatedImporter + return $ toDTO updatedImporter diff --git a/wizard-server/src/Wizard/Service/Project/Importer/ProjectImporterUtil.hs b/wizard-server/src/Wizard/Service/Project/Importer/ProjectImporterUtil.hs new file mode 100644 index 000000000..09ef58328 --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/Importer/ProjectImporterUtil.hs @@ -0,0 +1,18 @@ +module Wizard.Service.Project.Importer.ProjectImporterUtil where + +import Shared.Coordinate.Util.Coordinate +import Shared.KnowledgeModel.Service.KnowledgeModel.Package.KnowledgeModelPackageUtil +import Wizard.Constant.ProjectImporter +import Wizard.Model.Project.Importer.ProjectImporter + +isProjectImporterSupported :: ProjectImporter -> Bool +isProjectImporterSupported importer = importer.metamodelVersion == projectImporterMetamodelVersion + +filterProjectImporters :: Maybe String -> [ProjectImporter] -> [ProjectImporter] +filterProjectImporters mPkgId importers = + case mPkgId of + Just pkgId -> filter (filterProjectImporter . splitCoordinate $ pkgId) importers + Nothing -> importers + where + filterProjectImporter :: [String] -> ProjectImporter -> Bool + filterProjectImporter pkgIdSplit importer = fitsIntoKMSpecs pkgIdSplit importer.allowedPackages diff --git a/wizard-server/src/Wizard/Service/Questionnaire/Migration/Migrator/ChangeQTypeSanitizer.hs b/wizard-server/src/Wizard/Service/Project/Migration/Migrator/ChangeQTypeSanitizer.hs similarity index 96% rename from wizard-server/src/Wizard/Service/Questionnaire/Migration/Migrator/ChangeQTypeSanitizer.hs rename to wizard-server/src/Wizard/Service/Project/Migration/Migrator/ChangeQTypeSanitizer.hs index 30fa4c63e..92e04a871 100644 --- a/wizard-server/src/Wizard/Service/Questionnaire/Migration/Migrator/ChangeQTypeSanitizer.hs +++ b/wizard-server/src/Wizard/Service/Project/Migration/Migrator/ChangeQTypeSanitizer.hs @@ -1,4 +1,4 @@ -module Wizard.Service.Questionnaire.Migration.Migrator.ChangeQTypeSanitizer where +module Wizard.Service.Project.Migration.Migrator.ChangeQTypeSanitizer where import qualified Data.Aeson as A import qualified Data.Aeson.KeyMap as KM @@ -10,7 +10,7 @@ import Shared.Common.Util.Maybe (concatMaybe) import Shared.Common.Util.String (splitOn) import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModelLenses -import Wizard.Model.Questionnaire.QuestionnaireReply +import Wizard.Model.Project.ProjectReply sanitizeReplies :: KnowledgeModel -> [ReplyTuple] -> [ReplyTuple] sanitizeReplies km = mapMaybe (sanitizeReply km) diff --git a/wizard-server/src/Wizard/Service/Questionnaire/Migration/Migrator/MoveEventGenerator.hs b/wizard-server/src/Wizard/Service/Project/Migration/Migrator/MoveEventGenerator.hs similarity index 96% rename from wizard-server/src/Wizard/Service/Questionnaire/Migration/Migrator/MoveEventGenerator.hs rename to wizard-server/src/Wizard/Service/Project/Migration/Migrator/MoveEventGenerator.hs index 9ab1ef745..068b7e82e 100644 --- a/wizard-server/src/Wizard/Service/Questionnaire/Migration/Migrator/MoveEventGenerator.hs +++ b/wizard-server/src/Wizard/Service/Project/Migration/Migrator/MoveEventGenerator.hs @@ -1,4 +1,4 @@ -module Wizard.Service.Questionnaire.Migration.Migrator.MoveEventGenerator where +module Wizard.Service.Project.Migration.Migrator.MoveEventGenerator where import Control.Monad (guard) import qualified Data.Map.Strict as M diff --git a/wizard-server/src/Wizard/Service/Questionnaire/Migration/Migrator/MoveSanitizer.hs b/wizard-server/src/Wizard/Service/Project/Migration/Migrator/MoveSanitizer.hs similarity index 94% rename from wizard-server/src/Wizard/Service/Questionnaire/Migration/Migrator/MoveSanitizer.hs rename to wizard-server/src/Wizard/Service/Project/Migration/Migrator/MoveSanitizer.hs index dac84aaa9..7c655e06e 100644 --- a/wizard-server/src/Wizard/Service/Questionnaire/Migration/Migrator/MoveSanitizer.hs +++ b/wizard-server/src/Wizard/Service/Project/Migration/Migrator/MoveSanitizer.hs @@ -1,4 +1,4 @@ -module Wizard.Service.Questionnaire.Migration.Migrator.MoveSanitizer where +module Wizard.Service.Project.Migration.Migrator.MoveSanitizer where import qualified Data.List as L import qualified Data.Map.Strict as M @@ -13,9 +13,9 @@ import Shared.KnowledgeModel.Model.KnowledgeModel.Event.KnowledgeModelEvent import Shared.KnowledgeModel.Model.KnowledgeModel.Event.Move.MoveEvent import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModelUtil -import Wizard.Model.Questionnaire.QuestionnaireReply -import Wizard.Model.Questionnaire.QuestionnaireUtil -import Wizard.Service.Questionnaire.Migration.Migrator.MoveEventGenerator +import Wizard.Model.Project.ProjectReply +import Wizard.Model.Project.ProjectUtil +import Wizard.Service.Project.Migration.Migrator.MoveEventGenerator sanitizeReplies :: UTCTime -> KnowledgeModel -> KnowledgeModel -> [ReplyTuple] -> [ReplyTuple] sanitizeReplies now oldKm newKm replies = sanitizeRepliesWithEvents oldKm newKm replies (generateEvents now oldKm newKm) diff --git a/wizard-server/src/Wizard/Service/Project/Migration/Migrator/Sanitizer.hs b/wizard-server/src/Wizard/Service/Project/Migration/Migrator/Sanitizer.hs new file mode 100644 index 000000000..333448a43 --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/Migration/Migrator/Sanitizer.hs @@ -0,0 +1,77 @@ +module Wizard.Service.Project.Migration.Migrator.Sanitizer ( + sanitizeProjectEvents, +) where + +import Control.Monad.Reader (liftIO) +import qualified Data.Map.Strict as M +import Data.Time +import qualified Data.UUID as U + +import Shared.Common.Util.Uuid +import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.AppContextHelpers +import Wizard.Model.Project.Event.ProjectEventList +import Wizard.Model.Project.ProjectContent +import Wizard.Model.Project.ProjectReply +import Wizard.Service.Project.Compiler.ProjectCompilerService +import qualified Wizard.Service.Project.Migration.Migrator.ChangeQTypeSanitizer as CTS +import qualified Wizard.Service.Project.Migration.Migrator.MoveSanitizer as MS +import Wizard.Service.User.UserMapper + +sanitizeProjectEvents :: U.UUID -> KnowledgeModel -> KnowledgeModel -> [ProjectEventList] -> AppContextM [ProjectEventList] +sanitizeProjectEvents projectUuid oldKm newKm events = do + let oldProjectContent = compileProjectEvents events + let oldReplies = oldProjectContent.replies + now <- liftIO getCurrentTime + let sanitizedReplies = M.fromList . sanitizeReplies now oldKm newKm . M.toList $ oldReplies + clearReplyEvents <- generateClearReplyEvents projectUuid oldReplies sanitizedReplies + setReplyEvents <- generateSetReplyEvents projectUuid oldReplies sanitizedReplies + return $ events ++ clearReplyEvents ++ setReplyEvents + +-- -------------------------------- +-- PRIVATE +-- -------------------------------- +sanitizeReplies :: UTCTime -> KnowledgeModel -> KnowledgeModel -> [ReplyTuple] -> [ReplyTuple] +sanitizeReplies now oldKm newKm = MS.sanitizeReplies now oldKm newKm . CTS.sanitizeReplies newKm + +generateClearReplyEvents :: U.UUID -> M.Map String Reply -> M.Map String Reply -> AppContextM [ProjectEventList] +generateClearReplyEvents projectUuid oldReplies sanitizedReplies = traverse generateEvent repliesToBeDeleted + where + repliesToBeDeleted :: [ReplyTuple] + repliesToBeDeleted = M.toList . M.filterWithKey (\k _ -> k `M.notMember` sanitizedReplies) $ oldReplies + generateEvent :: ReplyTuple -> AppContextM ProjectEventList + generateEvent (k, _) = do + eUuid <- liftIO generateUuid + now <- liftIO getCurrentTime + user <- getCurrentUser + return . ClearReplyEventList' $ ClearReplyEventList eUuid k (Just (toSuggestion' user)) now + +generateSetReplyEvents :: U.UUID -> M.Map String Reply -> M.Map String Reply -> AppContextM [ProjectEventList] +generateSetReplyEvents projectUuid oldReplies sanitizedReplies = foldl generateEvent (return []) (M.toList sanitizedReplies) + where + generateEvent :: AppContextM [ProjectEventList] -> ReplyTuple -> AppContextM [ProjectEventList] + generateEvent accM (keyFromSanitizedReply, valueFromSanitizedReply) = do + acc <- accM + eUuid <- liftIO generateUuid + now <- liftIO getCurrentTime + user <- getCurrentUser + return $ + case M.lookup keyFromSanitizedReply oldReplies of + Just valueFromOldReply -> + if valueFromOldReply.value == valueFromSanitizedReply.value + then acc + else + acc + ++ [ SetReplyEventList' $ + SetReplyEventList + eUuid + keyFromSanitizedReply + valueFromSanitizedReply.value + (Just (toSuggestion' user)) + now + ] + Nothing -> + acc + ++ [ SetReplyEventList' $ SetReplyEventList eUuid keyFromSanitizedReply valueFromSanitizedReply.value (Just (toSuggestion' user)) now + ] diff --git a/wizard-server/src/Wizard/Service/Project/Migration/ProjectMigrationAudit.hs b/wizard-server/src/Wizard/Service/Project/Migration/ProjectMigrationAudit.hs new file mode 100644 index 000000000..e55ab8091 --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/Migration/ProjectMigrationAudit.hs @@ -0,0 +1,49 @@ +module Wizard.Service.Project.Migration.ProjectMigrationAudit where + +import qualified Data.Map.Strict as M +import qualified Data.UUID as U + +import Shared.Audit.Service.Audit.AuditService +import Wizard.Api.Resource.Project.Detail.ProjectDetailQuestionnaireDTO +import Wizard.Api.Resource.Project.Migration.ProjectMigrationChangeDTO +import Wizard.Api.Resource.Project.Migration.ProjectMigrationCreateDTO +import Wizard.Api.Resource.Project.Migration.ProjectMigrationDTO +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.ContextLenses () +import Wizard.Model.Project.Project + +auditProjectMigrationCreate :: ProjectMigrationCreateDTO -> Project -> Project -> AppContextM () +auditProjectMigrationCreate reqDto oldProject newProject = + logAuditWithBody + "project_migration" + "create" + (U.toString oldProject.uuid) + ( M.fromList + [ ("sourceKnowledgeModelPackageId", oldProject.knowledgeModelPackageId) + , ("targetKnowledgeModelPackageId", reqDto.targetKnowledgeModelPackageId) + , ("oldProjectUuid", U.toString $ oldProject.uuid) + , ("newProjectUuid", U.toString $ newProject.uuid) + ] + ) + +auditProjectMigrationModify :: ProjectMigrationDTO -> ProjectMigrationChangeDTO -> AppContextM () +auditProjectMigrationModify projectMigration resolvedQuestionUuids = + logAuditWithBody + "project_migration" + "modify" + (U.toString $ projectMigration.newProject.uuid) + (M.fromList [("resolvedQuestionUuids", show resolvedQuestionUuids)]) + +auditProjectMigrationFinish :: Project -> Project -> AppContextM () +auditProjectMigrationFinish oldProject newProject = + logAuditWithBody + "project_migration" + "finish" + (U.toString oldProject.uuid) + ( M.fromList + [("oldProjectUuid", U.toString $ oldProject.uuid), ("newProjectUuid", U.toString $ newProject.uuid)] + ) + +auditProjectMigrationCancel :: ProjectMigrationDTO -> AppContextM () +auditProjectMigrationCancel projectMigration = + logAudit "project_migration" "cancel" (U.toString $ projectMigration.oldProject.uuid) diff --git a/wizard-server/src/Wizard/Service/Project/Migration/ProjectMigrationMapper.hs b/wizard-server/src/Wizard/Service/Project/Migration/ProjectMigrationMapper.hs new file mode 100644 index 000000000..9efa8ae08 --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/Migration/ProjectMigrationMapper.hs @@ -0,0 +1,50 @@ +module Wizard.Service.Project.Migration.ProjectMigrationMapper where + +import Data.Time +import qualified Data.UUID as U + +import Wizard.Api.Resource.Project.Detail.ProjectDetailQuestionnaireDTO +import Wizard.Api.Resource.Project.Migration.ProjectMigrationChangeDTO +import Wizard.Api.Resource.Project.Migration.ProjectMigrationDTO +import Wizard.Api.Resource.User.UserDTO +import Wizard.Model.Project.Event.ProjectEvent +import Wizard.Model.Project.Migration.ProjectMigration + +toDTO :: ProjectDetailQuestionnaireDTO -> ProjectDetailQuestionnaireDTO -> [U.UUID] -> U.UUID -> ProjectMigrationDTO +toDTO oldProject newProject projectUuids tenantUuid = + ProjectMigrationDTO + { oldProject = oldProject + , newProject = newProject + , resolvedQuestionUuids = projectUuids + , tenantUuid = tenantUuid + } + +fromCreateDTO :: U.UUID -> U.UUID -> U.UUID -> ProjectMigration +fromCreateDTO oldProjectUuid newProjectUuid tenantUuid = + ProjectMigration + { oldProjectUuid = oldProjectUuid + , newProjectUuid = newProjectUuid + , resolvedQuestionUuids = [] + , tenantUuid = tenantUuid + } + +fromChangeDTO :: ProjectMigrationChangeDTO -> ProjectMigrationDTO -> ProjectMigration +fromChangeDTO changeDto ms = + ProjectMigration + { oldProjectUuid = ms.oldProject.uuid + , newProjectUuid = ms.newProject.uuid + , resolvedQuestionUuids = changeDto.resolvedQuestionUuids + , tenantUuid = ms.tenantUuid + } + +toProjectPhaseEvent :: U.UUID -> Maybe U.UUID -> U.UUID -> U.UUID -> Maybe UserDTO -> UTCTime -> ProjectEvent +toProjectPhaseEvent phaseEventUuid kmPhaseUuid projectUuid tenantUuid mCurrentUserUuid now = + SetPhaseEvent' $ + SetPhaseEvent + { uuid = phaseEventUuid + , phaseUuid = kmPhaseUuid + , projectUuid = projectUuid + , tenantUuid = tenantUuid + , createdBy = fmap (.uuid) mCurrentUserUuid + , createdAt = now + } diff --git a/wizard-server/src/Wizard/Service/Project/Migration/ProjectMigrationService.hs b/wizard-server/src/Wizard/Service/Project/Migration/ProjectMigrationService.hs new file mode 100644 index 000000000..c55f0ea72 --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/Migration/ProjectMigrationService.hs @@ -0,0 +1,205 @@ +module Wizard.Service.Project.Migration.ProjectMigrationService where + +import Control.Monad.Reader (asks, liftIO) +import Data.Foldable (traverse_) +import qualified Data.List as L +import Data.Maybe (catMaybes) +import Data.Time +import qualified Data.UUID as U + +import Shared.Common.Model.Common.Lens +import Shared.Common.Util.List +import Shared.Common.Util.Uuid +import Shared.DocumentTemplate.Database.DAO.DocumentTemplate.DocumentTemplateDAO +import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel +import Wizard.Api.Resource.Project.Detail.ProjectDetailQuestionnaireDTO +import Wizard.Api.Resource.Project.Migration.ProjectMigrationChangeDTO +import Wizard.Api.Resource.Project.Migration.ProjectMigrationCreateDTO +import Wizard.Api.Resource.Project.Migration.ProjectMigrationDTO +import Wizard.Database.DAO.Common +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectEventDAO +import Wizard.Database.DAO.Project.ProjectMigrationDAO +import Wizard.Database.DAO.Project.ProjectVersionDAO +import Wizard.Model.Common.Lens +import Wizard.Model.Context.AclContext +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Acl.ProjectPerm +import Wizard.Model.Project.Event.ProjectEvent +import Wizard.Model.Project.Migration.ProjectMigration +import Wizard.Model.Project.Project +import Wizard.Model.Project.ProjectContent +import Wizard.Model.Project.Version.ProjectVersion +import Wizard.Service.DocumentTemplate.DocumentTemplateUtil +import Wizard.Service.KnowledgeModel.KnowledgeModelService +import Wizard.Service.Project.Compiler.ProjectCompilerService +import Wizard.Service.Project.Event.ProjectEventMapper +import Wizard.Service.Project.Migration.Migrator.Sanitizer +import Wizard.Service.Project.Migration.ProjectMigrationAudit +import Wizard.Service.Project.Migration.ProjectMigrationMapper +import Wizard.Service.Project.Migration.ProjectMigrationValidation +import Wizard.Service.Project.ProjectAcl +import Wizard.Service.Project.ProjectService + +createProjectMigration :: U.UUID -> ProjectMigrationCreateDTO -> AppContextM ProjectMigrationDTO +createProjectMigration oldProjectUuid reqDto = + runInTransaction $ do + checkPermission _PRJ_PERM + validateMigrationExistence oldProjectUuid + oldProject <- findProjectByUuid oldProjectUuid + checkMigrationPermissionToProject oldProject.visibility oldProject.permissions + (newProject, newProjectEvents, newProjectVersions) <- upgradeProject reqDto oldProject + insertProject newProject + insertProjectEvents newProjectEvents + traverse_ insertProjectVersion newProjectVersions + tenantUuid <- asks currentTenantUuid + let projectMigration = fromCreateDTO oldProject.uuid newProject.uuid tenantUuid + insertProjectMigration projectMigration + auditProjectMigrationCreate reqDto oldProject newProject + getProjectMigration newProject.uuid + +getProjectMigration :: U.UUID -> AppContextM ProjectMigrationDTO +getProjectMigration projectUuid = do + checkPermission _PRJ_PERM + projectMigration <- findProjectMigrationByNewProjectUuid projectUuid + oldProjectDto <- getProjectDetailQuestionnaireByUuid projectMigration.oldProjectUuid + newProjectDto <- getProjectDetailQuestionnaireByUuid projectMigration.newProjectUuid + oldProject <- findProjectByUuid projectMigration.oldProjectUuid + newProject <- findProjectByUuid projectMigration.newProjectUuid + checkMigrationPermissionToProject oldProject.visibility oldProject.permissions + checkMigrationPermissionToProject newProject.visibility newProject.permissions + return $ toDTO oldProjectDto newProjectDto projectMigration.resolvedQuestionUuids projectMigration.tenantUuid + +modifyProjectMigration :: U.UUID -> ProjectMigrationChangeDTO -> AppContextM ProjectMigrationDTO +modifyProjectMigration projectUuid reqDto = + runInTransaction $ do + checkPermission _PRJ_PERM + projectMigration <- getProjectMigration projectUuid + let updatedState = fromChangeDTO reqDto projectMigration + updateProjectMigrationByNewProjectUuid updatedState + auditProjectMigrationModify projectMigration reqDto + return $ toDTO projectMigration.oldProject projectMigration.newProject updatedState.resolvedQuestionUuids updatedState.tenantUuid + +finishProjectMigration :: U.UUID -> AppContextM () +finishProjectMigration projectUuid = + runInTransaction $ do + checkPermission _PRJ_PERM + _ <- getProjectMigration projectUuid + projectMigration <- findProjectMigrationByNewProjectUuid projectUuid + deleteProjectMigrationByNewProjectUuid projectUuid + oldProject <- findProjectByUuid projectMigration.oldProjectUuid + newProject <- findProjectByUuid projectMigration.newProjectUuid + newProjectEvents <- ensurePhaseIsSetIfNecessary newProject + newProjectVersions <- findProjectVersionsByProjectUuid projectMigration.newProjectUuid + now <- liftIO getCurrentTime + let newProjectUpdated = + oldProject + { formatUuid = newProject.formatUuid + , documentTemplateId = newProject.documentTemplateId + , selectedQuestionTagUuids = newProject.selectedQuestionTagUuids + , knowledgeModelPackageId = newProject.knowledgeModelPackageId + , updatedAt = now + } + :: Project + let newProjectEventsWithOldProjectUuid = fmap (\event -> setProjectUuid event oldProject.uuid) newProjectEvents + newVersionsWithNewUuid <- traverse generateNewVersionUuid newProjectVersions + let newVersionsWithOldProjectUuid = fmap (\v -> v {projectUuid = oldProject.uuid} :: ProjectVersion) newVersionsWithNewUuid + -- Delete the new project + deleteProjectEventsByProjectUuid newProject.uuid + deleteProject newProject.uuid False + -- Update the old project with values from new project + updateProjectByUuid newProjectUpdated + deleteProjectEventsByProjectUuid oldProject.uuid + insertProjectEvents newProjectEventsWithOldProjectUuid + traverse_ insertProjectVersion newVersionsWithOldProjectUuid + auditProjectMigrationFinish oldProject newProject + +cancelProjectMigration :: U.UUID -> AppContextM () +cancelProjectMigration projectUuid = + runInTransaction $ do + checkPermission _PRJ_PERM + projectMigration <- getProjectMigration projectUuid + deleteProject projectMigration.newProject.uuid True + deleteProjectMigrationByNewProjectUuid projectUuid + auditProjectMigrationCancel projectMigration + return () + +-- -------------------------------- +-- PRIVATE +-- -------------------------------- +upgradeProject :: ProjectMigrationCreateDTO -> Project -> AppContextM (Project, [ProjectEvent], [ProjectVersion]) +upgradeProject reqDto oldProject = do + let newPkgId = reqDto.targetKnowledgeModelPackageId + let newTagUuids = reqDto.targetTagUuids + oldKm <- compileKnowledgeModel [] (Just oldProject.knowledgeModelPackageId) newTagUuids + newKm <- compileKnowledgeModel [] (Just newPkgId) newTagUuids + newUuid <- liftIO generateUuid + oldProjectEvents <- findProjectEventListsByProjectUuid oldProject.uuid + clonedProjectEventsWithOldEventUuid <- cloneProjectEventsWithOldEventUuid oldProjectEvents + let clonedProjectEvents = fmap snd clonedProjectEventsWithOldEventUuid + newProjectEvents <- sanitizeProjectEvents newUuid oldKm newKm clonedProjectEvents + (newDocumentTemplateId, newFormatUuid) <- getNewDocumentTemplateIdAndFormatUuid oldProject newPkgId + let newProjectEventUuids = fmap getUuid newProjectEvents + let clonedProjectEventsFiltered = filter (\e -> getUuid (snd e) `elem` newProjectEventUuids) clonedProjectEventsWithOldEventUuid + let newPermissions = fmap (\perm -> perm {projectUuid = newUuid} :: ProjectPerm) oldProject.permissions + let upgradedProject = + oldProject + { uuid = newUuid + , knowledgeModelPackageId = newPkgId + , selectedQuestionTagUuids = newTagUuids + , documentTemplateId = newDocumentTemplateId + , formatUuid = newFormatUuid + , permissions = newPermissions + } + :: Project + versionsWithOldProjectUuid <- findProjectVersionsByProjectUuid oldProject.uuid + newVersionsWithNewUuid <- traverse generateNewVersionUuid versionsWithOldProjectUuid + let newVersionsWithNewEventUuid = + fmap + ( \v -> + case L.find (\(oldEventUuid, _) -> v.eventUuid == oldEventUuid) clonedProjectEventsWithOldEventUuid of + Just (_, newEvent) -> + Just $ + v + { projectUuid = newUuid + , eventUuid = getUuid newEvent + } + Nothing -> Nothing + ) + newVersionsWithNewUuid + let newVersions = catMaybes newVersionsWithNewEventUuid + return (upgradedProject, fmap (toEvent upgradedProject.uuid upgradedProject.tenantUuid) newProjectEvents, newVersions) + +ensurePhaseIsSetIfNecessary :: Project -> AppContextM [ProjectEvent] +ensurePhaseIsSetIfNecessary newProject = do + uuid <- liftIO generateUuid + mCurrentUser <- asks currentUser + now <- liftIO getCurrentTime + newProjectListEvents <- findProjectEventListsByProjectUuid newProject.uuid + let projectContent = compileProjectEvents newProjectListEvents + knowledgeModel <- compileKnowledgeModel [] (Just newProject.knowledgeModelPackageId) newProject.selectedQuestionTagUuids + let newProjectEvents = fmap (toEvent newProject.uuid newProject.tenantUuid) newProjectListEvents + return $ + case (headSafe knowledgeModel.phaseUuids, projectContent.phaseUuid) of + (Nothing, Nothing) -> newProjectEvents + (Nothing, Just projectPhaseUuid) -> newProjectEvents ++ [toProjectPhaseEvent uuid Nothing newProject.uuid newProject.tenantUuid mCurrentUser now] + (Just kmPhaseUuid, Nothing) -> newProjectEvents ++ [toProjectPhaseEvent uuid (Just kmPhaseUuid) newProject.uuid newProject.tenantUuid mCurrentUser now] + (Just kmPhaseUuid, Just projectPhaseUuid) -> + if projectPhaseUuid `notElem` knowledgeModel.phaseUuids + then newProjectEvents ++ [toProjectPhaseEvent uuid (Just kmPhaseUuid) newProject.uuid newProject.tenantUuid mCurrentUser now] + else newProjectEvents + +generateNewVersionUuid :: ProjectVersion -> AppContextM ProjectVersion +generateNewVersionUuid version = do + newVersionUuid <- liftIO generateUuid + return $ version {uuid = newVersionUuid} + +getNewDocumentTemplateIdAndFormatUuid :: Project -> String -> AppContextM (Maybe String, Maybe U.UUID) +getNewDocumentTemplateIdAndFormatUuid oldProject newPkgId = do + case oldProject.documentTemplateId of + Just id -> do + documentTemplate <- findDocumentTemplateById id + if isPkgAllowedByDocumentTemplate newPkgId documentTemplate + then return (Just id, oldProject.formatUuid) + else return (Nothing, Nothing) + Nothing -> return (Nothing, Nothing) diff --git a/wizard-server/src/Wizard/Service/Project/Migration/ProjectMigrationValidation.hs b/wizard-server/src/Wizard/Service/Project/Migration/ProjectMigrationValidation.hs new file mode 100644 index 000000000..63cc39cc7 --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/Migration/ProjectMigrationValidation.hs @@ -0,0 +1,12 @@ +module Wizard.Service.Project.Migration.ProjectMigrationValidation where + +import Control.Monad (unless) +import Control.Monad.Except (throwError) + +import Shared.Common.Model.Error.Error +import Wizard.Database.DAO.Project.ProjectMigrationDAO +import Wizard.Localization.Messages.Public + +validateMigrationExistence oldProjectUuid = do + states <- findProjectMigrationsByOldProjectUuid oldProjectUuid + unless (null states) (throwError . UserError $ _ERROR_VALIDATION__PROJECT_MIGRATION_UNIQUENESS) diff --git a/wizard-server/src/Wizard/Service/Project/ProjectAcl.hs b/wizard-server/src/Wizard/Service/Project/ProjectAcl.hs new file mode 100644 index 000000000..0619cc78f --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/ProjectAcl.hs @@ -0,0 +1,198 @@ +module Wizard.Service.Project.ProjectAcl where + +import Control.Monad (unless) +import Control.Monad.Except (throwError) + +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Wizard.Api.Resource.User.UserDTO +import Wizard.Model.Context.AclContext +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.AppContextHelpers +import Wizard.Model.Project.Acl.ProjectAclHelpers +import Wizard.Model.Project.Acl.ProjectPerm +import Wizard.Model.Project.Project +import Wizard.Model.Tenant.Config.TenantConfig +import Wizard.Service.Tenant.Config.ConfigService +import WizardLib.Public.Database.DAO.User.UserGroupMembershipDAO +import WizardLib.Public.Model.User.UserGroupMembership + +checkCreatePermissionToProject :: AppContextM () +checkCreatePermissionToProject = do + tcProject <- getCurrentTenantConfigProject + let projectSharingEnabled = tcProject.projectSharing.enabled + let projectSharingAnonymousEnabled = tcProject.projectSharing.anonymousEnabled + let projectCreation = tcProject.projectCreation + case (projectSharingEnabled, projectSharingAnonymousEnabled, projectCreation) of + (True, True, CustomProjectCreation) -> return () + (True, True, TemplateAndCustomProjectCreation) -> return () + (_, _, TemplateProjectCreation) -> do + checkPermission _PRJ_PERM + checkPermission _PRJ_TML_PERM + (_, _, _) -> checkPermission _PRJ_PERM + +checkCreateFromTemplatePermissionToProject :: Bool -> AppContextM () +checkCreateFromTemplatePermissionToProject isTemplate = do + checkPermission _PRJ_PERM + tcProject <- getCurrentTenantConfigProject + let projectCreation = tcProject.projectCreation + case projectCreation of + CustomProjectCreation -> + throwError . UserError . _ERROR_SERVICE_COMMON__FEATURE_IS_DISABLED $ "Project Template" + _ -> unless isTemplate (throwError . ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN "Project Template") + +checkClonePermissionToProject :: ProjectPermC projectPerm => ProjectVisibility -> ProjectSharing -> [projectPerm] -> AppContextM () +checkClonePermissionToProject visibility sharing permissions = do + checkPermission _PRJ_PERM + checkViewPermissionToProject visibility sharing permissions + +checkViewPermissionToProject :: ProjectPermC projectPerm => ProjectVisibility -> ProjectSharing -> [projectPerm] -> AppContextM () +checkViewPermissionToProject visibility sharing perms = do + result <- hasViewPermissionToProject visibility sharing perms + if result + then return () + else throwError . ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN "View Project" + +hasViewPermissionToProject :: ProjectPermC projectPerm => ProjectVisibility -> ProjectSharing -> [projectPerm] -> AppContextM Bool +hasViewPermissionToProject visibility sharing perms = + if sharing == AnyoneWithLinkViewProjectSharing + || sharing == AnyoneWithLinkCommentProjectSharing + || sharing + == AnyoneWithLinkEditProjectSharing + then return True + else do + checkPermission _PRJ_PERM + currentUser <- getCurrentUser + userGroupMemberships <- findUserGroupMembershipsByUserUuid currentUser.uuid + let currentUserGroupUuids = fmap (.userGroupUuid) userGroupMemberships + if or + [ currentUser.uRole == _USER_ROLE_ADMIN + , -- Check visibility + visibility == VisibleViewProjectVisibility + , visibility == VisibleCommentProjectVisibility + , visibility == VisibleEditProjectVisibility + , -- Check membership + currentUser.uuid `elem` getUserUuidsForViewerPerm perms + , currentUser.uuid `elem` getUserUuidsForCommenterPerm perms + , currentUser.uuid `elem` getUserUuidsForEditorPerm perms + , currentUser.uuid `elem` getUserUuidsForOwnerPerm perms + , -- Check groups + or (fmap (`elem` getUserGroupUuidsForViewerPerm perms) currentUserGroupUuids) + , or (fmap (`elem` getUserGroupUuidsForCommenterPerm perms) currentUserGroupUuids) + , or (fmap (`elem` getUserGroupUuidsForEditorPerm perms) currentUserGroupUuids) + , or (fmap (`elem` getUserGroupUuidsForOwnerPerm perms) currentUserGroupUuids) + ] + then return True + else return False + +checkCommentPermissionToProject :: ProjectPermC projectPerm => ProjectVisibility -> ProjectSharing -> [projectPerm] -> AppContextM () +checkCommentPermissionToProject visibility sharing perms = do + result <- hasCommentPermissionToProject visibility sharing perms + if result + then return () + else throwError . ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN "Comment Project" + +hasCommentPermissionToProject :: ProjectPermC projectPerm => ProjectVisibility -> ProjectSharing -> [projectPerm] -> AppContextM Bool +hasCommentPermissionToProject visibility sharing perms = + if sharing == AnyoneWithLinkCommentProjectSharing || sharing == AnyoneWithLinkEditProjectSharing + then return True + else do + checkPermission _PRJ_PERM + currentUser <- getCurrentUser + userGroupMemberships <- findUserGroupMembershipsByUserUuid currentUser.uuid + let currentUserGroupUuids = fmap (.userGroupUuid) userGroupMemberships + if or + [ currentUser.uRole == _USER_ROLE_ADMIN + , -- Check visibility + visibility == VisibleCommentProjectVisibility + , visibility == VisibleEditProjectVisibility + , -- Check membership + currentUser.uuid `elem` getUserUuidsForCommenterPerm perms + , currentUser.uuid `elem` getUserUuidsForEditorPerm perms + , currentUser.uuid `elem` getUserUuidsForOwnerPerm perms + , -- Check groups + or (fmap (`elem` getUserGroupUuidsForCommenterPerm perms) currentUserGroupUuids) + , or (fmap (`elem` getUserGroupUuidsForEditorPerm perms) currentUserGroupUuids) + , or (fmap (`elem` getUserGroupUuidsForOwnerPerm perms) currentUserGroupUuids) + ] + then return True + else return False + +checkEditPermissionToProject :: ProjectPermC projectPerm => ProjectVisibility -> ProjectSharing -> [projectPerm] -> AppContextM () +checkEditPermissionToProject visibility sharing perms = do + result <- hasEditPermissionToProject visibility sharing perms + if result + then return () + else throwError . ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN "Edit Project" + +hasEditPermissionToProject :: ProjectPermC projectPerm => ProjectVisibility -> ProjectSharing -> [projectPerm] -> AppContextM Bool +hasEditPermissionToProject visibility sharing perms = + if sharing == AnyoneWithLinkEditProjectSharing + then return True + else do + checkPermission _PRJ_PERM + currentUser <- getCurrentUser + userGroupMemberships <- findUserGroupMembershipsByUserUuid currentUser.uuid + let currentUserGroupUuids = fmap (.userGroupUuid) userGroupMemberships + if or + [ currentUser.uRole == _USER_ROLE_ADMIN + , -- Check visibility + visibility == VisibleEditProjectVisibility + , -- Check membership + currentUser.uuid `elem` getUserUuidsForEditorPerm perms + , currentUser.uuid `elem` getUserUuidsForOwnerPerm perms + , -- Check groups + or (fmap (`elem` getUserGroupUuidsForEditorPerm perms) currentUserGroupUuids) + , or (fmap (`elem` getUserGroupUuidsForOwnerPerm perms) currentUserGroupUuids) + ] + then return True + else return False + +checkOwnerPermissionToProject :: ProjectPermC projectPerm => ProjectVisibility -> [projectPerm] -> AppContextM () +checkOwnerPermissionToProject visibility perms = do + result <- hasOwnerPermissionToProject visibility perms + if result + then return () + else throwError . ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN "Administrate Project" + +hasOwnerPermissionToProject :: ProjectPermC projectPerm => ProjectVisibility -> [projectPerm] -> AppContextM Bool +hasOwnerPermissionToProject visibility perms = do + checkPermission _PRJ_PERM + currentUser <- getCurrentUser + userGroupMemberships <- findUserGroupMembershipsByUserUuid currentUser.uuid + let currentUserGroupUuids = fmap (.userGroupUuid) userGroupMemberships + if or + [ currentUser.uRole == _USER_ROLE_ADMIN + , -- Check membership + currentUser.uuid `elem` getUserUuidsForOwnerPerm perms + , -- Check groups + or (fmap (`elem` getUserGroupUuidsForOwnerPerm perms) currentUserGroupUuids) + ] + then return True + else return False + +checkMigrationPermissionToProject :: ProjectPermC projectPerm => ProjectVisibility -> [projectPerm] -> AppContextM () +checkMigrationPermissionToProject visibility perms = do + result <- hasMigrationPermissionToProject visibility perms + if result + then return () + else throwError . ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN "Migrate Project" + +hasMigrationPermissionToProject :: ProjectPermC projectPerm => ProjectVisibility -> [projectPerm] -> AppContextM Bool +hasMigrationPermissionToProject visibility perms = do + currentUser <- getCurrentUser + userGroupMemberships <- findUserGroupMembershipsByUserUuid currentUser.uuid + let currentUserGroupUuids = fmap (.userGroupUuid) userGroupMemberships + if or + [ currentUser.uRole == _USER_ROLE_ADMIN + , -- Check visibility + visibility == VisibleEditProjectVisibility + , -- Check membership + currentUser.uuid `elem` getUserUuidsForEditorPerm perms + , currentUser.uuid `elem` getUserUuidsForOwnerPerm perms + , -- Check groups + or (fmap (`elem` getUserGroupUuidsForEditorPerm perms) currentUserGroupUuids) + , or (fmap (`elem` getUserGroupUuidsForOwnerPerm perms) currentUserGroupUuids) + ] + then return True + else return False diff --git a/wizard-server/src/Wizard/Service/Project/ProjectAudit.hs b/wizard-server/src/Wizard/Service/Project/ProjectAudit.hs new file mode 100644 index 000000000..ad0c96822 --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/ProjectAudit.hs @@ -0,0 +1,13 @@ +module Wizard.Service.Project.ProjectAudit where + +import qualified Data.UUID as U + +import Shared.Audit.Service.Audit.AuditService +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.ContextLenses () + +auditProjectListEvents :: U.UUID -> AppContextM () +auditProjectListEvents projectUuid = logAudit "project" "listEvents" (U.toString projectUuid) + +auditProjectDetailEvent :: U.UUID -> AppContextM () +auditProjectDetailEvent projectUuid = logAudit "project" "detailEvent" (U.toString projectUuid) diff --git a/wizard-server/src/Wizard/Service/Project/ProjectCommandExecutor.hs b/wizard-server/src/Wizard/Service/Project/ProjectCommandExecutor.hs new file mode 100644 index 000000000..32602af20 --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/ProjectCommandExecutor.hs @@ -0,0 +1,31 @@ +module Wizard.Service.Project.ProjectCommandExecutor where + +import Control.Monad.Except (throwError) +import Data.Aeson (eitherDecode) +import qualified Data.ByteString.Lazy.Char8 as BSL +import qualified Data.UUID as U + +import Shared.Common.Model.Error.Error +import Shared.Common.Util.Logger +import Shared.PersistentCommand.Model.PersistentCommand.PersistentCommand +import Wizard.Model.Context.AppContext +import Wizard.Service.Project.ProjectService +import WizardLib.Public.Model.PersistentCommand.Project.CreateProjectCommand + +cComponent = "project" + +execute :: PersistentCommand U.UUID -> AppContextM (PersistentCommandState, Maybe String) +execute command + | command.function == cCreateProjectsName = cCreateProjects command + | otherwise = throwError . GeneralServerError $ "Unknown command function: " <> command.function + +cCreateProjectsName = "createProjects" + +cCreateProjects :: PersistentCommand U.UUID -> AppContextM (PersistentCommandState, Maybe String) +cCreateProjects persistentCommand = do + let eCommands = eitherDecode (BSL.pack persistentCommand.body) :: Either String [CreateProjectCommand] + case eCommands of + Right commands -> do + createProjectsFromCommands commands + return (DonePersistentCommandState, Nothing) + Left error -> return (ErrorPersistentCommandState, Just $ f' "Problem in deserialization of JSON: %s" [error]) diff --git a/wizard-server/src/Wizard/Service/Project/ProjectMapper.hs b/wizard-server/src/Wizard/Service/Project/ProjectMapper.hs new file mode 100644 index 000000000..45a518817 --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/ProjectMapper.hs @@ -0,0 +1,371 @@ +module Wizard.Service.Project.ProjectMapper where + +import qualified Data.Map.Strict as M +import Data.Time +import qualified Data.UUID as U + +import Shared.DocumentTemplate.Api.Resource.DocumentTemplate.DocumentTemplateDTO +import Shared.DocumentTemplate.Constant.DocumentTemplate +import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplate +import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplateFormatSimple +import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel +import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackage +import qualified Shared.KnowledgeModel.Service.KnowledgeModel.Package.KnowledgeModelPackageMapper as SPM +import Wizard.Api.Resource.Project.Acl.ProjectPermChangeDTO +import Wizard.Api.Resource.Project.Acl.ProjectPermDTO +import Wizard.Api.Resource.Project.Detail.ProjectDetailDTO +import Wizard.Api.Resource.Project.Detail.ProjectDetailQuestionnaireDTO +import Wizard.Api.Resource.Project.Detail.ProjectDetailWsDTO +import Wizard.Api.Resource.Project.ProjectContentChangeDTO +import Wizard.Api.Resource.Project.ProjectContentDTO +import Wizard.Api.Resource.Project.ProjectCreateDTO +import Wizard.Api.Resource.Project.ProjectCreateFromTemplateDTO +import Wizard.Api.Resource.Project.ProjectDTO +import Wizard.Api.Resource.Project.ProjectReportDTO +import Wizard.Api.Resource.Project.ProjectSettingsChangeDTO +import Wizard.Api.Resource.Project.ProjectShareChangeDTO +import Wizard.Api.Resource.User.UserDTO +import Wizard.Constant.Acl +import Wizard.Model.DocumentTemplate.DocumentTemplateState +import Wizard.Model.Project.Acl.ProjectPerm +import Wizard.Model.Project.Comment.ProjectCommentList +import Wizard.Model.Project.Detail.ProjectDetail +import Wizard.Model.Project.Detail.ProjectDetailQuestionnaire +import Wizard.Model.Project.Event.ProjectEvent +import Wizard.Model.Project.Event.ProjectEventList +import Wizard.Model.Project.Project +import Wizard.Model.Project.ProjectContent +import Wizard.Model.Project.ProjectList +import Wizard.Model.Project.ProjectReply +import Wizard.Model.Project.ProjectSimple +import Wizard.Model.Project.ProjectState +import Wizard.Model.Project.ProjectSuggestion +import Wizard.Model.Project.Version.ProjectVersionList +import Wizard.Model.Report.Report +import Wizard.Model.Tenant.Config.TenantConfig +import Wizard.Model.User.User +import Wizard.Service.Acl.AclMapper +import Wizard.Service.Project.Event.ProjectEventMapper +import WizardLib.Public.Model.PersistentCommand.Project.CreateProjectCommand +import WizardLib.Public.Model.User.UserGroup + +toDTO :: Project -> KnowledgeModelPackage -> ProjectState -> [ProjectPermDTO] -> ProjectDTO +toDTO project kmPackage state permissions = + ProjectDTO + { uuid = project.uuid + , name = project.name + , description = project.description + , visibility = project.visibility + , sharing = project.sharing + , state = state + , knowledgeModelPackage = SPM.toSimple kmPackage + , permissions = permissions + , isTemplate = project.isTemplate + , createdAt = project.createdAt + , updatedAt = project.updatedAt + } + +toDTO' :: ProjectList -> ProjectDTO +toDTO' project = + ProjectDTO + { uuid = project.uuid + , name = project.name + , description = project.description + , visibility = project.visibility + , sharing = project.sharing + , state = project.state + , knowledgeModelPackage = project.knowledgeModelPackage + , permissions = project.permissions + , isTemplate = project.isTemplate + , createdAt = project.createdAt + , updatedAt = project.updatedAt + } + +toSimpleDTO :: Project -> KnowledgeModelPackage -> ProjectState -> [ProjectPermDTO] -> ProjectDTO +toSimpleDTO project kmPackage state permissions = + ProjectDTO + { uuid = project.uuid + , name = project.name + , description = project.description + , visibility = project.visibility + , sharing = project.sharing + , state = state + , knowledgeModelPackage = SPM.toSimple kmPackage + , permissions = permissions + , isTemplate = project.isTemplate + , createdAt = project.createdAt + , updatedAt = project.updatedAt + } + +toDetailQuestionnaire :: Project -> Maybe U.UUID -> [ProjectPermDTO] -> Int -> Int -> ProjectDetailQuestionnaire +toDetailQuestionnaire project migrationUuid permissions projectActionsAvailable projectImportersAvailable = + ProjectDetailQuestionnaire + { uuid = project.uuid + , name = project.name + , visibility = project.visibility + , sharing = project.sharing + , knowledgeModelPackageId = project.knowledgeModelPackageId + , selectedQuestionTagUuids = project.selectedQuestionTagUuids + , isTemplate = project.isTemplate + , migrationUuid = migrationUuid + , permissions = permissions + , files = [] + , projectActionsAvailable = projectActionsAvailable + , projectImportersAvailable = projectImportersAvailable + } + +toDetailDTO :: ProjectDetail -> ProjectDetailDTO +toDetailDTO ProjectDetail {..} = + ProjectDetailDTO {..} + +toDetailProjectDTO :: ProjectDetailQuestionnaire -> M.Map String (M.Map U.UUID Int) -> M.Map String (M.Map U.UUID Int) -> KnowledgeModel -> Maybe U.UUID -> M.Map String Reply -> M.Map String [U.UUID] -> ProjectDetailQuestionnaireDTO +toDetailProjectDTO ProjectDetailQuestionnaire {..} unresolvedCommentCounts resolvedCommentCounts knowledgeModel phaseUuid replies labels = + let fileCount = length files + in ProjectDetailQuestionnaireDTO {..} + +toDetailWsDTO :: Project -> Maybe DocumentTemplateDTO -> Maybe DocumentTemplateFormatSimple -> [ProjectPermDTO] -> M.Map String [U.UUID] -> M.Map String (M.Map U.UUID Int) -> M.Map String (M.Map U.UUID Int) -> ProjectDetailWsDTO +toDetailWsDTO project mTemplate mFormat projectPerms labels unresolvedCommentCounts resolvedCommentCounts = + ProjectDetailWsDTO + { name = project.name + , description = project.description + , visibility = project.visibility + , sharing = project.sharing + , projectTags = project.projectTags + , documentTemplateId = project.documentTemplateId + , documentTemplate = mTemplate + , formatUuid = project.formatUuid + , format = mFormat + , permissions = projectPerms + , isTemplate = project.isTemplate + , labels = labels + , unresolvedCommentCounts = unresolvedCommentCounts + , resolvedCommentCounts = resolvedCommentCounts + } + +toContentDTO + :: ProjectContent + -> M.Map String [ProjectCommentThreadList] + -> [ProjectEventList] + -> [ProjectVersionList] + -> ProjectContentDTO +toContentDTO projectContent threads events versions = + ProjectContentDTO + { phaseUuid = projectContent.phaseUuid + , replies = projectContent.replies + , commentThreadsMap = threads + , labels = projectContent.labels + , events = events + , versions = versions + } + +toProjectReportDTO :: [Indication] -> ProjectReportDTO +toProjectReportDTO indications = ProjectReportDTO {indications = indications} + +toChangeDTO :: Project -> ProjectShareChangeDTO +toChangeDTO project = + ProjectShareChangeDTO + { visibility = project.visibility + , sharing = project.sharing + , permissions = fmap toProjectPermChangeDTO project.permissions + } + +toUserProjectPerm :: U.UUID -> U.UUID -> [String] -> U.UUID -> ProjectPerm +toUserProjectPerm projectUuid userUuid perms tenantUuid = + ProjectPerm + { projectUuid = projectUuid + , memberType = UserProjectPermType + , memberUuid = userUuid + , perms = perms + , tenantUuid = tenantUuid + } + +toUserGroupProjectPerm :: U.UUID -> U.UUID -> [String] -> U.UUID -> ProjectPerm +toUserGroupProjectPerm projectUuid userGroupUuid perms tenantUuid = + ProjectPerm + { projectUuid = projectUuid + , memberType = UserGroupProjectPermType + , memberUuid = userGroupUuid + , perms = perms + , tenantUuid = tenantUuid + } + +toUserProjectPermDTO :: ProjectPerm -> User -> ProjectPermDTO +toUserProjectPermDTO projectPerm user = + ProjectPermDTO + { projectUuid = projectPerm.projectUuid + , member = toUserMemberDTO user + , perms = projectPerm.perms + } + +toUserGroupProjectPermDTO :: ProjectPerm -> UserGroup -> ProjectPermDTO +toUserGroupProjectPermDTO projectPerm userGroup = + ProjectPermDTO + { projectUuid = projectPerm.projectUuid + , member = toUserGroupMemberDTO userGroup + , perms = projectPerm.perms + } + +toProjectPermChangeDTO :: ProjectPerm -> ProjectPermChangeDTO +toProjectPermChangeDTO projectPerm = + ProjectPermChangeDTO + { memberUuid = projectPerm.memberUuid + , memberType = projectPerm.memberType + , perms = projectPerm.perms + } + +toSimple :: Project -> ProjectSimple +toSimple project = ProjectSimple {uuid = project.uuid, name = project.name} + +toSuggestion :: Project -> ProjectSuggestion +toSuggestion project = ProjectSuggestion {uuid = project.uuid, name = project.name, description = project.description} + +toCreateFromTemplateDTO :: Project -> ProjectCreateFromTemplateDTO +toCreateFromTemplateDTO project = + ProjectCreateFromTemplateDTO + { name = project.name + , projectUuid = project.uuid + } + +toProjectDetailTemplateState :: Maybe DocumentTemplate -> Maybe DocumentTemplateState +toProjectDetailTemplateState = + fmap + ( \tml -> + if tml.metamodelVersion /= documentTemplateMetamodelVersion + then UnsupportedMetamodelVersionDocumentTemplateState + else DefaultDocumentTemplateState + ) + +fromShareChangeDTO :: Project -> ProjectShareChangeDTO -> ProjectVisibility -> ProjectSharing -> UTCTime -> Project +fromShareChangeDTO project dto visibility sharing now = + Project + { uuid = project.uuid + , name = project.name + , description = project.description + , visibility = visibility + , sharing = sharing + , knowledgeModelPackageId = project.knowledgeModelPackageId + , selectedQuestionTagUuids = project.selectedQuestionTagUuids + , projectTags = project.projectTags + , documentTemplateId = project.documentTemplateId + , formatUuid = project.formatUuid + , creatorUuid = project.creatorUuid + , permissions = fmap (fromProjectPermChangeDTO project.uuid project.tenantUuid) dto.permissions + , isTemplate = project.isTemplate + , squashed = project.squashed + , tenantUuid = project.tenantUuid + , createdAt = project.createdAt + , updatedAt = now + } + +fromSettingsChangeDTO :: Project -> ProjectSettingsChangeDTO -> UserDTO -> UTCTime -> Project +fromSettingsChangeDTO project dto currentUser now = + Project + { uuid = project.uuid + , name = dto.name + , description = dto.description + , visibility = project.visibility + , sharing = project.sharing + , knowledgeModelPackageId = project.knowledgeModelPackageId + , selectedQuestionTagUuids = project.selectedQuestionTagUuids + , projectTags = dto.projectTags + , documentTemplateId = dto.documentTemplateId + , formatUuid = dto.formatUuid + , creatorUuid = project.creatorUuid + , permissions = project.permissions + , isTemplate = + if _PRJ_TML_PERM `elem` currentUser.permissions + then dto.isTemplate + else project.isTemplate + , squashed = project.squashed + , tenantUuid = project.tenantUuid + , createdAt = project.createdAt + , updatedAt = now + } + +fromProjectCreateDTO + :: ProjectCreateDTO + -> U.UUID + -> ProjectVisibility + -> ProjectSharing + -> Maybe U.UUID + -> String + -> U.UUID + -> Maybe U.UUID + -> U.UUID + -> UTCTime + -> (Project, [ProjectEvent]) +fromProjectCreateDTO dto projectUuid visibility sharing mCurrentUserUuid pkgId phaseEventUuid mPhase tenantUuid now = + ( Project + { uuid = projectUuid + , name = dto.name + , description = Nothing + , visibility = visibility + , sharing = sharing + , knowledgeModelPackageId = pkgId + , selectedQuestionTagUuids = dto.questionTagUuids + , projectTags = [] + , documentTemplateId = dto.documentTemplateId + , formatUuid = dto.formatUuid + , creatorUuid = mCurrentUserUuid + , permissions = + case mCurrentUserUuid of + Just currentUserUuid -> [toUserProjectPerm projectUuid currentUserUuid ownerPermissions tenantUuid] + Nothing -> [] + , isTemplate = False + , squashed = True + , tenantUuid = tenantUuid + , createdAt = now + , updatedAt = now + } + , case mPhase of + Just phase -> + [ SetPhaseEvent' $ + SetPhaseEvent + { uuid = phaseEventUuid + , phaseUuid = Just phase + , projectUuid = projectUuid + , tenantUuid = tenantUuid + , createdBy = mCurrentUserUuid + , createdAt = now + } + ] + Nothing -> [] + ) + +fromContentChangeDTO :: Project -> [ProjectEvent] -> ProjectContentChangeDTO -> Maybe UserDTO -> UTCTime -> (Project, [ProjectEvent]) +fromContentChangeDTO project events dto mCurrentUser now = + let newTodoEvents = fmap (\e -> fromEventChangeDTO e project.uuid project.tenantUuid (fmap (.uuid) mCurrentUser) now) dto.events + updatedEvents = events ++ newTodoEvents + in (project {updatedAt = now}, updatedEvents) + +fromProjectPermChangeDTO :: U.UUID -> U.UUID -> ProjectPermChangeDTO -> ProjectPerm +fromProjectPermChangeDTO projectUuid tenantUuid dto = + ProjectPerm + { projectUuid = projectUuid + , memberType = dto.memberType + , memberUuid = dto.memberUuid + , perms = dto.perms + , tenantUuid = tenantUuid + } + +fromCreateProjectCommand :: CreateProjectCommand -> U.UUID -> [ProjectPerm] -> TenantConfigProject -> U.UUID -> UTCTime -> Project +fromCreateProjectCommand command uuid permissions tcProject createdBy now = do + Project + { uuid = uuid + , name = command.name + , description = Nothing + , visibility = tcProject.projectVisibility.defaultValue + , sharing = tcProject.projectSharing.defaultValue + , knowledgeModelPackageId = command.knowledgeModelPackageId + , selectedQuestionTagUuids = [] + , projectTags = [] + , documentTemplateId = command.documentTemplateId + , formatUuid = Nothing + , creatorUuid = Just createdBy + , permissions = permissions + , isTemplate = False + , squashed = True + , tenantUuid = tcProject.tenantUuid + , createdAt = now + , updatedAt = now + } diff --git a/wizard-server/src/Wizard/Service/Project/ProjectService.hs b/wizard-server/src/Wizard/Service/Project/ProjectService.hs new file mode 100644 index 000000000..01209e401 --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/ProjectService.hs @@ -0,0 +1,454 @@ +module Wizard.Service.Project.ProjectService where + +import Control.Monad (void, when) +import Control.Monad.Except (catchError, throwError) +import Control.Monad.Reader (asks, liftIO) +import Data.Foldable (traverse_) +import qualified Data.List as L +import qualified Data.Map.Strict as M +import Data.Time +import qualified Data.UUID as U + +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Common.Lens +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.Pageable +import Shared.Common.Model.Common.Sort +import Shared.Common.Model.Error.Error +import Shared.Common.Util.List +import Shared.Common.Util.Logger +import Shared.Common.Util.Uuid +import Shared.DocumentTemplate.Database.DAO.DocumentTemplate.DocumentTemplateDAO +import Shared.DocumentTemplate.Database.DAO.DocumentTemplate.DocumentTemplateFormatDAO +import qualified Shared.DocumentTemplate.Service.DocumentTemplate.DocumentTemplateMapper as STM +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel +import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackage +import Shared.KnowledgeModel.Service.KnowledgeModel.Package.KnowledgeModelPackageUtil +import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSimpleDTO +import Wizard.Api.Resource.Project.Detail.ProjectDetailDTO +import Wizard.Api.Resource.Project.Detail.ProjectDetailQuestionnaireDTO +import Wizard.Api.Resource.Project.Event.ProjectEventDTO +import Wizard.Api.Resource.Project.ProjectContentChangeDTO +import Wizard.Api.Resource.Project.ProjectCreateDTO +import Wizard.Api.Resource.Project.ProjectCreateFromTemplateDTO +import Wizard.Api.Resource.Project.ProjectDTO +import Wizard.Api.Resource.Project.ProjectSettingsChangeDTO +import Wizard.Api.Resource.Project.ProjectShareChangeDTO +import Wizard.Api.Resource.User.UserDTO +import Wizard.Database.DAO.Common +import Wizard.Database.DAO.Document.DocumentDAO +import Wizard.Database.DAO.Project.ProjectCommentThreadDAO +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectEventDAO +import Wizard.Database.DAO.User.UserDAO +import Wizard.Localization.Messages.Internal +import Wizard.Model.Context.AclContext +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.AppContextHelpers +import Wizard.Model.Project.Acl.ProjectAclHelpers +import Wizard.Model.Project.Acl.ProjectPerm +import Wizard.Model.Project.Detail.ProjectDetail +import Wizard.Model.Project.Detail.ProjectDetailPreview +import Wizard.Model.Project.Detail.ProjectDetailQuestionnaire +import Wizard.Model.Project.Detail.ProjectDetailSettings +import Wizard.Model.Project.Event.ProjectEventList +import Wizard.Model.Project.File.ProjectFile +import Wizard.Model.Project.Project +import Wizard.Model.Project.ProjectContent +import Wizard.Model.Project.ProjectReply +import Wizard.Model.Tenant.Config.TenantConfig +import Wizard.Service.KnowledgeModel.KnowledgeModelService +import Wizard.Service.KnowledgeModel.Package.KnowledgeModelPackageService +import Wizard.Service.Mail.Mailer +import Wizard.Service.Project.Collaboration.ProjectCollaborationService +import Wizard.Service.Project.Comment.ProjectCommentService +import Wizard.Service.Project.Compiler.ProjectCompilerService +import Wizard.Service.Project.Event.ProjectEventMapper +import Wizard.Service.Project.File.ProjectFileService +import Wizard.Service.Project.ProjectAcl +import Wizard.Service.Project.ProjectAudit +import Wizard.Service.Project.ProjectMapper +import Wizard.Service.Project.ProjectUtil +import Wizard.Service.Project.ProjectValidation +import Wizard.Service.Project.Version.ProjectVersionService +import Wizard.Service.Tenant.Config.ConfigService +import Wizard.Service.Tenant.Limit.LimitService +import WizardLib.Public.Model.PersistentCommand.Project.CreateProjectCommand + +getProjectsForCurrentUserPageDto + :: Maybe String + -> Maybe Bool + -> Maybe Bool + -> Maybe [String] + -> Maybe String + -> Maybe [String] + -> Maybe String + -> Maybe [String] + -> Maybe String + -> Pageable + -> [Sort] + -> AppContextM (Page ProjectDTO) +getProjectsForCurrentUserPageDto mQuery mIsTemplate mIsMigrating mProjectTags mProjectTagsOp mUserUuids mUserUuidsOp mKnowledgeModelPackageIds mKnowledgeModelPackageIdsOp pageable sort = do + checkPermission _PRJ_PERM + currentUser <- getCurrentUser + projectPage <- + findProjectsForCurrentUserPage + mQuery + mIsTemplate + mIsMigrating + mProjectTags + mProjectTagsOp + mUserUuids + mUserUuidsOp + mKnowledgeModelPackageIds + mKnowledgeModelPackageIdsOp + pageable + sort + return . fmap toDTO' $ projectPage + +createProject :: ProjectCreateDTO -> AppContextM ProjectDTO +createProject reqDto = + liftIO generateUuid >>= createProjectWithGivenUuid reqDto + +createProjectWithGivenUuid :: ProjectCreateDTO -> U.UUID -> AppContextM ProjectDTO +createProjectWithGivenUuid reqDto projectUuid = + runInTransaction $ do + checkProjectLimit + checkCreatePermissionToProject + pkgId <- resolvePackageId reqDto.knowledgeModelPackageId + pkg <- findPackageById pkgId + projectState <- getProjectState projectUuid pkgId + now <- liftIO getCurrentTime + tenantUuid <- asks currentTenantUuid + visibility <- extractVisibility reqDto + sharing <- extractSharing reqDto + mCurrentUser <- asks currentUser + knowledgeModel <- compileKnowledgeModel [] (Just pkgId) reqDto.questionTagUuids + phaseEventUuid <- liftIO generateUuid + let (project, projectEvents) = + fromProjectCreateDTO + reqDto + projectUuid + visibility + sharing + (fmap (.uuid) mCurrentUser) + pkgId + phaseEventUuid + (headSafe knowledgeModel.phaseUuids) + tenantUuid + now + insertProject project + insertProjectEvents projectEvents + permissionDtos <- traverse enhanceProjectPerm project.permissions + return $ toSimpleDTO project pkg projectState permissionDtos + +createProjectFromTemplate :: ProjectCreateFromTemplateDTO -> AppContextM ProjectDTO +createProjectFromTemplate reqDto = + runInTransaction $ do + checkProjectLimit + originProject <- findProjectByUuid reqDto.projectUuid + checkCreateFromTemplatePermissionToProject originProject.isTemplate + pkg <- findPackageById originProject.knowledgeModelPackageId + newProjectUuid <- liftIO generateUuid + currentUser <- getCurrentUser + now <- liftIO getCurrentTime + tcProject <- getCurrentTenantConfigProject + originProjectEvents <- findProjectEventListsByProjectUuid reqDto.projectUuid + let newVisibility = tcProject.projectVisibility.defaultValue + let newSharing = tcProject.projectSharing.defaultValue + let newPermissions = [toUserProjectPerm newProjectUuid currentUser.uuid ownerPermissions tcProject.tenantUuid] + let newProject = + originProject + { uuid = newProjectUuid + , name = reqDto.name + , description = Nothing + , sharing = newSharing + , visibility = newVisibility + , permissions = newPermissions + , isTemplate = False + , creatorUuid = Just $ currentUser.uuid + , createdAt = now + , updatedAt = now + } + :: Project + insertProject newProject + clonedFiles <- cloneProjectFiles originProject.uuid newProject.uuid + newProjectEventsWithOldEventUuid <- cloneProjectEventsWithOldEventUuid originProjectEvents + let newProjectEvents = fmap snd newProjectEventsWithOldEventUuid + let newProjectEventsWithReplacedFiles = replaceProjectEventsWithNewFiles clonedFiles newProjectEvents + insertProjectEvents (fmap (toEvent newProjectUuid newProject.tenantUuid) newProjectEventsWithReplacedFiles) + duplicateCommentThreads reqDto.projectUuid newProjectUuid + cloneProjectVersions originProject.uuid newProject.uuid newProjectEventsWithOldEventUuid + state <- getProjectState newProjectUuid pkg.pId + permissionDtos <- traverse enhanceProjectPerm newProject.permissions + return $ toSimpleDTO newProject pkg state permissionDtos + +cloneProject :: U.UUID -> AppContextM ProjectDTO +cloneProject cloneUuid = + runInTransaction $ do + checkProjectLimit + originProject <- findProjectByUuid cloneUuid + checkClonePermissionToProject originProject.visibility originProject.sharing originProject.permissions + pkg <- findPackageById originProject.knowledgeModelPackageId + newProjectUuid <- liftIO generateUuid + currentUser <- getCurrentUser + now <- liftIO getCurrentTime + originProjectEvents <- findProjectEventListsByProjectUuid originProject.uuid + let ownerPerm = toUserProjectPerm newProjectUuid currentUser.uuid ownerPermissions originProject.tenantUuid + let newPermissions = ownerPerm : removeUserPermission currentUser.uuid originProject.permissions + let newDuplicatedPermissions = fmap (\permission -> permission {projectUuid = newProjectUuid} :: ProjectPerm) newPermissions + let newProject = + originProject + { uuid = newProjectUuid + , name = "Copy of " ++ originProject.name + , permissions = newDuplicatedPermissions + , updatedAt = now + } + :: Project + insertProject newProject + clonedFiles <- cloneProjectFiles originProject.uuid newProject.uuid + newProjectEventsWithOldEventUuid <- cloneProjectEventsWithOldEventUuid originProjectEvents + let newProjectEvents = fmap snd newProjectEventsWithOldEventUuid + let newProjectEventsWithReplacedFiles = replaceProjectEventsWithNewFiles clonedFiles newProjectEvents + insertProjectEvents (fmap (toEvent newProjectUuid newProject.tenantUuid) newProjectEventsWithReplacedFiles) + cloneProjectVersions originProject.uuid newProject.uuid newProjectEventsWithOldEventUuid + duplicateCommentThreads cloneUuid newProjectUuid + state <- getProjectState newProjectUuid pkg.pId + permissionDtos <- traverse enhanceProjectPerm newProject.permissions + return $ toSimpleDTO newProject pkg state permissionDtos + +createProjectsFromCommands :: [CreateProjectCommand] -> AppContextM () +createProjectsFromCommands = runInTransaction . traverse_ create + where + create :: CreateProjectCommand -> AppContextM () + create command = do + uuid <- liftIO generateUuid + currentUser <- getCurrentUser + now <- liftIO getCurrentTime + tcProject <- getCurrentTenantConfigProject + users <- findUsersByEmails command.emails + let permissions = fmap (createPermission uuid) users + let project = fromCreateProjectCommand command uuid permissions tcProject currentUser.uuid now + insertProject project + return () + createPermission :: U.UUID -> User -> ProjectPerm + createPermission projectUuid user = toUserProjectPerm projectUuid user.uuid ownerPermissions user.tenantUuid + +getProjectById :: U.UUID -> AppContextM ProjectDTO +getProjectById projectUuid = do + mProject <- getProjectById' projectUuid + case mProject of + Just project -> return project + Nothing -> throwError $ NotExistsError $ _ERROR_DATABASE__ENTITY_NOT_FOUND "project" [("uuid", U.toString projectUuid)] + +getProjectById' :: U.UUID -> AppContextM (Maybe ProjectDTO) +getProjectById' projectUuid = do + mProject <- findProjectByUuid' projectUuid + case mProject of + Just project -> do + checkViewPermissionToProject project.visibility project.sharing project.permissions + package <- getPackageById project.knowledgeModelPackageId + state <- getProjectState projectUuid package.pId + permissionDtos <- traverse enhanceProjectPerm project.permissions + return . Just $ toDTO project package state permissionDtos + Nothing -> return Nothing + +getProjectDetailByUuid :: U.UUID -> AppContextM ProjectDetailDTO +getProjectDetailByUuid projectUuid = do + project <- findProjectDetail projectUuid + checkViewPermissionToProject project.visibility project.sharing project.permissions + return $ toDetailDTO project + +getProjectDetailQuestionnaireByUuid :: U.UUID -> AppContextM ProjectDetailQuestionnaireDTO +getProjectDetailQuestionnaireByUuid projectUuid = do + project <- findProjectDetailQuestionnaire projectUuid + projectEvents <- findProjectEventListsByProjectUuid projectUuid + checkViewPermissionToProject project.visibility project.sharing project.permissions + editor <- catchError (hasEditPermissionToProject project.visibility project.sharing project.permissions) (\_ -> return False) + commenter <- catchError (hasCommentPermissionToProject project.visibility project.sharing project.permissions) (\_ -> return False) + unresolvedCommentCounts <- + if commenter + then findProjectCommentThreadsSimple projectUuid False editor + else return M.empty + resolvedCommentCounts <- + if commenter + then findProjectCommentThreadsSimple projectUuid True editor + else return M.empty + knowledgeModel <- compileKnowledgeModel [] (Just project.knowledgeModelPackageId) project.selectedQuestionTagUuids + let projectContent = compileProjectEvents projectEvents + let labels = + if editor + then projectContent.labels + else M.empty + return $ toDetailProjectDTO project unresolvedCommentCounts resolvedCommentCounts knowledgeModel projectContent.phaseUuid projectContent.replies labels + +getProjectDetailPreviewById :: U.UUID -> AppContextM ProjectDetailPreview +getProjectDetailPreviewById projectUuid = do + project <- findProjectDetailPreview projectUuid + checkViewPermissionToProject project.visibility project.sharing project.permissions + return project + +getProjectDetailSettingsById :: U.UUID -> AppContextM ProjectDetailSettings +getProjectDetailSettingsById projectUuid = do + project <- findProjectDetailSettings projectUuid + checkViewPermissionToProject project.visibility project.sharing project.permissions + knowledgeModel <- compileKnowledgeModel [] (Just project.knowledgeModelPackage.pId) project.selectedQuestionTagUuids + return $ project {knowledgeModelTags = M.elems knowledgeModel.entities.tags} + +getProjectEventsPage :: U.UUID -> Pageable -> [Sort] -> AppContextM (Page ProjectEventList) +getProjectEventsPage projectUuid pageable sort = do + project <- findProjectByUuid projectUuid + events <- findProjectEventsPage projectUuid pageable sort + checkViewPermissionToProject project.visibility project.sharing project.permissions + auditProjectListEvents projectUuid + return events + +getProjectEventForProjectUuid :: U.UUID -> U.UUID -> AppContextM ProjectEventDTO +getProjectEventForProjectUuid projectUuid eventUuid = do + project <- findProjectByUuid projectUuid + checkViewPermissionToProject project.visibility project.sharing project.permissions + auditProjectDetailEvent projectUuid + event <- findProjectEventByUuid eventUuid + mUser <- + case getCreatedBy event of + Just userUuid -> findUserByUuid' userUuid + Nothing -> return Nothing + return $ toEventDTO event mUser + +modifyProjectShare :: U.UUID -> ProjectShareChangeDTO -> AppContextM ProjectShareChangeDTO +modifyProjectShare projectUuid reqDto = + runInTransaction $ do + checkPermission _PRJ_PERM + project <- findProjectByUuid projectUuid + skipIfAssigningProject project (checkOwnerPermissionToProject project.visibility project.permissions) + now <- liftIO getCurrentTime + qVisibility <- extractVisibility reqDto + qSharing <- extractSharing reqDto + let updatedProject = fromShareChangeDTO project reqDto qVisibility qSharing now + updateProjectByUuid updatedProject + updatePermsForOnlineUsers projectUuid updatedProject.visibility updatedProject.sharing updatedProject.permissions + permissionDtos <- traverse enhanceProjectPerm updatedProject.permissions + skipIfAssigningProject + project + ( catchError + (sendProjectInvitationMail project updatedProject) + (\errMessage -> throwError $ GeneralServerError _ERROR_SERVICE_PROJECT__INVITATION_EMAIL_NOT_SENT) + ) + mTemplate <- + case updatedProject.documentTemplateId of + Just tId -> do + tml <- findDocumentTemplateById tId + formats <- findDocumentTemplateFormats tId + return . Just $ STM.toDTO tml formats + _ -> return Nothing + mFormat <- + case (updatedProject.documentTemplateId, updatedProject.formatUuid) of + (Just dtId, Just formatUuid) -> do + format <- findDocumentTemplateFormatByDocumentTemplateIdAndUuid dtId formatUuid + return $ Just format + _ -> return Nothing + projectEvents <- findProjectEventListsByProjectUuid projectUuid + let projectContent = compileProjectEvents projectEvents + unresolvedCommentCounts <- findProjectCommentThreadsSimple projectUuid False True + resolvedCommentCounts <- findProjectCommentThreadsSimple projectUuid True True + let restWsDto = toDetailWsDTO updatedProject mTemplate mFormat permissionDtos projectContent.labels unresolvedCommentCounts resolvedCommentCounts + setProject projectUuid restWsDto + return reqDto + +modifyProjectSettings :: U.UUID -> ProjectSettingsChangeDTO -> AppContextM ProjectSettingsChangeDTO +modifyProjectSettings projectUuid reqDto = + runInTransaction $ do + checkPermission _PRJ_PERM + validateProjectSettingsChangeDTO reqDto + project <- findProjectByUuid projectUuid + skipIfAssigningProject project (checkOwnerPermissionToProject project.visibility project.permissions) + currentUser <- getCurrentUser + now <- liftIO getCurrentTime + let updatedProject = fromSettingsChangeDTO project reqDto currentUser now + updateProjectByUuid updatedProject + permissionDtos <- traverse enhanceProjectPerm updatedProject.permissions + deleteTemporalDocumentsByProjectUuid project.uuid + mTemplate <- + case updatedProject.documentTemplateId of + Just tId -> do + tml <- findDocumentTemplateById tId + formats <- findDocumentTemplateFormats tId + return . Just $ STM.toDTO tml formats + _ -> return Nothing + mFormat <- + case (updatedProject.documentTemplateId, updatedProject.formatUuid) of + (Just dtId, Just formatUuid) -> do + format <- findDocumentTemplateFormatByDocumentTemplateIdAndUuid dtId formatUuid + return $ Just format + _ -> return Nothing + projectEvents <- findProjectEventListsByProjectUuid projectUuid + let projectContent = compileProjectEvents projectEvents + unresolvedCommentCounts <- findProjectCommentThreadsSimple projectUuid False True + resolvedCommentCounts <- findProjectCommentThreadsSimple projectUuid True True + let restWsDto = toDetailWsDTO updatedProject mTemplate mFormat permissionDtos projectContent.labels unresolvedCommentCounts resolvedCommentCounts + setProject projectUuid restWsDto + return reqDto + +deleteProject :: U.UUID -> Bool -> AppContextM () +deleteProject projectUuid shouldValidatePermission = + runInTransaction $ do + project <- findProjectByUuid projectUuid + validateProjectDeletion projectUuid + when shouldValidatePermission (checkOwnerPermissionToProject project.visibility project.permissions) + deleteProjectByUuid projectUuid + void $ logOutOnlineUsersWhenProjectDramaticallyChanged projectUuid + +modifyContent :: U.UUID -> ProjectContentChangeDTO -> AppContextM ProjectContentChangeDTO +modifyContent projectUuid reqDto = + runInTransaction $ do + project <- findProjectByUuid projectUuid + checkEditPermissionToProject project.visibility project.sharing project.permissions + mCurrentUser <- asks currentUser + now <- liftIO getCurrentTime + projectEvents <- findProjectEventsByProjectUuid projectUuid + let (updatedProject, updatedProjectEvents) = fromContentChangeDTO project projectEvents reqDto mCurrentUser now + syncProjectEventsWithDb projectEvents updatedProjectEvents + updateProjectSquashedAndUpdatedAtByUuid projectUuid False now + return reqDto + +cleanProjects :: AppContextM () +cleanProjects = + runInTransaction $ do + projects <- findProjectsWithZeroAcl + traverse_ + ( \project -> do + logInfoI _CMP_SERVICE (f' "Clean project with empty ACL (projectUuid: '%s')" [U.toString project.uuid]) + deleteProject project.uuid False + ) + projects + +cloneProjectEvents :: [ProjectEventList] -> AppContextM [ProjectEventList] +cloneProjectEvents oldEvents = do + newEvents <- cloneProjectEventsWithOldEventUuid oldEvents + return $ fmap snd newEvents + +cloneProjectEventsWithOldEventUuid :: [ProjectEventList] -> AppContextM [(U.UUID, ProjectEventList)] +cloneProjectEventsWithOldEventUuid = + traverse + ( \event -> do + newEventUuid <- liftIO generateUuid + return (getUuid event, setUuid event newEventUuid) + ) + +replaceProjectEventsWithNewFiles :: [(ProjectFile, ProjectFile)] -> [ProjectEventList] -> [ProjectEventList] +replaceProjectEventsWithNewFiles clonedFiles projectEvents = + let findFile :: U.UUID -> Maybe (ProjectFile, ProjectFile) + findFile fileUuid = L.find (\(oldFile, newFile) -> oldFile.uuid == fileUuid) clonedFiles + replaceEvent :: ProjectEventList -> ProjectEventList + replaceEvent (SetReplyEventList' 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 SetReplyEventList' (event {value = value'}) + replaceEvent event' = event' + in fmap replaceEvent projectEvents diff --git a/wizard-server/src/Wizard/Service/Project/ProjectUtil.hs b/wizard-server/src/Wizard/Service/Project/ProjectUtil.hs new file mode 100644 index 000000000..4dc1941be --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/ProjectUtil.hs @@ -0,0 +1,60 @@ +module Wizard.Service.Project.ProjectUtil where + +import Control.Monad (when) +import qualified Data.UUID as U + +import Wizard.Api.Resource.Project.Acl.ProjectPermDTO +import Wizard.Database.DAO.Project.ProjectMigrationDAO +import Wizard.Database.DAO.User.UserDAO +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Acl.ProjectPerm +import Wizard.Model.Project.Event.ProjectEventLenses () +import Wizard.Model.Project.Project +import Wizard.Model.Project.ProjectState +import Wizard.Model.Tenant.Config.TenantConfig +import Wizard.Service.KnowledgeModel.Package.KnowledgeModelPackageService +import Wizard.Service.Project.ProjectMapper +import Wizard.Service.Tenant.Config.ConfigService +import WizardLib.Public.Database.DAO.User.UserGroupDAO + +extractVisibility dto = do + tcProject <- getCurrentTenantConfigProject + if tcProject.projectVisibility.enabled + then return dto.visibility + else return $ tcProject.projectVisibility.defaultValue + +extractSharing dto = do + tcProject <- getCurrentTenantConfigProject + if tcProject.projectSharing.enabled + then return dto.sharing + else return $ tcProject.projectSharing.defaultValue + +enhanceProjectPerm :: ProjectPerm -> AppContextM ProjectPermDTO +enhanceProjectPerm projectPerm = + case projectPerm.memberType of + UserProjectPermType -> do + user <- findUserByUuid projectPerm.memberUuid + return $ toUserProjectPermDTO projectPerm user + UserGroupProjectPermType -> do + userGroup <- findUserGroupByUuid projectPerm.memberUuid + return $ toUserGroupProjectPermDTO projectPerm userGroup + +getProjectState :: U.UUID -> String -> AppContextM ProjectState +getProjectState projectUuid pkgId = do + mMs <- findProjectMigrationByNewProjectUuid' projectUuid + case mMs of + Just _ -> return MigratingProjectState + Nothing -> do + pkgs <- getNewerPackages pkgId True + if null pkgs + then return DefaultProjectState + else return OutdatedProjectState + +skipIfAssigningProject :: Project -> AppContextM () -> AppContextM () +skipIfAssigningProject project action = do + tcProject <- getCurrentTenantConfigProject + let projectSharingEnabled = tcProject.projectSharing.enabled + let projectSharingAnonymousEnabled = tcProject.projectSharing.anonymousEnabled + when + (not (projectSharingEnabled && projectSharingAnonymousEnabled) || (not . null $ project.permissions)) + action diff --git a/wizard-server/src/Wizard/Service/Project/ProjectValidation.hs b/wizard-server/src/Wizard/Service/Project/ProjectValidation.hs new file mode 100644 index 000000000..a68564851 --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/ProjectValidation.hs @@ -0,0 +1,39 @@ +module Wizard.Service.Project.ProjectValidation where + +import Control.Monad.Except (throwError) +import Data.Foldable (forM_, traverse_) +import qualified Data.Map.Strict as M +import qualified Data.UUID as U +import Text.Regex.TDFA + +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Wizard.Api.Resource.Project.ProjectSettingsChangeDTO +import Wizard.Database.DAO.Project.ProjectMigrationDAO +import Wizard.Localization.Messages.Public +import Wizard.Model.Context.AppContext + +validateProjectSettingsChangeDTO :: ProjectSettingsChangeDTO -> AppContextM () +validateProjectSettingsChangeDTO reqDto = validateProjectTags reqDto.projectTags + +validateProjectDeletion :: U.UUID -> AppContextM () +validateProjectDeletion = validateUsageByProjectMigration + +validateUsageByProjectMigration :: U.UUID -> AppContextM () +validateUsageByProjectMigration projectUuid = do + result <- findProjectMigrationsByOldProjectUuid projectUuid + case result of + [] -> return () + _ -> throwError . UserError $ _ERROR_SERVICE_PROJECT__PROJECT_CANT_BE_DELETED_BECAUSE_IT_IS_USED_IN_MIGRATION + +validateProjectTags :: [String] -> AppContextM () +validateProjectTags = traverse_ validateProjectTag + +validateProjectTag :: String -> AppContextM () +validateProjectTag tag = forM_ (isValidProjectTag tag) throwError + +isValidProjectTag :: String -> Maybe AppError +isValidProjectTag tag = + if tag =~ "^[^,]+$" + then Nothing + else Just $ ValidationError [] (M.singleton "tags" [_ERROR_VALIDATION__FORBIDDEN_CHARACTERS tag]) diff --git a/wizard-server/src/Wizard/Service/Project/Tag/ProjectTagService.hs b/wizard-server/src/Wizard/Service/Project/Tag/ProjectTagService.hs new file mode 100644 index 000000000..481f0ec3f --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/Tag/ProjectTagService.hs @@ -0,0 +1,13 @@ +module Wizard.Service.Project.Tag.ProjectTagService where + +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.Pageable +import Shared.Common.Model.Common.Sort +import Wizard.Database.DAO.Project.ProjectTagDAO +import Wizard.Model.Context.AclContext +import Wizard.Model.Context.AppContext + +getProjectTagSuggestions :: Maybe String -> [String] -> Pageable -> [Sort] -> AppContextM (Page String) +getProjectTagSuggestions mQuery excludeTags pageable sort = do + checkPermission _PRJ_PERM + findProjectTagsPage mQuery excludeTags pageable sort diff --git a/wizard-server/src/Wizard/Service/Project/User/ProjectUserService.hs b/wizard-server/src/Wizard/Service/Project/User/ProjectUserService.hs new file mode 100644 index 000000000..23c5a34eb --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/User/ProjectUserService.hs @@ -0,0 +1,29 @@ +module Wizard.Service.Project.User.ProjectUserService where + +import qualified Data.UUID as U + +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.Pageable +import Shared.Common.Model.Common.Sort +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectUserDAO +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Project +import Wizard.Service.Project.ProjectAcl +import Wizard.Service.User.UserMapper +import Wizard.Service.User.UserService +import WizardLib.Public.Model.User.UserSuggestion + +getProjectUserSuggestionsPage :: U.UUID -> Maybe String -> Maybe Bool -> Pageable -> [Sort] -> AppContextM (Page UserSuggestion) +getProjectUserSuggestionsPage projectUuid mQuery mEditor pageable sort = do + project <- findProjectByUuid projectUuid + checkCommentPermissionToProject project.visibility project.sharing project.permissions + if project.visibility == VisibleCommentProjectVisibility || project.visibility == VisibleEditProjectVisibility || project.sharing == AnyoneWithLinkCommentProjectSharing || project.sharing == AnyoneWithLinkEditProjectSharing + then getUserSuggestionsPage mQuery Nothing Nothing pageable sort + else do + let perm = + case mEditor of + Just True -> "EDIT" + _ -> "COMMENT" + suggestionPage <- findProjectUserSuggestionsPage projectUuid perm mQuery pageable sort + return . fmap toSuggestion $ suggestionPage diff --git a/wizard-server/src/Wizard/Service/Project/Version/ProjectVersionMapper.hs b/wizard-server/src/Wizard/Service/Project/Version/ProjectVersionMapper.hs new file mode 100644 index 000000000..3c4f78c94 --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/Version/ProjectVersionMapper.hs @@ -0,0 +1,68 @@ +module Wizard.Service.Project.Version.ProjectVersionMapper where + +import Data.Time +import qualified Data.UUID as U + +import Wizard.Api.Resource.Project.Version.ProjectVersionChangeDTO +import Wizard.Api.Resource.Project.Version.ProjectVersionRevertDTO +import Wizard.Api.Resource.User.UserDTO +import Wizard.Model.Project.Version.ProjectVersion +import Wizard.Model.Project.Version.ProjectVersionList +import qualified Wizard.Service.User.UserMapper as UM + +toVersionList :: ProjectVersion -> Maybe UserDTO -> ProjectVersionList +toVersionList version createdBy = + ProjectVersionList + { uuid = version.uuid + , name = version.name + , description = version.description + , eventUuid = version.eventUuid + , createdBy = fmap UM.toSuggestion' createdBy + , createdAt = version.createdAt + , updatedAt = version.updatedAt + } + +-- --------------------------------------------------------------------------------------------------------------------- +-- --------------------------------------------------------------------------------------------------------------------- +toVersionChangeDTO :: ProjectVersion -> ProjectVersionChangeDTO +toVersionChangeDTO version = + ProjectVersionChangeDTO + { name = version.name + , description = version.description + , eventUuid = version.eventUuid + } + +-- --------------------------------------------------------------------------------------------------------------------- +-- --------------------------------------------------------------------------------------------------------------------- +toVersionRevertDTO :: U.UUID -> ProjectVersionRevertDTO +toVersionRevertDTO eventUuid = ProjectVersionRevertDTO {eventUuid = eventUuid} + +-- --------------------------------------------------------------------------------------------------------------------- +-- --------------------------------------------------------------------------------------------------------------------- +fromVersionChangeDTO :: ProjectVersionChangeDTO -> U.UUID -> U.UUID -> U.UUID -> U.UUID -> UTCTime -> ProjectVersion +fromVersionChangeDTO reqDto uuid projectUuid tenantUuid createdBy now = + ProjectVersion + { uuid = uuid + , name = reqDto.name + , description = reqDto.description + , eventUuid = reqDto.eventUuid + , projectUuid = projectUuid + , tenantUuid = tenantUuid + , createdBy = Just createdBy + , createdAt = now + , updatedAt = now + } + +fromVersionChangeDTO' :: ProjectVersion -> ProjectVersionChangeDTO -> UTCTime -> ProjectVersion +fromVersionChangeDTO' version reqDto now = + ProjectVersion + { uuid = version.uuid + , name = reqDto.name + , description = reqDto.description + , eventUuid = reqDto.eventUuid + , projectUuid = version.projectUuid + , tenantUuid = version.tenantUuid + , createdBy = version.createdBy + , createdAt = version.createdAt + , updatedAt = now + } diff --git a/wizard-server/src/Wizard/Service/Project/Version/ProjectVersionService.hs b/wizard-server/src/Wizard/Service/Project/Version/ProjectVersionService.hs new file mode 100644 index 000000000..4981f845f --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/Version/ProjectVersionService.hs @@ -0,0 +1,141 @@ +module Wizard.Service.Project.Version.ProjectVersionService where + +import Control.Monad (void, when) +import Control.Monad.Except (catchError) +import Control.Monad.Reader (asks, liftIO) +import qualified Data.List as L +import qualified Data.Map.Strict as M +import qualified Data.Set as S +import Data.Time +import qualified Data.UUID as U + +import Shared.Common.Model.Common.Lens +import Shared.Common.Util.List +import Shared.Common.Util.Uuid +import Wizard.Api.Resource.Project.ProjectContentDTO +import Wizard.Api.Resource.Project.Version.ProjectVersionChangeDTO +import Wizard.Api.Resource.Project.Version.ProjectVersionRevertDTO +import Wizard.Api.Resource.User.UserDTO +import Wizard.Database.DAO.Common +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectEventDAO +import Wizard.Database.DAO.Project.ProjectFileDAO +import Wizard.Database.DAO.Project.ProjectVersionDAO +import Wizard.Model.Context.AppContext +import Wizard.Model.Context.AppContextHelpers +import Wizard.Model.Project.Event.ProjectEventList +import Wizard.Model.Project.Event.ProjectEventListLenses () +import Wizard.Model.Project.Project +import Wizard.Model.Project.Version.ProjectVersion +import Wizard.Model.Project.Version.ProjectVersionList +import Wizard.Service.Project.Collaboration.ProjectCollaborationService +import Wizard.Service.Project.Comment.ProjectCommentService +import Wizard.Service.Project.Compiler.ProjectCompilerService +import Wizard.Service.Project.ProjectAcl +import Wizard.Service.Project.ProjectMapper +import Wizard.Service.Project.Version.ProjectVersionMapper +import Wizard.Service.Project.Version.ProjectVersionValidation +import Wizard.Service.User.UserService + +getVersions :: U.UUID -> AppContextM [ProjectVersionList] +getVersions projectUuid = do + project <- findProjectByUuid projectUuid + checkViewPermissionToProject project.visibility project.sharing project.permissions + findProjectVersionListByProjectUuidAndCreatedAt projectUuid Nothing + +createVersion :: U.UUID -> ProjectVersionChangeDTO -> AppContextM ProjectVersionList +createVersion projectUuid reqDto = + runInTransaction $ do + project <- findProjectByUuid projectUuid + checkOwnerPermissionToProject project.visibility project.permissions + validateProjectVersionCreate projectUuid reqDto + uuid <- liftIO generateUuid + tenantUuid <- asks currentTenantUuid + currentUser <- getCurrentUser + now <- liftIO getCurrentTime + let version = fromVersionChangeDTO reqDto uuid projectUuid tenantUuid currentUser.uuid now + insertProjectVersion version + return $ toVersionList version (Just currentUser) + +cloneProjectVersions :: U.UUID -> U.UUID -> [(U.UUID, ProjectEventList)] -> AppContextM [(ProjectVersion, ProjectVersion)] +cloneProjectVersions oldProjectUuid newProjectUuid newProjectEventsWithOldEventUuid = do + runInTransaction $ do + oldVersions <- findProjectVersionsByProjectUuid oldProjectUuid + traverse + ( \oldVersion -> do + newVersionUuid <- liftIO generateUuid + let newEventUuid = + case L.find (\(oldEventUuid, newEvent) -> oldVersion.eventUuid == oldEventUuid) newProjectEventsWithOldEventUuid of + Just (_, newEvent) -> getUuid newEvent + Nothing -> oldVersion.eventUuid + let newVersion = oldVersion {uuid = newVersionUuid, projectUuid = newProjectUuid, eventUuid = newEventUuid} + insertProjectVersion newVersion + return (oldVersion, newVersion) + ) + oldVersions + +modifyVersion :: U.UUID -> U.UUID -> ProjectVersionChangeDTO -> AppContextM ProjectVersionList +modifyVersion projectUuid versionUuid reqDto = + runInTransaction $ do + project <- findProjectByUuid projectUuid + checkOwnerPermissionToProject project.visibility project.permissions + validateProjectVersionUpdate reqDto + now <- liftIO getCurrentTime + version <- findProjectVersionByUuid versionUuid + let updatedVersion = fromVersionChangeDTO' version reqDto now + updateProjectVersionByUuid updatedVersion + createdBy <- + case version.createdBy of + Just vCreatedBy -> do + user <- getUserById vCreatedBy + return . Just $ user + Nothing -> return Nothing + return $ toVersionList updatedVersion createdBy + +deleteVersion :: U.UUID -> U.UUID -> AppContextM () +deleteVersion projectUuid vUuid = + runInTransaction $ do + project <- findProjectByUuid projectUuid + checkOwnerPermissionToProject project.visibility project.permissions + _ <- findProjectVersionByUuid vUuid + void $ deleteProjectVersionByUuid vUuid + +revertToEvent :: U.UUID -> ProjectVersionRevertDTO -> Bool -> AppContextM ProjectContentDTO +revertToEvent projectUuid reqDto shouldSave = + runInTransaction $ do + project <- findProjectByUuid projectUuid + if shouldSave + then checkOwnerPermissionToProject project.visibility project.permissions + else checkViewPermissionToProject project.visibility project.sharing project.permissions + projectVersions <- findProjectVersionsByProjectUuid projectUuid + projectEvents <- findProjectEventListsByProjectUuid projectUuid + let updatedEvents = takeWhileInclusive (\e -> getUuid e /= reqDto.eventUuid) projectEvents + let eventsToDelete = dropWhileExclusive (\e -> getUuid e /= reqDto.eventUuid) projectEvents + let updatedEventUuids = S.fromList . fmap getUuid $ updatedEvents + let updatedVersions = filter (\v -> S.member v.eventUuid updatedEventUuids) projectVersions + when + shouldSave + ( do + let versionsToDelete = fmap (.uuid) . filter (\v -> not $ S.member v.eventUuid updatedEventUuids) $ projectVersions + deleteProjectVersionsByUuids versionsToDelete + deleteProjectEventsByUuids (fmap getUuid eventsToDelete) + event <- findProjectEventByUuid reqDto.eventUuid + deleteProjectFilesNewerThen projectUuid (getCreatedAt event) + void $ updateProjectUpdatedAtByUuid projectUuid + ) + let projectContent = compileProjectEvents updatedEvents + versionDto <- + traverse + ( \version -> do + createdBy <- + case version.createdBy of + Just vCreatedBy -> do + user <- getUserById vCreatedBy + return . Just $ user + Nothing -> return Nothing + return $ toVersionList version createdBy + ) + updatedVersions + when shouldSave (logOutOnlineUsersWhenProjectDramaticallyChanged projectUuid) + commentThreadsMap <- catchError (getProjectCommentsByProjectUuid projectUuid Nothing Nothing) (\_ -> return M.empty) + return $ toContentDTO projectContent commentThreadsMap updatedEvents versionDto diff --git a/wizard-server/src/Wizard/Service/Project/Version/ProjectVersionValidation.hs b/wizard-server/src/Wizard/Service/Project/Version/ProjectVersionValidation.hs new file mode 100644 index 000000000..409298022 --- /dev/null +++ b/wizard-server/src/Wizard/Service/Project/Version/ProjectVersionValidation.hs @@ -0,0 +1,34 @@ +module Wizard.Service.Project.Version.ProjectVersionValidation where + +import Control.Monad (when) +import Control.Monad.Except (throwError) +import Data.Maybe (isJust) +import qualified Data.UUID as U + +import Shared.Common.Model.Error.Error +import Wizard.Api.Resource.Project.Version.ProjectVersionChangeDTO +import Wizard.Database.DAO.Project.ProjectEventDAO +import Wizard.Database.DAO.Project.ProjectVersionDAO +import Wizard.Localization.Messages.Public +import Wizard.Model.Context.AppContext + +validateProjectVersionCreate :: U.UUID -> ProjectVersionChangeDTO -> AppContextM () +validateProjectVersionCreate projectUuid reqDto = do + validateProjectVersionEventExistence reqDto + validateProjectVersionUniqueness projectUuid reqDto + +validateProjectVersionUpdate :: ProjectVersionChangeDTO -> AppContextM () +validateProjectVersionUpdate = validateProjectVersionEventExistence + +validateProjectVersionUniqueness :: U.UUID -> ProjectVersionChangeDTO -> AppContextM () +validateProjectVersionUniqueness projectUuid reqDto = do + mProjectVersion <- findProjectVersionByEventUuid' projectUuid reqDto.eventUuid + when + (isJust mProjectVersion) + (throwError . UserError $ _ERROR_SERVICE_PROJECT_VERSION__VERSION_UNIQUENESS (U.toString $ reqDto.eventUuid)) + +validateProjectVersionEventExistence :: ProjectVersionChangeDTO -> AppContextM () +validateProjectVersionEventExistence reqDto = + findProjectEventByUuid' reqDto.eventUuid >>= \case + Just _ -> return () + Nothing -> throwError . UserError $ _ERROR_SERVICE_PROJECT_VERSION__NON_EXISTENT_EVENT_UUID (U.toString $ reqDto.eventUuid) diff --git a/wizard-server/src/Wizard/Service/Questionnaire/Collaboration/CollaborationAcl.hs b/wizard-server/src/Wizard/Service/Questionnaire/Collaboration/CollaborationAcl.hs deleted file mode 100644 index 112f6c33c..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/Collaboration/CollaborationAcl.hs +++ /dev/null @@ -1,75 +0,0 @@ -module Wizard.Service.Questionnaire.Collaboration.CollaborationAcl where - -import Control.Monad.Except (throwError) -import Data.Maybe (isJust) -import qualified Data.UUID as U -import Prelude hiding (log) - -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireAclHelpers -import Wizard.Model.Questionnaire.QuestionnairePerm -import Wizard.Model.User.User -import Wizard.Model.Websocket.WebsocketRecord - -getPermission - :: QuestionnaireVisibility - -> QuestionnaireSharing - -> [QuestionnairePerm] - -> Maybe U.UUID - -> Maybe String - -> [U.UUID] - -> WebsocketPerm -getPermission visibility sharing permissions mCurrentUserUuid mCurrentUserRole mCurrentUserGroupUuids - | or - [ isAdmin - , isLogged && isExplicitlyOwner - , isLogged && isExplicitlyEditor - , isLogged && isInOwnerGroup - , isLogged && isInEditorGroup - , isLogged && visibility == VisibleEditQuestionnaire - , sharing == AnyoneWithLinkEditQuestionnaire - ] = - EditorWebsocketPerm - | or - [ isLogged && isExplicitlyCommenter - , isLogged && isInCommenterGroup - , isLogged && visibility == VisibleCommentQuestionnaire - , sharing == AnyoneWithLinkCommentQuestionnaire - ] = - CommenterWebsocketPerm - | or - [ isLogged && isExplicitlyViewer - , isLogged && isInViewerGroup - , isLogged && visibility == VisibleViewQuestionnaire - , sharing == AnyoneWithLinkViewQuestionnaire - ] = - ViewerWebsocketPerm - | otherwise = NoWebsocketPerm - where - isExplicitlyOwner = maybe False (`elem` getUserUuidsForOwnerPerm permissions) mCurrentUserUuid - isExplicitlyEditor = maybe False (`elem` getUserUuidsForEditorPerm permissions) mCurrentUserUuid - isExplicitlyCommenter = maybe False (`elem` getUserUuidsForCommenterPerm permissions) mCurrentUserUuid - isExplicitlyViewer = maybe False (`elem` getUserUuidsForViewerPerm permissions) mCurrentUserUuid - isInOwnerGroup = or (fmap (`elem` getUserGroupUuidsForOwnerPerm permissions) mCurrentUserGroupUuids) - isInEditorGroup = or (fmap (`elem` getUserGroupUuidsForEditorPerm permissions) mCurrentUserGroupUuids) - isInCommenterGroup = or (fmap (`elem` getUserGroupUuidsForCommenterPerm permissions) mCurrentUserGroupUuids) - isInViewerGroup = or (fmap (`elem` getUserGroupUuidsForViewerPerm permissions) mCurrentUserGroupUuids) - isLogged = isJust mCurrentUserUuid - isAdmin = mCurrentUserRole == Just _USER_ROLE_ADMIN - -checkViewPermission myself = - if myself.entityPerm == EditorWebsocketPerm || myself.entityPerm == CommenterWebsocketPerm || myself.entityPerm == ViewerWebsocketPerm - then return () - else throwError . ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN "View Questionnaire" - -checkCommentPermission myself = - if myself.entityPerm == EditorWebsocketPerm || myself.entityPerm == CommenterWebsocketPerm - then return () - else throwError . ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN "Comment Questionnaire" - -checkEditPermission myself = - if myself.entityPerm == EditorWebsocketPerm - then return () - else throwError . ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN "Edit Questionnaire" diff --git a/wizard-server/src/Wizard/Service/Questionnaire/Collaboration/CollaborationMapper.hs b/wizard-server/src/Wizard/Service/Questionnaire/Collaboration/CollaborationMapper.hs deleted file mode 100644 index 5cb695d33..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/Collaboration/CollaborationMapper.hs +++ /dev/null @@ -1,124 +0,0 @@ -module Wizard.Service.Questionnaire.Collaboration.CollaborationMapper where - -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailWsDTO -import Wizard.Api.Resource.Websocket.QuestionnaireActionDTO -import Wizard.Api.Resource.Websocket.WebsocketActionDTO -import Wizard.Model.Questionnaire.QuestionnaireFileSimple -import Wizard.Model.Websocket.WebsocketMessage -import Wizard.Model.Websocket.WebsocketRecord -import Wizard.Util.Websocket - -toWebsocketMessage :: WebsocketRecord -> content -> WebsocketMessage content -toWebsocketMessage record content = - WebsocketMessage - { connectionUuid = record.connectionUuid - , connection = record.connection - , entityId = record.entityId - , content = content - } - -toSetUserListMessage - :: [WebsocketRecord] -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerQuestionnaireActionDTO) -toSetUserListMessage records record = - toWebsocketMessage record $ - Success_ServerActionDTO . SetUserList_ServerQuestionnaireActionDTO $ - getCollaborators record.connectionUuid record.entityId records - -toSetReplyMessage - :: SetReplyEventDTO -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerQuestionnaireActionDTO) -toSetReplyMessage reqDto record = - toWebsocketMessage record $ - Success_ServerActionDTO . SetContent_ServerQuestionnaireActionDTO . SetReplyEventDTO' $ - reqDto - -toClearReplyMessage - :: ClearReplyEventDTO -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerQuestionnaireActionDTO) -toClearReplyMessage reqDto record = - toWebsocketMessage record $ - Success_ServerActionDTO . SetContent_ServerQuestionnaireActionDTO . ClearReplyEventDTO' $ - reqDto - -toSetPhaseMessage - :: SetPhaseEventDTO -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerQuestionnaireActionDTO) -toSetPhaseMessage reqDto record = - toWebsocketMessage record $ - Success_ServerActionDTO . SetContent_ServerQuestionnaireActionDTO . SetPhaseEventDTO' $ - reqDto - -toSetLabelMessage - :: SetLabelsEventDTO -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerQuestionnaireActionDTO) -toSetLabelMessage reqDto record = - toWebsocketMessage record $ - Success_ServerActionDTO . SetContent_ServerQuestionnaireActionDTO . SetLabelsEventDTO' $ - reqDto - -toResolveCommentThreadMessage - :: ResolveCommentThreadEventDTO - -> WebsocketRecord - -> WebsocketMessage (Success_ServerActionDTO ServerQuestionnaireActionDTO) -toResolveCommentThreadMessage reqDto record = - toWebsocketMessage record $ - Success_ServerActionDTO . SetContent_ServerQuestionnaireActionDTO . ResolveCommentThreadEventDTO' $ - reqDto - -toReopenCommentThreadMessage - :: ReopenCommentThreadEventDTO - -> WebsocketRecord - -> WebsocketMessage (Success_ServerActionDTO ServerQuestionnaireActionDTO) -toReopenCommentThreadMessage reqDto record = - toWebsocketMessage record $ - Success_ServerActionDTO . SetContent_ServerQuestionnaireActionDTO . ReopenCommentThreadEventDTO' $ - reqDto - -toAssignCommentThreadMessage - :: AssignCommentThreadEventDTO - -> WebsocketRecord - -> WebsocketMessage (Success_ServerActionDTO ServerQuestionnaireActionDTO) -toAssignCommentThreadMessage reqDto record = - toWebsocketMessage record $ - Success_ServerActionDTO . SetContent_ServerQuestionnaireActionDTO . AssignCommentThreadEventDTO' $ - reqDto - -toDeleteCommentThreadMessage - :: DeleteCommentThreadEventDTO - -> WebsocketRecord - -> WebsocketMessage (Success_ServerActionDTO ServerQuestionnaireActionDTO) -toDeleteCommentThreadMessage reqDto record = - toWebsocketMessage record $ - Success_ServerActionDTO . SetContent_ServerQuestionnaireActionDTO . DeleteCommentThreadEventDTO' $ - reqDto - -toAddCommentMessage - :: AddCommentEventDTO -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerQuestionnaireActionDTO) -toAddCommentMessage reqDto record = - toWebsocketMessage record $ - Success_ServerActionDTO . SetContent_ServerQuestionnaireActionDTO . AddCommentEventDTO' $ - reqDto - -toEditCommentMessage - :: EditCommentEventDTO -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerQuestionnaireActionDTO) -toEditCommentMessage reqDto record = - toWebsocketMessage record $ - Success_ServerActionDTO . SetContent_ServerQuestionnaireActionDTO . EditCommentEventDTO' $ - reqDto - -toDeleteCommentMessage - :: DeleteCommentEventDTO -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerQuestionnaireActionDTO) -toDeleteCommentMessage reqDto record = - toWebsocketMessage record $ - Success_ServerActionDTO . SetContent_ServerQuestionnaireActionDTO . DeleteCommentEventDTO' $ - reqDto - -toSetQuestionnaireMessage - :: QuestionnaireDetailWsDTO -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerQuestionnaireActionDTO) -toSetQuestionnaireMessage resWsDto record = - toWebsocketMessage record $ - Success_ServerActionDTO . SetQuestionnaire_ServerQuestionnaireActionDTO $ - resWsDto - -toAddFileMessage :: QuestionnaireFileSimple -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerQuestionnaireActionDTO) -toAddFileMessage file record = - toWebsocketMessage record $ - Success_ServerActionDTO . AddFile_ServerQuestionnaireActionDTO $ - file diff --git a/wizard-server/src/Wizard/Service/Questionnaire/Collaboration/CollaborationService.hs b/wizard-server/src/Wizard/Service/Questionnaire/Collaboration/CollaborationService.hs deleted file mode 100644 index 4c8196b4a..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/Collaboration/CollaborationService.hs +++ /dev/null @@ -1,436 +0,0 @@ -module Wizard.Service.Questionnaire.Collaboration.CollaborationService where - -import Control.Monad (when) -import Control.Monad.Except (catchError) -import Control.Monad.Reader (asks, liftIO) -import qualified Data.Aeson as A -import qualified Data.Aeson.KeyMap as AKM -import qualified Data.ByteString.Lazy.Char8 as BSL -import Data.Foldable (traverse_) -import Data.Maybe (isJust) -import Data.Time -import qualified Data.UUID as U -import Network.WebSockets (Connection) - -import Shared.Common.Integration.Aws.Lambda -import Shared.Common.Model.Error.Error -import Shared.Common.Util.Uuid -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventChangeDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailWsDTO -import Wizard.Api.Resource.User.UserDTO -import Wizard.Api.Resource.Websocket.QuestionnaireActionJM () -import Wizard.Api.Resource.Websocket.WebsocketActionJM () -import Wizard.Cache.QuestionnaireWebsocketCache -import Wizard.Database.DAO.Questionnaire.QuestionnaireCommentDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireCommentThreadDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireEventDAO -import Wizard.Database.DAO.Tenant.TenantDAO -import Wizard.Localization.Messages.Public -import Wizard.Model.Config.ServerConfig -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireFileSimple -import Wizard.Model.Questionnaire.QuestionnairePerm -import Wizard.Model.Tenant.Tenant -import Wizard.Model.User.OnlineUserInfo -import Wizard.Model.Websocket.WebsocketMessage -import Wizard.Model.Websocket.WebsocketRecord -import Wizard.Service.Questionnaire.Collaboration.CollaborationAcl -import Wizard.Service.Questionnaire.Collaboration.CollaborationMapper -import Wizard.Service.Questionnaire.Comment.QuestionnaireCommentMapper -import Wizard.Service.Questionnaire.Event.QuestionnaireEventMapper -import Wizard.Service.Websocket.WebsocketService -import Wizard.Util.Websocket -import WizardLib.Public.Database.DAO.User.UserGroupMembershipDAO -import WizardLib.Public.Model.User.UserGroupMembership -import WizardLib.Public.Model.User.UserSuggestion - -putUserOnline :: U.UUID -> U.UUID -> Connection -> AppContextM () -putUserOnline qtnUuid connectionUuid connection = do - myself <- createQuestionnaireRecord connectionUuid connection qtnUuid - checkViewPermission myself - addToCache myself - logWS connectionUuid "New user added to the list" - setUserList qtnUuid connectionUuid - -deleteUser :: U.UUID -> U.UUID -> AppContextM () -deleteUser qtnUuid connectionUuid = do - deleteFromCache connectionUuid - setUserList qtnUuid connectionUuid - -setUserList :: U.UUID -> U.UUID -> AppContextM () -setUserList qtnUuid connectionUuid = do - logWS connectionUuid "Informing other users about user list changes" - records <- getAllFromCache - broadcast (U.toString qtnUuid) records (toSetUserListMessage records) disconnectUser - logWS connectionUuid "Informed completed" - -updatePermsForOnlineUsers :: U.UUID -> QuestionnaireVisibility -> QuestionnaireSharing -> [QuestionnairePerm] -> AppContextM () -updatePermsForOnlineUsers qtnUuid visibility sharing permissions = do - currentTenantUuid <- asks currentTenantUuid - tenant <- findTenantByUuid currentTenantUuid - if isJust tenant.signalBridgeUrl - then do - serverConfig <- asks serverConfig - let dto = AKM.fromList [("questionnaireUuid", U.toString qtnUuid), ("tenantUuid", U.toString currentTenantUuid)] - invokeLambda serverConfig.signalBridge.updatePermsArn (BSL.toStrict . A.encode $ dto) - return () - else do - records <- getAllFromCache - traverse_ updatePerm records - where - updatePerm :: WebsocketRecord -> AppContextM () - updatePerm record = - when - (record.entityId == U.toString qtnUuid) - ( do - let permission = - case record.user of - user@LoggedOnlineUserInfo {uuid = uuid, role = role, groupUuids = groupUuids} -> - getPermission visibility sharing permissions (Just uuid) (Just role) groupUuids - user@AnonymousOnlineUserInfo {..} -> - getPermission visibility sharing permissions Nothing Nothing [] - let updatedRecord = record {entityPerm = permission} - updateCache updatedRecord - disconnectUserIfLostPermission updatedRecord - ) - -removeUserGroupFromUsers :: U.UUID -> [U.UUID] -> AppContextM () -removeUserGroupFromUsers userGroupUuid userUuids = do - currentTenantUuid <- asks currentTenantUuid - tenant <- findTenantByUuid currentTenantUuid - if isJust tenant.signalBridgeUrl - then do - serverConfig <- asks serverConfig - let dto = AKM.fromList [("userGroupUuid", U.toString userGroupUuid), ("tenantUuid", U.toString currentTenantUuid)] - invokeLambda serverConfig.signalBridge.updateUserGroupArn (BSL.toStrict . A.encode $ dto) - return () - else do - records <- getAllFromCache - traverse_ updatePerm records - where - updatePerm :: WebsocketRecord -> AppContextM () - updatePerm record = - case record.user of - user@LoggedOnlineUserInfo {uuid = uuid, role = role, groupUuids = groupUuids} -> do - when - (user.uuid `elem` userUuids) - ( do - let updatedRecord = record {user = user {groupUuids = filter (/= userGroupUuid) user.groupUuids}} - updateCache updatedRecord - ) - user@AnonymousOnlineUserInfo {..} -> return () - -setQuestionnaire :: U.UUID -> QuestionnaireDetailWsDTO -> AppContextM () -setQuestionnaire qtnUuid reqDto = do - currentTenantUuid <- asks currentTenantUuid - tenant <- findTenantByUuid currentTenantUuid - if isJust tenant.signalBridgeUrl - then do - serverConfig <- asks serverConfig - let dto = - AKM.fromList - [ ("questionnaireUuid", A.String . U.toText $ qtnUuid) - , ("tenantUuid", A.String . U.toText $ currentTenantUuid) - , ("message", A.toJSON reqDto) - ] - invokeLambda serverConfig.signalBridge.setQuestionnaireArn (BSL.toStrict . A.encode $ dto) - return () - else do - logWS U.nil "Informing other users about changed questionnaire" - records <- getAllFromCache - broadcast (U.toString qtnUuid) records (toSetQuestionnaireMessage reqDto) disconnectUser - logWS U.nil "Informed completed" - -addFile :: U.UUID -> QuestionnaireFileSimple -> AppContextM () -addFile qtnUuid reqDto = do - currentTenantUuid <- asks currentTenantUuid - tenant <- findTenantByUuid currentTenantUuid - if isJust tenant.signalBridgeUrl - then do - serverConfig <- asks serverConfig - let dto = - AKM.fromList - [ ("questionnaireUuid", A.String . U.toText $ qtnUuid) - , ("tenantUuid", A.String . U.toText $ currentTenantUuid) - , ("message", A.toJSON reqDto) - ] - invokeLambda serverConfig.signalBridge.addFileArn (BSL.toStrict . A.encode $ dto) - return () - else do - logWS U.nil "Informing other users about added file" - records <- getAllFromCache - broadcast (U.toString qtnUuid) records (toAddFileMessage reqDto) disconnectUser - logWS U.nil "Informed completed" - -logOutOnlineUsersWhenQtnDramaticallyChanged :: U.UUID -> AppContextM () -logOutOnlineUsersWhenQtnDramaticallyChanged qtnUuid = do - currentTenantUuid <- asks currentTenantUuid - tenant <- findTenantByUuid currentTenantUuid - if isJust tenant.signalBridgeUrl - then do - serverConfig <- asks serverConfig - let dto = AKM.fromList [("questionnaireUuid", U.toString qtnUuid), ("tenantUuid", U.toString currentTenantUuid)] - invokeLambda serverConfig.signalBridge.logOutAllArn (BSL.toStrict . A.encode $ dto) - return () - else do - records <- getAllFromCache - let error = NotExistsError $ _ERROR_SERVICE_QTN_COLLABORATION__FORCE_DISCONNECT (U.toString qtnUuid) - traverse_ (logOut error) records - where - logOut :: AppError -> WebsocketRecord -> AppContextM () - logOut error record = - when - (record.entityId == U.toString qtnUuid) - (sendError record.connectionUuid record.connection record.entityId disconnectUser error) - --- -------------------------------- -setContent :: U.UUID -> U.UUID -> QuestionnaireEventChangeDTO -> AppContextM () -setContent qtnUuid connectionUuid reqDto = - case reqDto of - SetReplyEventChangeDTO' event -> setReply qtnUuid connectionUuid event - ClearReplyEventChangeDTO' event -> clearReply qtnUuid connectionUuid event - SetPhaseEventChangeDTO' event -> setPhase qtnUuid connectionUuid event - SetLabelsEventChangeDTO' event -> setLabel qtnUuid connectionUuid event - ResolveCommentThreadEventChangeDTO' event -> resolveCommentThread qtnUuid connectionUuid event - ReopenCommentThreadEventChangeDTO' event -> reopenCommentThread qtnUuid connectionUuid event - AssignCommentThreadEventChangeDTO' event -> assignCommentThread qtnUuid connectionUuid event - DeleteCommentThreadEventChangeDTO' event -> deleteCommentThread qtnUuid connectionUuid event - AddCommentEventChangeDTO' event -> addComment qtnUuid connectionUuid event - EditCommentEventChangeDTO' event -> editComment qtnUuid connectionUuid event - DeleteCommentEventChangeDTO' event -> deleteComment qtnUuid connectionUuid event - -setReply :: U.UUID -> U.UUID -> SetReplyEventChangeDTO -> AppContextM () -setReply qtnUuid connectionUuid reqDto = do - myself <- getFromCache' connectionUuid - checkEditPermission myself - now <- liftIO getCurrentTime - tenantUuid <- asks currentTenantUuid - let mCreatedBy = getMaybeCreatedBy myself - let mCreatedByUuid = getMaybeCreatedByUuid myself - insertQuestionnaireEventWithTimestampUpdate - qtnUuid - (fromEventChangeDTO (SetReplyEventChangeDTO' reqDto) qtnUuid tenantUuid mCreatedByUuid now) - let resDto = toSetReplyEventDTO' reqDto mCreatedBy now - records <- getAllFromCache - broadcast (U.toString qtnUuid) records (toSetReplyMessage resDto) disconnectUser - -clearReply :: U.UUID -> U.UUID -> ClearReplyEventChangeDTO -> AppContextM () -clearReply qtnUuid connectionUuid reqDto = do - myself <- getFromCache' connectionUuid - checkEditPermission myself - now <- liftIO getCurrentTime - tenantUuid <- asks currentTenantUuid - let mCreatedBy = getMaybeCreatedBy myself - let mCreatedByUuid = getMaybeCreatedByUuid myself - insertQuestionnaireEventWithTimestampUpdate - qtnUuid - (fromEventChangeDTO (ClearReplyEventChangeDTO' reqDto) qtnUuid tenantUuid mCreatedByUuid now) - let resDto = toClearReplyEventDTO' reqDto mCreatedBy now - records <- getAllFromCache - broadcast (U.toString qtnUuid) records (toClearReplyMessage resDto) disconnectUser - -setPhase :: U.UUID -> U.UUID -> SetPhaseEventChangeDTO -> AppContextM () -setPhase qtnUuid connectionUuid reqDto = do - myself <- getFromCache' connectionUuid - checkEditPermission myself - now <- liftIO getCurrentTime - tenantUuid <- asks currentTenantUuid - let mCreatedBy = getMaybeCreatedBy myself - let mCreatedByUuid = getMaybeCreatedByUuid myself - insertQuestionnaireEventWithTimestampUpdate - qtnUuid - (fromEventChangeDTO (SetPhaseEventChangeDTO' reqDto) qtnUuid tenantUuid mCreatedByUuid now) - let resDto = toSetPhaseEventDTO' reqDto mCreatedBy now - records <- getAllFromCache - broadcast (U.toString qtnUuid) records (toSetPhaseMessage resDto) disconnectUser - -setLabel :: U.UUID -> U.UUID -> SetLabelsEventChangeDTO -> AppContextM () -setLabel qtnUuid connectionUuid reqDto = do - myself <- getFromCache' connectionUuid - checkEditPermission myself - now <- liftIO getCurrentTime - tenantUuid <- asks currentTenantUuid - let mCreatedBy = getMaybeCreatedBy myself - let mCreatedByUuid = getMaybeCreatedByUuid myself - insertQuestionnaireEventWithTimestampUpdate qtnUuid (fromEventChangeDTO (SetLabelsEventChangeDTO' reqDto) qtnUuid tenantUuid mCreatedByUuid now) - let resDto = toSetLabelsEventDTO' reqDto mCreatedBy now - records <- getAllFromCache - broadcast (U.toString qtnUuid) records (toSetLabelMessage resDto) disconnectUser - -resolveCommentThread :: U.UUID -> U.UUID -> ResolveCommentThreadEventChangeDTO -> AppContextM () -resolveCommentThread qtnUuid connectionUuid reqDto = do - myself <- getFromCache' connectionUuid - checkCommentPermission myself - now <- liftIO getCurrentTime - let mCreatedBy = getMaybeCreatedBy myself - let mCreatedByUuid = getMaybeCreatedByUuid myself - updateQuestionnaireCommentThreadResolvedById reqDto.threadUuid True - let resDto = toResolveCommentThreadEventDTO' reqDto mCreatedBy now - records <- getAllFromCache - let filteredRecords = - if reqDto.private - then filterEditors records - else filterCommenters records - broadcast (U.toString qtnUuid) filteredRecords (toResolveCommentThreadMessage resDto) disconnectUser - -reopenCommentThread :: U.UUID -> U.UUID -> ReopenCommentThreadEventChangeDTO -> AppContextM () -reopenCommentThread qtnUuid connectionUuid reqDto = do - myself <- getFromCache' connectionUuid - checkCommentPermission myself - now <- liftIO getCurrentTime - let mCreatedBy = getMaybeCreatedBy myself - let mCreatedByUuid = getMaybeCreatedByUuid myself - updateQuestionnaireCommentThreadResolvedById reqDto.threadUuid False - let resDto = toReopenCommentThreadEventDTO' reqDto mCreatedBy now - records <- getAllFromCache - let filteredRecords = - if reqDto.private - then filterEditors records - else filterCommenters records - broadcast (U.toString qtnUuid) filteredRecords (toReopenCommentThreadMessage resDto) disconnectUser - -assignCommentThread :: U.UUID -> U.UUID -> AssignCommentThreadEventChangeDTO -> AppContextM () -assignCommentThread qtnUuid connectionUuid reqDto = do - myself <- getFromCache' connectionUuid - checkCommentPermission myself - now <- liftIO getCurrentTime - let mCreatedBy = getMaybeCreatedBy myself - let mCreatedByUuid = getMaybeCreatedByUuid myself - updateQuestionnaireCommentThreadAssignee reqDto.threadUuid (fmap (.uuid) reqDto.assignedTo) mCreatedByUuid - let resDto = toAssignCommentThreadEventDTO' reqDto mCreatedBy now - records <- getAllFromCache - let filteredRecords = - if reqDto.private - then filterEditors records - else filterCommenters records - broadcast (U.toString qtnUuid) filteredRecords (toAssignCommentThreadMessage resDto) disconnectUser - -deleteCommentThread :: U.UUID -> U.UUID -> DeleteCommentThreadEventChangeDTO -> AppContextM () -deleteCommentThread qtnUuid connectionUuid reqDto = do - myself <- getFromCache' connectionUuid - checkCommentPermission myself - now <- liftIO getCurrentTime - let mCreatedBy = getMaybeCreatedBy myself - let mCreatedByUuid = getMaybeCreatedByUuid myself - deleteQuestionnaireCommentsByThreadUuid reqDto.threadUuid - deleteQuestionnaireCommentThreadById reqDto.threadUuid - let resDto = toDeleteCommentThreadEventDTO' reqDto mCreatedBy now - records <- getAllFromCache - let filteredRecords = - if reqDto.private - then filterEditors records - else filterCommenters records - broadcast (U.toString qtnUuid) filteredRecords (toDeleteCommentThreadMessage resDto) disconnectUser - -addComment :: U.UUID -> U.UUID -> AddCommentEventChangeDTO -> AppContextM () -addComment qtnUuid connectionUuid reqDto = do - myself <- getFromCache' connectionUuid - checkCommentPermission myself - tenantUuid <- asks currentTenantUuid - now <- liftIO getCurrentTime - let mCreatedBy = getMaybeCreatedBy myself - let mCreatedByUuid = getMaybeCreatedByUuid myself - let comment = toComment reqDto tenantUuid mCreatedByUuid now - if reqDto.newThread - then do - let thread = toCommentThread reqDto qtnUuid tenantUuid mCreatedByUuid now - insertQuestionnaireThreadAndComment thread comment - else insertQuestionnaireComment comment - let resDto = toAddCommentEventDTO' reqDto mCreatedBy now - records <- getAllFromCache - let filteredRecords = - if reqDto.private - then filterEditors records - else filterCommenters records - broadcast (U.toString qtnUuid) filteredRecords (toAddCommentMessage resDto) disconnectUser - -editComment :: U.UUID -> U.UUID -> EditCommentEventChangeDTO -> AppContextM () -editComment qtnUuid connectionUuid reqDto = do - myself <- getFromCache' connectionUuid - checkCommentPermission myself - now <- liftIO getCurrentTime - let mCreatedBy = getMaybeCreatedBy myself - let mCreatedByUuid = getMaybeCreatedByUuid myself - updateQuestionnaireCommentTextById reqDto.commentUuid reqDto.text - let resDto = toEditCommentEventDTO' reqDto mCreatedBy now - records <- getAllFromCache - let filteredRecords = - if reqDto.private - then filterEditors records - else filterCommenters records - broadcast (U.toString qtnUuid) filteredRecords (toEditCommentMessage resDto) disconnectUser - -deleteComment :: U.UUID -> U.UUID -> DeleteCommentEventChangeDTO -> AppContextM () -deleteComment qtnUuid connectionUuid reqDto = do - myself <- getFromCache' connectionUuid - checkCommentPermission myself - now <- liftIO getCurrentTime - let mCreatedBy = getMaybeCreatedBy myself - let mCreatedByUuid = getMaybeCreatedByUuid myself - deleteQuestionnaireCommentById reqDto.commentUuid - let resDto = toDeleteCommentEventDTO' reqDto mCreatedBy now - records <- getAllFromCache - let filteredRecords = - if reqDto.private - then filterEditors records - else filterCommenters records - broadcast (U.toString qtnUuid) filteredRecords (toDeleteCommentMessage resDto) disconnectUser - --- -------------------------------- --- PRIVATE --- -------------------------------- -disconnectUser :: A.ToJSON resDto => WebsocketMessage resDto -> AppContextM () -disconnectUser msg = deleteUser (u' msg.entityId) msg.connectionUuid - -disconnectUserIfLostPermission :: WebsocketRecord -> AppContextM () -disconnectUserIfLostPermission record = catchError (checkViewPermission record) handleError - where - handleError = sendError record.connectionUuid record.connection record.entityId disconnectUser - -createQuestionnaireRecord :: U.UUID -> Connection -> U.UUID -> AppContextM WebsocketRecord -createQuestionnaireRecord connectionUuid connection qtnUuid = do - mCurrentUser <- asks currentUser - qtn <- findQuestionnaireByUuid qtnUuid - userGroupUuids <- - case mCurrentUser of - Just currentUser -> do - userGroupMemberships <- findUserGroupMembershipsByUserUuid currentUser.uuid - return . fmap (.userGroupUuid) $ userGroupMemberships - Nothing -> return [] - let permission = - getPermission - qtn.visibility - qtn.sharing - qtn.permissions - (fmap (.uuid) mCurrentUser) - (fmap (.uRole) mCurrentUser) - userGroupUuids - createRecord connectionUuid connection (U.toString qtnUuid) permission userGroupUuids - -getMaybeCreatedBy :: WebsocketRecord -> Maybe UserSuggestion -getMaybeCreatedBy myself = - case myself.user of - u@LoggedOnlineUserInfo - { uuid = uuid - , firstName = firstName - , lastName = lastName - , gravatarHash = gravatarHash - , imageUrl = imageUrl - } -> - Just $ - UserSuggestion - { uuid = uuid - , firstName = firstName - , lastName = lastName - , gravatarHash = gravatarHash - , imageUrl = imageUrl - } - u@AnonymousOnlineUserInfo {..} -> Nothing - -getMaybeCreatedByUuid :: WebsocketRecord -> Maybe U.UUID -getMaybeCreatedByUuid myself = - case myself.user of - u@LoggedOnlineUserInfo {uuid = uuid} -> Just uuid - u@AnonymousOnlineUserInfo {..} -> Nothing diff --git a/wizard-server/src/Wizard/Service/Questionnaire/Comment/QuestionnaireCommentMapper.hs b/wizard-server/src/Wizard/Service/Questionnaire/Comment/QuestionnaireCommentMapper.hs deleted file mode 100644 index cbe9b8082..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/Comment/QuestionnaireCommentMapper.hs +++ /dev/null @@ -1,80 +0,0 @@ -module Wizard.Service.Questionnaire.Comment.QuestionnaireCommentMapper where - -import qualified Data.Map.Strict as M -import Data.Time -import qualified Data.UUID as U - -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventChangeDTO -import Wizard.Model.Questionnaire.QuestionnaireComment -import Wizard.Model.Questionnaire.QuestionnaireCommentList -import Wizard.Model.User.User -import qualified Wizard.Service.User.UserMapper as UM - -toCommentThreadsMap :: [QuestionnaireCommentThreadList] -> M.Map String [QuestionnaireCommentThreadList] -toCommentThreadsMap = foldl go M.empty - where - go - :: M.Map String [QuestionnaireCommentThreadList] - -> QuestionnaireCommentThreadList - -> M.Map String [QuestionnaireCommentThreadList] - go commentThreadsMap thread = - let threads = - case M.lookup thread.path commentThreadsMap of - Nothing -> [] - Just [] -> [] - Just threads -> threads - in M.insert thread.path (thread : threads) commentThreadsMap - -toCommentThreadList :: QuestionnaireCommentThread -> Maybe User -> Maybe User -> [QuestionnaireCommentList] -> QuestionnaireCommentThreadList -toCommentThreadList thread mAssignedTo mCreatedBy comments = - QuestionnaireCommentThreadList - { uuid = thread.uuid - , path = thread.path - , resolved = thread.resolved - , comments = comments - , private = thread.private - , assignedTo = fmap (UM.toSuggestion . UM.toSimple) mAssignedTo - , createdBy = fmap (UM.toSuggestion . UM.toSimple) mCreatedBy - , createdAt = thread.createdAt - , updatedAt = thread.updatedAt - } - -toCommentThread :: AddCommentEventChangeDTO -> U.UUID -> U.UUID -> Maybe U.UUID -> UTCTime -> QuestionnaireCommentThread -toCommentThread event qtnUuid tenantUuid mCreatedByUuid now = - QuestionnaireCommentThread - { uuid = event.threadUuid - , path = event.path - , resolved = False - , comments = [] - , private = event.private - , questionnaireUuid = qtnUuid - , tenantUuid = tenantUuid - , assignedTo = Nothing - , assignedBy = Nothing - , notificationRequired = False - , createdBy = mCreatedByUuid - , createdAt = now - , updatedAt = now - } - -toCommentList :: QuestionnaireComment -> Maybe User -> QuestionnaireCommentList -toCommentList comment mUser = - QuestionnaireCommentList - { uuid = comment.uuid - , text = comment.text - , createdBy = fmap (UM.toSuggestion . UM.toSimple) mUser - , createdAt = comment.createdAt - , updatedAt = comment.updatedAt - } - -toComment :: AddCommentEventChangeDTO -> U.UUID -> Maybe U.UUID -> UTCTime -> QuestionnaireComment -toComment event tenantUuid mCreatedByUuid now = - QuestionnaireComment - { uuid = event.commentUuid - , text = event.text - , threadUuid = event.threadUuid - , tenantUuid = tenantUuid - , createdBy = mCreatedByUuid - , createdAt = now - , updatedAt = now - } diff --git a/wizard-server/src/Wizard/Service/Questionnaire/Comment/QuestionnaireCommentService.hs b/wizard-server/src/Wizard/Service/Questionnaire/Comment/QuestionnaireCommentService.hs deleted file mode 100644 index 26ea6a750..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/Comment/QuestionnaireCommentService.hs +++ /dev/null @@ -1,77 +0,0 @@ -module Wizard.Service.Questionnaire.Comment.QuestionnaireCommentService where - -import Control.Monad.Except (catchError) -import Control.Monad.Reader (liftIO) -import Data.Foldable (traverse_) -import qualified Data.Map.Strict as M -import qualified Data.UUID as U - -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.List -import Shared.Common.Util.Uuid -import Wizard.Constant.Acl -import Wizard.Database.DAO.Common -import Wizard.Database.DAO.Questionnaire.QuestionnaireCommentDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireCommentThreadDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireComment -import Wizard.Model.Questionnaire.QuestionnaireCommentList -import Wizard.Model.Questionnaire.QuestionnaireCommentThreadAssigned -import Wizard.Model.Questionnaire.QuestionnaireCommentThreadNotification -import Wizard.Service.Mail.Mailer -import Wizard.Service.Questionnaire.Comment.QuestionnaireCommentMapper -import Wizard.Service.Questionnaire.QuestionnaireAcl -import WizardLib.Public.Model.User.UserSimple - -getQuestionnaireCommentThreadsPage :: Maybe String -> Maybe U.UUID -> Maybe Bool -> Pageable -> [Sort] -> AppContextM (Page QuestionnaireCommentThreadAssigned) -getQuestionnaireCommentThreadsPage mQuery mQuestionnaireUuid resolved pageable sort = do - checkPermission _QTN_PERM - findAssignedQuestionnaireCommentThreadsPage mQuery mQuestionnaireUuid resolved pageable sort - -getQuestionnaireCommentsByQuestionnaireUuid :: U.UUID -> Maybe String -> Maybe Bool -> AppContextM (M.Map String [QuestionnaireCommentThreadList]) -getQuestionnaireCommentsByQuestionnaireUuid qtnUuid mPath mResolved = do - qtn <- findQuestionnaireByUuid qtnUuid - checkCommentPermissionToQtn qtn.visibility qtn.sharing qtn.permissions - editor <- catchError (hasEditPermissionToQtn qtn.visibility qtn.sharing qtn.permissions) (\_ -> return False) - threads <- findQuestionnaireCommentThreadsForQuestionnaire qtn.uuid mPath mResolved editor - return . toCommentThreadsMap $ threads - -duplicateCommentThreads :: U.UUID -> U.UUID -> AppContextM () -duplicateCommentThreads oldQtnUuid newQtnUuid = do - threads <- findQuestionnaireCommentThreads oldQtnUuid - traverse_ (duplicateCommentThread newQtnUuid) threads - -duplicateCommentThread :: U.UUID -> QuestionnaireCommentThread -> AppContextM () -duplicateCommentThread newQtnUuid thread = do - newUuid <- liftIO generateUuid - let updatedCommentThread = - thread - { uuid = newUuid - , questionnaireUuid = newQtnUuid - } - insertQuestionnaireCommentThread updatedCommentThread - traverse_ (duplicateComment newUuid) thread.comments - -duplicateComment :: U.UUID -> QuestionnaireComment -> AppContextM () -duplicateComment newThreadUuid comment = do - newUuid <- liftIO generateUuid - let updatedComment = - comment - { uuid = newUuid - , threadUuid = newThreadUuid - } - insertQuestionnaireComment updatedComment - return () - -sendNotificationToNewAssignees :: AppContextM () -sendNotificationToNewAssignees = - runInTransaction $ do - threads <- findQuestionnaireCommentThreadsForNotifying - let threadGroups = groupBy (\t1 t2 -> t1.assignedTo.uuid == t2.assignedTo.uuid && t1.tenantUuid == t2.tenantUuid) threads - traverse_ sendQuestionnaireCommentThreadAssignedMail threadGroups - unsetQuestionnaireCommentThreadNotificationRequired diff --git a/wizard-server/src/Wizard/Service/Questionnaire/Compiler/CompilerService.hs b/wizard-server/src/Wizard/Service/Questionnaire/Compiler/CompilerService.hs deleted file mode 100644 index e08f5fdaf..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/Compiler/CompilerService.hs +++ /dev/null @@ -1,22 +0,0 @@ -module Wizard.Service.Questionnaire.Compiler.CompilerService where - -import qualified Data.Map.Strict as M - -import Wizard.Model.Questionnaire.QuestionnaireContent -import Wizard.Model.Questionnaire.QuestionnaireContentDM -import Wizard.Model.Questionnaire.QuestionnaireEventList -import Wizard.Service.Questionnaire.Event.QuestionnaireEventMapper - -compileQuestionnaire :: [QuestionnaireEventList] -> QuestionnaireContent -compileQuestionnaire = foldl applyEvent defaultQuestionnaireContent - -applyEvent :: QuestionnaireContent -> QuestionnaireEventList -> QuestionnaireContent -applyEvent qtnCtn (SetReplyEventList' event) = qtnCtn {replies = M.insert event.path (toReply' event) qtnCtn.replies} -applyEvent qtnCtn (ClearReplyEventList' event) = qtnCtn {replies = M.delete event.path qtnCtn.replies} -applyEvent qtnCtn (SetPhaseEventList' event) = qtnCtn {phaseUuid = event.phaseUuid} -applyEvent qtnCtn (SetLabelsEventList' event) = - qtnCtn - { labels = case event.value of - [] -> M.delete event.path qtnCtn.labels - newValue -> M.insert event.path newValue qtnCtn.labels - } diff --git a/wizard-server/src/Wizard/Service/Questionnaire/Event/QuestionnaireEventMapper.hs b/wizard-server/src/Wizard/Service/Questionnaire/Event/QuestionnaireEventMapper.hs deleted file mode 100644 index 3325a7266..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/Event/QuestionnaireEventMapper.hs +++ /dev/null @@ -1,400 +0,0 @@ -module Wizard.Service.Questionnaire.Event.QuestionnaireEventMapper where - -import Data.Time -import qualified Data.UUID as U - -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventChangeDTO -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventDTO -import Wizard.Model.Questionnaire.QuestionnaireEvent -import Wizard.Model.Questionnaire.QuestionnaireEventList -import Wizard.Model.Questionnaire.QuestionnaireReply -import Wizard.Model.User.User -import qualified Wizard.Service.User.UserMapper as UM -import WizardLib.Public.Model.User.UserSuggestion - -toEventDTO :: QuestionnaireEvent -> Maybe User -> QuestionnaireEventDTO -toEventDTO event' mCreatedBy = - case event' of - SetReplyEvent' event@SetReplyEvent {..} -> SetReplyEventDTO' $ toSetReplyEventDTO event mCreatedBy - ClearReplyEvent' event@ClearReplyEvent {..} -> ClearReplyEventDTO' $ toClearReplyEventDTO event mCreatedBy - SetPhaseEvent' event@SetPhaseEvent {..} -> SetPhaseEventDTO' $ toSetPhaseEventDTO event mCreatedBy - SetLabelsEvent' event@SetLabelsEvent {..} -> SetLabelsEventDTO' $ toSetLabelsEventDTO event mCreatedBy - -toEventList :: QuestionnaireEvent -> Maybe User -> QuestionnaireEventList -toEventList event' mCreatedBy = - case event' of - SetReplyEvent' event@SetReplyEvent {..} -> SetReplyEventList' $ toSetReplyEventList event mCreatedBy - ClearReplyEvent' event@ClearReplyEvent {..} -> ClearReplyEventList' $ toClearReplyEventList event mCreatedBy - SetPhaseEvent' event@SetPhaseEvent {..} -> SetPhaseEventList' $ toSetPhaseEventList event mCreatedBy - SetLabelsEvent' event@SetLabelsEvent {..} -> SetLabelsEventList' $ toSetLabelsEventList event mCreatedBy - -toEvent :: U.UUID -> U.UUID -> QuestionnaireEventList -> QuestionnaireEvent -toEvent questionnaireUuid tenantUuid event' = - case event' of - SetReplyEventList' event@SetReplyEventList {..} -> SetReplyEvent' $ toSetReplyEvent questionnaireUuid tenantUuid event - ClearReplyEventList' event@ClearReplyEventList {..} -> ClearReplyEvent' $ toClearReplyEvent questionnaireUuid tenantUuid event - SetPhaseEventList' event@SetPhaseEventList {..} -> SetPhaseEvent' $ toSetPhaseEvent questionnaireUuid tenantUuid event - SetLabelsEventList' event@SetLabelsEventList {..} -> SetLabelsEvent' $ toSetLabelsEvent questionnaireUuid tenantUuid event - -toSetReplyEventDTO :: SetReplyEvent -> Maybe User -> SetReplyEventDTO -toSetReplyEventDTO event user = - SetReplyEventDTO - { uuid = event.uuid - , path = event.path - , value = event.value - , createdBy = fmap (UM.toSuggestion . UM.toSimple) user - , createdAt = event.createdAt - } - -toSetReplyEventList :: SetReplyEvent -> Maybe User -> SetReplyEventList -toSetReplyEventList event user = - SetReplyEventList - { uuid = event.uuid - , path = event.path - , value = event.value - , createdBy = fmap (UM.toSuggestion . UM.toSimple) user - , createdAt = event.createdAt - } - -toSetReplyEvent :: U.UUID -> U.UUID -> SetReplyEventList -> SetReplyEvent -toSetReplyEvent questionnaireUuid tenantUuid event = - SetReplyEvent - { uuid = event.uuid - , path = event.path - , value = event.value - , questionnaireUuid = questionnaireUuid - , tenantUuid = tenantUuid - , createdBy = fmap (.uuid) event.createdBy - , createdAt = event.createdAt - } - -toClearReplyEventDTO :: ClearReplyEvent -> Maybe User -> ClearReplyEventDTO -toClearReplyEventDTO event user = - ClearReplyEventDTO - { uuid = event.uuid - , path = event.path - , createdBy = fmap (UM.toSuggestion . UM.toSimple) user - , createdAt = event.createdAt - } - -toClearReplyEventList :: ClearReplyEvent -> Maybe User -> ClearReplyEventList -toClearReplyEventList event user = - ClearReplyEventList - { uuid = event.uuid - , path = event.path - , createdBy = fmap (UM.toSuggestion . UM.toSimple) user - , createdAt = event.createdAt - } - -toClearReplyEvent :: U.UUID -> U.UUID -> ClearReplyEventList -> ClearReplyEvent -toClearReplyEvent questionnaireUuid tenantUuid event = - ClearReplyEvent - { uuid = event.uuid - , path = event.path - , questionnaireUuid = questionnaireUuid - , tenantUuid = tenantUuid - , createdBy = fmap (.uuid) event.createdBy - , createdAt = event.createdAt - } - -toSetPhaseEventDTO :: SetPhaseEvent -> Maybe User -> SetPhaseEventDTO -toSetPhaseEventDTO event user = - SetPhaseEventDTO - { uuid = event.uuid - , phaseUuid = event.phaseUuid - , createdBy = fmap (UM.toSuggestion . UM.toSimple) user - , createdAt = event.createdAt - } - -toSetPhaseEventList :: SetPhaseEvent -> Maybe User -> SetPhaseEventList -toSetPhaseEventList event user = - SetPhaseEventList - { uuid = event.uuid - , phaseUuid = event.phaseUuid - , createdBy = fmap (UM.toSuggestion . UM.toSimple) user - , createdAt = event.createdAt - } - -toSetPhaseEvent :: U.UUID -> U.UUID -> SetPhaseEventList -> SetPhaseEvent -toSetPhaseEvent questionnaireUuid tenantUuid event = - SetPhaseEvent - { uuid = event.uuid - , phaseUuid = event.phaseUuid - , questionnaireUuid = questionnaireUuid - , tenantUuid = tenantUuid - , createdBy = fmap (.uuid) event.createdBy - , createdAt = event.createdAt - } - -toSetLabelsEventDTO :: SetLabelsEvent -> Maybe User -> SetLabelsEventDTO -toSetLabelsEventDTO event user = - SetLabelsEventDTO - { uuid = event.uuid - , path = event.path - , value = event.value - , createdBy = fmap (UM.toSuggestion . UM.toSimple) user - , createdAt = event.createdAt - } - -toSetLabelsEventList :: SetLabelsEvent -> Maybe User -> SetLabelsEventList -toSetLabelsEventList event user = - SetLabelsEventList - { uuid = event.uuid - , path = event.path - , value = event.value - , createdBy = fmap (UM.toSuggestion . UM.toSimple) user - , createdAt = event.createdAt - } - -toSetLabelsEvent :: U.UUID -> U.UUID -> SetLabelsEventList -> SetLabelsEvent -toSetLabelsEvent questionnaireUuid tenantUuid event = - SetLabelsEvent - { uuid = event.uuid - , path = event.path - , value = event.value - , questionnaireUuid = questionnaireUuid - , tenantUuid = tenantUuid - , createdBy = fmap (.uuid) event.createdBy - , createdAt = event.createdAt - } - --- --------------------------------------------------------------------------------------------------------------------- --- --------------------------------------------------------------------------------------------------------------------- -toSetReplyEventDTO' :: SetReplyEventChangeDTO -> Maybe UserSuggestion -> UTCTime -> SetReplyEventDTO -toSetReplyEventDTO' event mCreatedBy now = - SetReplyEventDTO - { uuid = event.uuid - , path = event.path - , value = event.value - , createdBy = mCreatedBy - , createdAt = now - } - -toClearReplyEventDTO' :: ClearReplyEventChangeDTO -> Maybe UserSuggestion -> UTCTime -> ClearReplyEventDTO -toClearReplyEventDTO' event mCreatedBy now = - ClearReplyEventDTO - { uuid = event.uuid - , path = event.path - , createdBy = mCreatedBy - , createdAt = now - } - -toSetPhaseEventDTO' :: SetPhaseEventChangeDTO -> Maybe UserSuggestion -> UTCTime -> SetPhaseEventDTO -toSetPhaseEventDTO' event mCreatedBy now = - SetPhaseEventDTO - { uuid = event.uuid - , phaseUuid = event.phaseUuid - , createdBy = mCreatedBy - , createdAt = now - } - -toSetLabelsEventDTO' :: SetLabelsEventChangeDTO -> Maybe UserSuggestion -> UTCTime -> SetLabelsEventDTO -toSetLabelsEventDTO' event mCreatedBy now = - SetLabelsEventDTO - { uuid = event.uuid - , path = event.path - , value = event.value - , createdBy = mCreatedBy - , createdAt = now - } - -toResolveCommentThreadEventDTO' - :: ResolveCommentThreadEventChangeDTO -> Maybe UserSuggestion -> UTCTime -> ResolveCommentThreadEventDTO -toResolveCommentThreadEventDTO' event mCreatedBy now = - ResolveCommentThreadEventDTO - { uuid = event.uuid - , path = event.path - , threadUuid = event.threadUuid - , commentCount = event.commentCount - , createdBy = mCreatedBy - , createdAt = now - } - -toReopenCommentThreadEventDTO' - :: ReopenCommentThreadEventChangeDTO -> Maybe UserSuggestion -> UTCTime -> ReopenCommentThreadEventDTO -toReopenCommentThreadEventDTO' event mCreatedBy now = - ReopenCommentThreadEventDTO - { uuid = event.uuid - , path = event.path - , threadUuid = event.threadUuid - , commentCount = event.commentCount - , createdBy = mCreatedBy - , createdAt = now - } - -toAssignCommentThreadEventDTO' :: AssignCommentThreadEventChangeDTO -> Maybe UserSuggestion -> UTCTime -> AssignCommentThreadEventDTO -toAssignCommentThreadEventDTO' event mCreatedBy now = - AssignCommentThreadEventDTO - { uuid = event.uuid - , path = event.path - , threadUuid = event.threadUuid - , private = event.private - , assignedTo = event.assignedTo - , createdBy = mCreatedBy - , createdAt = now - } - -toDeleteCommentThreadEventDTO' - :: DeleteCommentThreadEventChangeDTO -> Maybe UserSuggestion -> UTCTime -> DeleteCommentThreadEventDTO -toDeleteCommentThreadEventDTO' event mCreatedBy now = - DeleteCommentThreadEventDTO - { uuid = event.uuid - , path = event.path - , threadUuid = event.threadUuid - , createdBy = mCreatedBy - , createdAt = now - } - -toAddCommentEventDTO' :: AddCommentEventChangeDTO -> Maybe UserSuggestion -> UTCTime -> AddCommentEventDTO -toAddCommentEventDTO' event mCreatedBy now = - AddCommentEventDTO - { uuid = event.uuid - , path = event.path - , threadUuid = event.threadUuid - , commentUuid = event.commentUuid - , text = event.text - , private = event.private - , createdBy = mCreatedBy - , createdAt = now - } - -toEditCommentEventDTO' :: EditCommentEventChangeDTO -> Maybe UserSuggestion -> UTCTime -> EditCommentEventDTO -toEditCommentEventDTO' event mCreatedBy now = - EditCommentEventDTO - { uuid = event.uuid - , path = event.path - , threadUuid = event.threadUuid - , commentUuid = event.commentUuid - , text = event.text - , createdBy = mCreatedBy - , createdAt = now - } - -toDeleteCommentEventDTO' :: DeleteCommentEventChangeDTO -> Maybe UserSuggestion -> UTCTime -> DeleteCommentEventDTO -toDeleteCommentEventDTO' event mCreatedBy now = - DeleteCommentEventDTO - { uuid = event.uuid - , path = event.path - , threadUuid = event.threadUuid - , commentUuid = event.commentUuid - , createdBy = mCreatedBy - , createdAt = now - } - --- --------------------------------------------------------------------------------------------------------------------- --- --------------------------------------------------------------------------------------------------------------------- -toEventChangeDTO :: QuestionnaireEvent -> QuestionnaireEventChangeDTO -toEventChangeDTO event = - case event of - SetReplyEvent' event@SetReplyEvent {..} -> - SetReplyEventChangeDTO' $ toSetReplyEventChangeDTO event - ClearReplyEvent' event@ClearReplyEvent {..} -> - ClearReplyEventChangeDTO' $ toClearReplyEventChangeDTO event - SetPhaseEvent' event@SetPhaseEvent {..} -> - SetPhaseEventChangeDTO' $ toSetPhaseEventChangeDTO event - SetLabelsEvent' event@SetLabelsEvent {..} -> - SetLabelsEventChangeDTO' $ toSetLabelsEventChangeDTO event - -toSetReplyEventChangeDTO :: SetReplyEvent -> SetReplyEventChangeDTO -toSetReplyEventChangeDTO event = - SetReplyEventChangeDTO - { uuid = event.uuid - , path = event.path - , value = event.value - } - -toClearReplyEventChangeDTO :: ClearReplyEvent -> ClearReplyEventChangeDTO -toClearReplyEventChangeDTO event = - ClearReplyEventChangeDTO - { uuid = event.uuid - , path = event.path - } - -toSetPhaseEventChangeDTO :: SetPhaseEvent -> SetPhaseEventChangeDTO -toSetPhaseEventChangeDTO event = - SetPhaseEventChangeDTO - { uuid = event.uuid - , phaseUuid = event.phaseUuid - } - -toSetLabelsEventChangeDTO :: SetLabelsEvent -> SetLabelsEventChangeDTO -toSetLabelsEventChangeDTO event = - SetLabelsEventChangeDTO - { uuid = event.uuid - , path = event.path - , value = event.value - } - --- --------------------------------------------------------------------------------------------------------------------- --- --------------------------------------------------------------------------------------------------------------------- -fromEventChangeDTO :: QuestionnaireEventChangeDTO -> U.UUID -> U.UUID -> Maybe U.UUID -> UTCTime -> QuestionnaireEvent -fromEventChangeDTO event questionnaireUuid tenantUuid createdBy now = - case event of - SetReplyEventChangeDTO' event@SetReplyEventChangeDTO {..} -> - SetReplyEvent' $ fromSetReplyEventChangeDTO event questionnaireUuid tenantUuid createdBy now - ClearReplyEventChangeDTO' event@ClearReplyEventChangeDTO {..} -> - ClearReplyEvent' $ fromClearReplyEventChangeDTO event questionnaireUuid tenantUuid createdBy now - SetPhaseEventChangeDTO' event@SetPhaseEventChangeDTO {..} -> - SetPhaseEvent' $ fromSetPhaseEventChangeDTO event questionnaireUuid tenantUuid createdBy now - SetLabelsEventChangeDTO' event@SetLabelsEventChangeDTO {..} -> - SetLabelsEvent' $ fromSetLabelsEventChangeDTO event questionnaireUuid tenantUuid createdBy now - _ -> error "Unsupported event type in fromEventChangeDTO" - -fromSetReplyEventChangeDTO :: SetReplyEventChangeDTO -> U.UUID -> U.UUID -> Maybe U.UUID -> UTCTime -> SetReplyEvent -fromSetReplyEventChangeDTO event questionnaireUuid tenantUuid createdBy now = - SetReplyEvent - { uuid = event.uuid - , path = event.path - , value = event.value - , questionnaireUuid = questionnaireUuid - , tenantUuid = tenantUuid - , createdBy = createdBy - , createdAt = now - } - -fromClearReplyEventChangeDTO :: ClearReplyEventChangeDTO -> U.UUID -> U.UUID -> Maybe U.UUID -> UTCTime -> ClearReplyEvent -fromClearReplyEventChangeDTO event questionnaireUuid tenantUuid createdBy now = - ClearReplyEvent - { uuid = event.uuid - , path = event.path - , questionnaireUuid = questionnaireUuid - , tenantUuid = tenantUuid - , createdBy = createdBy - , createdAt = now - } - -fromSetPhaseEventChangeDTO :: SetPhaseEventChangeDTO -> U.UUID -> U.UUID -> Maybe U.UUID -> UTCTime -> SetPhaseEvent -fromSetPhaseEventChangeDTO event questionnaireUuid tenantUuid createdBy now = - SetPhaseEvent - { uuid = event.uuid - , phaseUuid = event.phaseUuid - , questionnaireUuid = questionnaireUuid - , tenantUuid = tenantUuid - , createdBy = createdBy - , createdAt = now - } - -fromSetLabelsEventChangeDTO :: SetLabelsEventChangeDTO -> U.UUID -> U.UUID -> Maybe U.UUID -> UTCTime -> SetLabelsEvent -fromSetLabelsEventChangeDTO event questionnaireUuid tenantUuid createdBy now = - SetLabelsEvent - { uuid = event.uuid - , path = event.path - , value = event.value - , questionnaireUuid = questionnaireUuid - , tenantUuid = tenantUuid - , createdBy = createdBy - , createdAt = now - } - --- --------------------------------------------------------------------------------------------------------------------- --- --------------------------------------------------------------------------------------------------------------------- -toReply :: SetReplyEvent -> Maybe User -> Reply -toReply event mUser = - Reply - { value = event.value - , createdBy = fmap (UM.toSuggestion . UM.toSimple) mUser - , createdAt = event.createdAt - } - -toReply' :: SetReplyEventList -> Reply -toReply' SetReplyEventList {..} = Reply {..} diff --git a/wizard-server/src/Wizard/Service/Questionnaire/Event/QuestionnaireEventService.hs b/wizard-server/src/Wizard/Service/Questionnaire/Event/QuestionnaireEventService.hs deleted file mode 100644 index 56f9314f4..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/Event/QuestionnaireEventService.hs +++ /dev/null @@ -1,64 +0,0 @@ -module Wizard.Service.Questionnaire.Event.QuestionnaireEventService where - -import Data.Foldable (traverse_) -import qualified Data.List as L -import qualified Data.Map.Strict as M -import Data.Time -import qualified Data.UUID as U - -import Shared.Common.Model.Common.Lens -import Shared.Common.Util.List (groupBy) -import Shared.Common.Util.Logger -import Wizard.Database.DAO.Common -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireEventDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireVersionDAO -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.QuestionnaireEvent -import Wizard.Model.Questionnaire.QuestionnaireVersion - -squashQuestionnaireEvents :: AppContextM () -squashQuestionnaireEvents = do - qtnUuids <- findQuestionnaireForSquashing - traverse_ squashQuestionnaireEventsForQuestionnaire qtnUuids - -squashQuestionnaireEventsForQuestionnaire :: U.UUID -> AppContextM () -squashQuestionnaireEventsForQuestionnaire qtnUuid = - runInTransaction $ do - logInfoI _CMP_SERVICE (f' "Squashing events for questionnaire (qtnUuid: '%s')" [U.toString qtnUuid]) - events <- findQuestionnaireEventsByQuestionnaireUuid qtnUuid - versions <- findQuestionnaireVersionsByQuestionnaireUuid qtnUuid - let squashedEvents = squash versions events - syncQuestionnaireEventsWithDb events squashedEvents - updateQuestionnaireSquashedByUuid qtnUuid True - logInfoI - _CMP_SERVICE - ( f' - "Squashing for questionnaire '%s' finished successfully (before: %s, after %s)" - [U.toString qtnUuid, show . length $ events, show . length $ squashedEvents] - ) - -instance Ord QuestionnaireEvent where - compare a b = compare (getCreatedAt a) (getCreatedAt b) - -squash :: [QuestionnaireVersion] -> [QuestionnaireEvent] -> [QuestionnaireEvent] -squash versions events = - let groupedEvents = groupBy (\e1 e2 -> utctDay (getCreatedAt e1) == utctDay (getCreatedAt e2)) events - squashedEvents = fmap (squashOnePeriod versions) groupedEvents - in concat squashedEvents - -squashOnePeriod :: [QuestionnaireVersion] -> [QuestionnaireEvent] -> [QuestionnaireEvent] -squashOnePeriod versions = snd . foldr go (M.empty, []) - where - go - :: QuestionnaireEvent - -> (M.Map String (Maybe U.UUID), [QuestionnaireEvent]) - -> (M.Map String (Maybe U.UUID), [QuestionnaireEvent]) - go event' (questions, events) = - case event' of - SetReplyEvent' event -> - if not (L.any (\v -> v.eventUuid == event.uuid) versions) - && Just event.createdBy == M.lookup event.path questions - then (questions, events) - else (M.insert event.path event.createdBy questions, event' : events) - _ -> (questions, event' : events) diff --git a/wizard-server/src/Wizard/Service/Questionnaire/File/QuestionnaireFileAcl.hs b/wizard-server/src/Wizard/Service/Questionnaire/File/QuestionnaireFileAcl.hs deleted file mode 100644 index 99d8e84fc..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/File/QuestionnaireFileAcl.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Wizard.Service.Questionnaire.File.QuestionnaireFileAcl where - -import qualified Data.UUID as U - -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Service.Questionnaire.QuestionnaireAcl - -checkViewPermissionToFile :: U.UUID -> AppContextM () -checkViewPermissionToFile qtnUuid = do - qtn <- findQuestionnaireByUuid qtnUuid - checkViewPermissionToQtn qtn.visibility qtn.sharing qtn.permissions - -checkEditPermissionToFile :: U.UUID -> AppContextM () -checkEditPermissionToFile qtnUuid = do - qtn <- findQuestionnaireByUuid qtnUuid - checkEditPermissionToQtn qtn.visibility qtn.sharing qtn.permissions diff --git a/wizard-server/src/Wizard/Service/Questionnaire/File/QuestionnaireFileCommandExecutor.hs b/wizard-server/src/Wizard/Service/Questionnaire/File/QuestionnaireFileCommandExecutor.hs deleted file mode 100644 index ff5284848..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/File/QuestionnaireFileCommandExecutor.hs +++ /dev/null @@ -1,31 +0,0 @@ -module Wizard.Service.Questionnaire.File.QuestionnaireFileCommandExecutor where - -import Control.Monad.Except (throwError) -import Data.Aeson (eitherDecode) -import qualified Data.ByteString.Lazy.Char8 as BSL -import qualified Data.UUID as U - -import Shared.Common.Model.Error.Error -import Shared.Common.Util.Logger -import Shared.PersistentCommand.Model.PersistentCommand.PersistentCommand -import Wizard.Model.Context.AppContext -import Wizard.Model.PersistentCommand.Questionnaire.File.QuestionnaireFileDeleteFromS3Command -import Wizard.S3.Questionnaire.QuestionnaireFileS3 - -cComponent = "questionnaire_file" - -execute :: PersistentCommand U.UUID -> AppContextM (PersistentCommandState, Maybe String) -execute command - | command.function == cDeleteFromS3Name = cDeleteFromS3 command - | otherwise = throwError . GeneralServerError $ "Unknown command function: " <> command.function - -cDeleteFromS3Name = "deleteFromS3" - -cDeleteFromS3 :: PersistentCommand U.UUID -> AppContextM (PersistentCommandState, Maybe String) -cDeleteFromS3 persistentCommand = do - let eCommand = eitherDecode (BSL.pack persistentCommand.body) :: Either String QuestionnaireFileDeleteFromS3Command - case eCommand of - Right command -> do - removeFile command.questionnaireUuid command.fileUuid - return (DonePersistentCommandState, Nothing) - Left error -> return (ErrorPersistentCommandState, Just $ f' "Problem in deserialization of JSON: %s" [error]) diff --git a/wizard-server/src/Wizard/Service/Questionnaire/File/QuestionnaireFileMapper.hs b/wizard-server/src/Wizard/Service/Questionnaire/File/QuestionnaireFileMapper.hs deleted file mode 100644 index 5e3e6d020..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/File/QuestionnaireFileMapper.hs +++ /dev/null @@ -1,48 +0,0 @@ -module Wizard.Service.Questionnaire.File.QuestionnaireFileMapper where - -import qualified Data.ByteString.Char8 as BS -import Data.Time -import qualified Data.UUID as U - -import Wizard.Api.Resource.File.FileCreateDTO -import Wizard.Api.Resource.User.UserDTO -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireFile -import Wizard.Model.Questionnaire.QuestionnaireFileList -import Wizard.Model.Questionnaire.QuestionnaireFileSimple -import qualified Wizard.Service.Questionnaire.QuestionnaireMapper as QuestionnaireMapper -import qualified Wizard.Service.User.UserMapper as UserMapper - -toList :: QuestionnaireFile -> Questionnaire -> Maybe UserDTO -> QuestionnaireFileList -toList QuestionnaireFile {..} questionnaire mCreatedBy = - QuestionnaireFileList - { uuid = uuid - , fileName = fileName - , contentType = contentType - , fileSize = fileSize - , questionnaire = QuestionnaireMapper.toSimple questionnaire - , createdBy = fmap UserMapper.toSuggestion' mCreatedBy - , createdAt = createdAt - } - -toSimple :: QuestionnaireFile -> QuestionnaireFileSimple -toSimple QuestionnaireFile {..} = - QuestionnaireFileSimple - { uuid = uuid - , fileName = fileName - , contentType = contentType - , fileSize = fileSize - } - -fromFileCreateDTO :: FileCreateDTO -> U.UUID -> U.UUID -> Maybe UserDTO -> U.UUID -> UTCTime -> QuestionnaireFile -fromFileCreateDTO reqDto uuid qtnUuid mCreatedBy tenantUuid now = - QuestionnaireFile - { uuid = uuid - , fileName = reqDto.fileName - , contentType = reqDto.contentType - , fileSize = fromIntegral . BS.length $ reqDto.content - , questionnaireUuid = qtnUuid - , createdBy = fmap (.uuid) mCreatedBy - , tenantUuid = tenantUuid - , createdAt = now - } diff --git a/wizard-server/src/Wizard/Service/Questionnaire/File/QuestionnaireFileService.hs b/wizard-server/src/Wizard/Service/Questionnaire/File/QuestionnaireFileService.hs deleted file mode 100644 index f6bc8581e..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/File/QuestionnaireFileService.hs +++ /dev/null @@ -1,90 +0,0 @@ -module Wizard.Service.Questionnaire.File.QuestionnaireFileService where - -import Control.Monad (void) -import Control.Monad.Reader (asks, liftIO) -import Data.Time -import qualified Data.UUID as U - -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.Constant.Acl -import Wizard.Database.DAO.Common -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireFileDAO -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.AppContextHelpers -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireFile -import Wizard.Model.Questionnaire.QuestionnaireFileList -import Wizard.S3.Questionnaire.QuestionnaireFileS3 -import Wizard.Service.Questionnaire.Collaboration.CollaborationService -import Wizard.Service.Questionnaire.File.QuestionnaireFileAcl -import Wizard.Service.Questionnaire.File.QuestionnaireFileMapper -import Wizard.Service.Questionnaire.File.QuestionnaireFileValidation -import Wizard.Service.Questionnaire.QuestionnaireAcl -import WizardLib.Public.Api.Resource.TemporaryFile.TemporaryFileDTO -import qualified WizardLib.Public.Service.TemporaryFile.TemporaryFileMapper as TemporaryFileMapper -import WizardLib.Public.Service.TemporaryFile.TemporaryFileService - -getQuestionnaireFilesPage :: Maybe String -> Maybe U.UUID -> Pageable -> [Sort] -> AppContextM (Page QuestionnaireFileList) -getQuestionnaireFilesPage mQuery mQtnUuid pageable sort = do - case mQtnUuid of - Just qtnUuid -> do - qtn <- findQuestionnaireByUuid qtnUuid - checkViewPermissionToQtn qtn.visibility qtn.sharing qtn.permissions - Nothing -> checkPermission _QTN_FILE_PERM - findQuestionnaireFilesPage mQuery mQtnUuid pageable sort - -createQuestionnaireFile :: U.UUID -> U.UUID -> FileCreateDTO -> AppContextM QuestionnaireFileList -createQuestionnaireFile qtnUuid questionUuid reqDto = - runInTransaction $ do - qtn <- findQuestionnaireByUuid qtnUuid - checkViewPermissionToQtn qtn.visibility qtn.sharing qtn.permissions - uuid <- liftIO generateUuid - mCurrentUser <- asks currentUser - tenantUuid <- asks currentTenantUuid - now <- liftIO getCurrentTime - let qtnFile = fromFileCreateDTO reqDto uuid qtnUuid mCurrentUser tenantUuid now - validateQuestionnaireFile qtn questionUuid qtnFile - insertQuestionnaireFile qtnFile - putFile qtnUuid uuid reqDto.contentType reqDto.content - 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 - qtnFile <- findQuestionnaireFileByUuid fileUuid - checkViewPermissionToFile qtnUuid - contentAction <- retrieveFileConduitAction qtnUuid fileUuid - mCurrentUserUuid <- getCurrentUserUuid - url <- createTemporaryFileConduit qtnFile.fileName "application/octet-stream" mCurrentUserUuid contentAction - return $ TemporaryFileMapper.toDTO url qtnFile.contentType - -deleteQuestionnaireFile :: U.UUID -> U.UUID -> AppContextM () -deleteQuestionnaireFile qtnUuid fileUuid = do - runInTransaction $ do - _ <- findQuestionnaireFileByUuid fileUuid - checkEditPermissionToFile qtnUuid - void $ deleteQuestionnaireFileByUuid fileUuid diff --git a/wizard-server/src/Wizard/Service/Questionnaire/File/QuestionnaireFileValidation.hs b/wizard-server/src/Wizard/Service/Questionnaire/File/QuestionnaireFileValidation.hs deleted file mode 100644 index d5a4dad30..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/File/QuestionnaireFileValidation.hs +++ /dev/null @@ -1,30 +0,0 @@ -module Wizard.Service.Questionnaire.File.QuestionnaireFileValidation where - -import Control.Monad (when) -import Control.Monad.Except (throwError) -import qualified Data.Map.Strict as M -import qualified Data.UUID as U - -import Shared.Common.Model.Error.Error -import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel -import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModelLenses -import Wizard.Localization.Messages.Public -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireFile -import Wizard.Service.KnowledgeModel.KnowledgeModelService -import Wizard.Service.Tenant.Limit.LimitService - -validateQuestionnaireFile :: Questionnaire -> U.UUID -> QuestionnaireFile -> AppContextM () -validateQuestionnaireFile qtn questionUuid qtnFile = do - checkStorageSize qtnFile.fileSize - km <- compileKnowledgeModel [] (Just qtn.knowledgeModelPackageId) qtn.selectedQuestionTagUuids - case M.lookup questionUuid (getQuestionsM km) of - Just (FileQuestion' question) -> - case question.maxSize of - (Just maxFileSize) -> - when - (maxFileSize < fromIntegral qtnFile.fileSize) - (throwError . UserError $ _ERROR_VALIDATION__QUESTIONNAIRE_FILE_SIZE_EXCEEDS_LIMIT qtnFile.fileSize maxFileSize) - Nothing -> return () - _ -> throwError . UserError $ _ERROR_VALIDATION__QUESTIONNAIRE_FILE_QUESTION_ABSENCE_OR_WRONG_TYPE diff --git a/wizard-server/src/Wizard/Service/Questionnaire/Migration/MigrationAudit.hs b/wizard-server/src/Wizard/Service/Questionnaire/Migration/MigrationAudit.hs deleted file mode 100644 index c1c454545..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/Migration/MigrationAudit.hs +++ /dev/null @@ -1,49 +0,0 @@ -module Wizard.Service.Questionnaire.Migration.MigrationAudit where - -import qualified Data.Map.Strict as M -import qualified Data.UUID as U - -import Shared.Audit.Service.Audit.AuditService -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateChangeDTO -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateCreateDTO -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailQuestionnaireDTO -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.ContextLenses () -import Wizard.Model.Questionnaire.Questionnaire - -auditQuestionnaireMigrationCreate :: MigratorStateCreateDTO -> Questionnaire -> Questionnaire -> AppContextM () -auditQuestionnaireMigrationCreate reqDto oldQtn newQtn = - logAuditWithBody - "questionnaire.migration" - "create" - (U.toString oldQtn.uuid) - ( M.fromList - [ ("sourceKnowledgeModelPackageId", oldQtn.knowledgeModelPackageId) - , ("targetKnowledgeModelPackageId", reqDto.targetKnowledgeModelPackageId) - , ("oldQuestionnaireUuid", U.toString $ oldQtn.uuid) - , ("newQuestionnaireUuid", U.toString $ newQtn.uuid) - ] - ) - -auditQuestionnaireMigrationModify :: MigratorStateDTO -> MigratorStateChangeDTO -> AppContextM () -auditQuestionnaireMigrationModify state resolvedQuestionUuids = - logAuditWithBody - "questionnaire.migration" - "modify" - (U.toString $ state.oldQuestionnaire.uuid) - (M.fromList [("resolvedQuestionUuids", show resolvedQuestionUuids)]) - -auditQuestionnaireMigrationFinish :: Questionnaire -> Questionnaire -> AppContextM () -auditQuestionnaireMigrationFinish oldQtn newQtn = - logAuditWithBody - "questionnaire.migration" - "finish" - (U.toString oldQtn.uuid) - ( M.fromList - [("oldQuestionnaireUuid", U.toString $ oldQtn.uuid), ("newQuestionnaireUuid", U.toString $ newQtn.uuid)] - ) - -auditQuestionnaireMigrationCancel :: MigratorStateDTO -> AppContextM () -auditQuestionnaireMigrationCancel state = - logAudit "questionnaire.migration" "cancel" (U.toString $ state.oldQuestionnaire.uuid) diff --git a/wizard-server/src/Wizard/Service/Questionnaire/Migration/MigrationMapper.hs b/wizard-server/src/Wizard/Service/Questionnaire/Migration/MigrationMapper.hs deleted file mode 100644 index cc9cbfde7..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/Migration/MigrationMapper.hs +++ /dev/null @@ -1,50 +0,0 @@ -module Wizard.Service.Questionnaire.Migration.MigrationMapper where - -import Data.Time -import qualified Data.UUID as U - -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateChangeDTO -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailQuestionnaireDTO -import Wizard.Api.Resource.User.UserDTO -import Wizard.Model.Questionnaire.MigratorState -import Wizard.Model.Questionnaire.QuestionnaireEvent - -toDTO :: QuestionnaireDetailQuestionnaireDTO -> QuestionnaireDetailQuestionnaireDTO -> [U.UUID] -> U.UUID -> MigratorStateDTO -toDTO oldQtn newQtn qtnUuids tenantUuid = - MigratorStateDTO - { oldQuestionnaire = oldQtn - , newQuestionnaire = newQtn - , resolvedQuestionUuids = qtnUuids - , tenantUuid = tenantUuid - } - -fromCreateDTO :: U.UUID -> U.UUID -> U.UUID -> MigratorState -fromCreateDTO oldQtnUuid newQtnUuid tenantUuid = - MigratorState - { oldQuestionnaireUuid = oldQtnUuid - , newQuestionnaireUuid = newQtnUuid - , resolvedQuestionUuids = [] - , tenantUuid = tenantUuid - } - -fromChangeDTO :: MigratorStateChangeDTO -> MigratorStateDTO -> MigratorState -fromChangeDTO changeDto ms = - MigratorState - { oldQuestionnaireUuid = ms.oldQuestionnaire.uuid - , newQuestionnaireUuid = ms.newQuestionnaire.uuid - , resolvedQuestionUuids = changeDto.resolvedQuestionUuids - , tenantUuid = ms.tenantUuid - } - -toQuestionnairePhaseEvent :: U.UUID -> Maybe U.UUID -> U.UUID -> U.UUID -> Maybe UserDTO -> UTCTime -> QuestionnaireEvent -toQuestionnairePhaseEvent phaseEventUuid kmPhaseUuid questionnaireUuid tenantUuid mCurrentUserUuid now = - SetPhaseEvent' $ - SetPhaseEvent - { uuid = phaseEventUuid - , phaseUuid = kmPhaseUuid - , questionnaireUuid = questionnaireUuid - , tenantUuid = tenantUuid - , createdBy = fmap (.uuid) mCurrentUserUuid - , createdAt = now - } diff --git a/wizard-server/src/Wizard/Service/Questionnaire/Migration/MigrationService.hs b/wizard-server/src/Wizard/Service/Questionnaire/Migration/MigrationService.hs deleted file mode 100644 index 5b067c693..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/Migration/MigrationService.hs +++ /dev/null @@ -1,205 +0,0 @@ -module Wizard.Service.Questionnaire.Migration.MigrationService where - -import Control.Monad.Reader (asks, liftIO) -import Data.Foldable (traverse_) -import qualified Data.List as L -import Data.Maybe (catMaybes) -import Data.Time -import qualified Data.UUID as U - -import Shared.Common.Model.Common.Lens -import Shared.Common.Util.List -import Shared.Common.Util.Uuid -import Shared.DocumentTemplate.Database.DAO.DocumentTemplate.DocumentTemplateDAO -import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateChangeDTO -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateCreateDTO -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailQuestionnaireDTO -import Wizard.Database.DAO.Common -import Wizard.Database.DAO.Questionnaire.MigratorDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireEventDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireVersionDAO -import Wizard.Model.Common.Lens -import Wizard.Model.Context.AclContext -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.MigratorState -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireContent -import Wizard.Model.Questionnaire.QuestionnaireEvent -import Wizard.Model.Questionnaire.QuestionnairePerm -import Wizard.Model.Questionnaire.QuestionnaireVersion -import Wizard.Service.DocumentTemplate.DocumentTemplateUtil -import Wizard.Service.KnowledgeModel.KnowledgeModelService -import Wizard.Service.Questionnaire.Compiler.CompilerService -import Wizard.Service.Questionnaire.Event.QuestionnaireEventMapper -import Wizard.Service.Questionnaire.Migration.MigrationAudit -import Wizard.Service.Questionnaire.Migration.MigrationMapper -import Wizard.Service.Questionnaire.Migration.MigrationValidation -import Wizard.Service.Questionnaire.Migration.Migrator.Sanitizer -import Wizard.Service.Questionnaire.QuestionnaireAcl -import Wizard.Service.Questionnaire.QuestionnaireService - -createQuestionnaireMigration :: U.UUID -> MigratorStateCreateDTO -> AppContextM MigratorStateDTO -createQuestionnaireMigration oldQtnUuid reqDto = - runInTransaction $ do - checkPermission _QTN_PERM - validateMigrationExistence oldQtnUuid - oldQtn <- findQuestionnaireByUuid oldQtnUuid - checkMigrationPermissionToQtn oldQtn.visibility oldQtn.permissions - (newQtn, newQtnEvents, newQtnVersions) <- upgradeQuestionnaire reqDto oldQtn - insertQuestionnaire newQtn - insertQuestionnaireEvents newQtnEvents - traverse_ insertQuestionnaireVersion newQtnVersions - tenantUuid <- asks currentTenantUuid - let state = fromCreateDTO oldQtn.uuid newQtn.uuid tenantUuid - insertMigratorState state - auditQuestionnaireMigrationCreate reqDto oldQtn newQtn - getQuestionnaireMigration newQtn.uuid - -getQuestionnaireMigration :: U.UUID -> AppContextM MigratorStateDTO -getQuestionnaireMigration qtnUuid = do - checkPermission _QTN_PERM - state <- findMigratorStateByNewQuestionnaireUuid qtnUuid - oldQtnDto <- getQuestionnaireDetailQuestionnaireByUuid state.oldQuestionnaireUuid - newQtnDto <- getQuestionnaireDetailQuestionnaireByUuid state.newQuestionnaireUuid - oldQtn <- findQuestionnaireByUuid state.oldQuestionnaireUuid - newQtn <- findQuestionnaireByUuid state.newQuestionnaireUuid - checkMigrationPermissionToQtn oldQtn.visibility oldQtn.permissions - checkMigrationPermissionToQtn newQtn.visibility newQtn.permissions - return $ toDTO oldQtnDto newQtnDto state.resolvedQuestionUuids state.tenantUuid - -modifyQuestionnaireMigration :: U.UUID -> MigratorStateChangeDTO -> AppContextM MigratorStateDTO -modifyQuestionnaireMigration qtnUuid reqDto = - runInTransaction $ do - checkPermission _QTN_PERM - state <- getQuestionnaireMigration qtnUuid - let updatedState = fromChangeDTO reqDto state - updateMigratorStateByNewQuestionnaireUuid updatedState - auditQuestionnaireMigrationModify state reqDto - return $ toDTO state.oldQuestionnaire state.newQuestionnaire updatedState.resolvedQuestionUuids updatedState.tenantUuid - -finishQuestionnaireMigration :: U.UUID -> AppContextM () -finishQuestionnaireMigration qtnUuid = - runInTransaction $ do - checkPermission _QTN_PERM - _ <- getQuestionnaireMigration qtnUuid - state <- findMigratorStateByNewQuestionnaireUuid qtnUuid - deleteMigratorStateByNewQuestionnaireUuid qtnUuid - oldQtn <- findQuestionnaireByUuid state.oldQuestionnaireUuid - newQtn <- findQuestionnaireByUuid state.newQuestionnaireUuid - newQtnEvents <- ensurePhaseIsSetIfNecessary newQtn - newQtnVersions <- findQuestionnaireVersionsByQuestionnaireUuid state.newQuestionnaireUuid - now <- liftIO getCurrentTime - let updatedNewQtn = - oldQtn - { formatUuid = newQtn.formatUuid - , documentTemplateId = newQtn.documentTemplateId - , selectedQuestionTagUuids = newQtn.selectedQuestionTagUuids - , knowledgeModelPackageId = newQtn.knowledgeModelPackageId - , updatedAt = now - } - :: Questionnaire - let newQtnEventsWithOldQtnUuid = fmap (\event -> setQuestionnaireUuid event oldQtn.uuid) newQtnEvents - newVersionsWithNewUuid <- traverse generateNewVersionUuid newQtnVersions - let newVersionsWithOldQtnUuid = fmap (\v -> v {questionnaireUuid = oldQtn.uuid} :: QuestionnaireVersion) newVersionsWithNewUuid - -- Delete the new questionnaire - deleteQuestionnaireEventsByQuestionnaireUuid newQtn.uuid - deleteQuestionnaire newQtn.uuid False - -- Update the old questionnaire with values from new questionnaire - updateQuestionnaireByUuid updatedNewQtn - deleteQuestionnaireEventsByQuestionnaireUuid oldQtn.uuid - insertQuestionnaireEvents newQtnEventsWithOldQtnUuid - traverse_ insertQuestionnaireVersion newVersionsWithOldQtnUuid - auditQuestionnaireMigrationFinish oldQtn newQtn - -cancelQuestionnaireMigration :: U.UUID -> AppContextM () -cancelQuestionnaireMigration qtnUuid = - runInTransaction $ do - checkPermission _QTN_PERM - state <- getQuestionnaireMigration qtnUuid - deleteQuestionnaire state.newQuestionnaire.uuid True - deleteMigratorStateByNewQuestionnaireUuid qtnUuid - auditQuestionnaireMigrationCancel state - return () - --- -------------------------------- --- PRIVATE --- -------------------------------- -upgradeQuestionnaire :: MigratorStateCreateDTO -> Questionnaire -> AppContextM (Questionnaire, [QuestionnaireEvent], [QuestionnaireVersion]) -upgradeQuestionnaire reqDto oldQtn = do - let newPkgId = reqDto.targetKnowledgeModelPackageId - let newTagUuids = reqDto.targetTagUuids - oldKm <- compileKnowledgeModel [] (Just oldQtn.knowledgeModelPackageId) newTagUuids - newKm <- compileKnowledgeModel [] (Just newPkgId) newTagUuids - newUuid <- liftIO generateUuid - oldQtnEvents <- findQuestionnaireEventListsByQuestionnaireUuid oldQtn.uuid - clonedQtnEventsWithOldEventUuid <- cloneQuestionnaireEventsWithOldEventUuid oldQtnEvents - let clonedQtnEvents = fmap snd clonedQtnEventsWithOldEventUuid - newQtnEvents <- sanitizeQuestionnaireEvents newUuid oldKm newKm clonedQtnEvents - (newDocumentTemplateId, newFormatUuid) <- getNewDocumentTemplateIdAndFormatUuid oldQtn newPkgId - let newQtnEventUuids = fmap getUuid newQtnEvents - let clonedQtnEventsFiltered = filter (\e -> getUuid (snd e) `elem` newQtnEventUuids) clonedQtnEventsWithOldEventUuid - let newPermissions = fmap (\perm -> perm {questionnaireUuid = newUuid} :: QuestionnairePerm) oldQtn.permissions - let upgradedQtn = - oldQtn - { uuid = newUuid - , knowledgeModelPackageId = newPkgId - , selectedQuestionTagUuids = newTagUuids - , documentTemplateId = newDocumentTemplateId - , formatUuid = newFormatUuid - , permissions = newPermissions - } - :: Questionnaire - versionsWithOldQtnUuid <- findQuestionnaireVersionsByQuestionnaireUuid oldQtn.uuid - newVersionsWithNewUuid <- traverse generateNewVersionUuid versionsWithOldQtnUuid - let newVersionsWithNewEventUuid = - fmap - ( \v -> - case L.find (\(oldEventUuid, _) -> v.eventUuid == oldEventUuid) clonedQtnEventsWithOldEventUuid of - Just (_, newEvent) -> - Just $ - v - { questionnaireUuid = newUuid - , eventUuid = getUuid newEvent - } - Nothing -> Nothing - ) - newVersionsWithNewUuid - let newVersions = catMaybes newVersionsWithNewEventUuid - return (upgradedQtn, fmap (toEvent upgradedQtn.uuid upgradedQtn.tenantUuid) newQtnEvents, newVersions) - -ensurePhaseIsSetIfNecessary :: Questionnaire -> AppContextM [QuestionnaireEvent] -ensurePhaseIsSetIfNecessary newQtn = do - uuid <- liftIO generateUuid - mCurrentUser <- asks currentUser - now <- liftIO getCurrentTime - newQtnListEvents <- findQuestionnaireEventListsByQuestionnaireUuid newQtn.uuid - let qtnCtn = compileQuestionnaire newQtnListEvents - knowledgeModel <- compileKnowledgeModel [] (Just newQtn.knowledgeModelPackageId) newQtn.selectedQuestionTagUuids - let newQtnEvents = fmap (toEvent newQtn.uuid newQtn.tenantUuid) newQtnListEvents - return $ - case (headSafe knowledgeModel.phaseUuids, qtnCtn.phaseUuid) of - (Nothing, Nothing) -> newQtnEvents - (Nothing, Just qtnPhaseUuid) -> newQtnEvents ++ [toQuestionnairePhaseEvent uuid Nothing newQtn.uuid newQtn.tenantUuid mCurrentUser now] - (Just kmPhaseUuid, Nothing) -> newQtnEvents ++ [toQuestionnairePhaseEvent uuid (Just kmPhaseUuid) newQtn.uuid newQtn.tenantUuid mCurrentUser now] - (Just kmPhaseUuid, Just qtnPhaseUuid) -> - if qtnPhaseUuid `notElem` knowledgeModel.phaseUuids - then newQtnEvents ++ [toQuestionnairePhaseEvent uuid (Just kmPhaseUuid) newQtn.uuid newQtn.tenantUuid mCurrentUser now] - else newQtnEvents - -generateNewVersionUuid :: QuestionnaireVersion -> AppContextM QuestionnaireVersion -generateNewVersionUuid version = do - newVersionUuid <- liftIO generateUuid - return $ version {uuid = newVersionUuid} - -getNewDocumentTemplateIdAndFormatUuid :: Questionnaire -> String -> AppContextM (Maybe String, Maybe U.UUID) -getNewDocumentTemplateIdAndFormatUuid oldQtn newPkgId = do - case oldQtn.documentTemplateId of - Just id -> do - documentTemplate <- findDocumentTemplateById id - if isPkgAllowedByDocumentTemplate newPkgId documentTemplate - then return (Just id, oldQtn.formatUuid) - else return (Nothing, Nothing) - Nothing -> return (Nothing, Nothing) diff --git a/wizard-server/src/Wizard/Service/Questionnaire/Migration/MigrationValidation.hs b/wizard-server/src/Wizard/Service/Questionnaire/Migration/MigrationValidation.hs deleted file mode 100644 index 77fd9dbb5..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/Migration/MigrationValidation.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Service.Questionnaire.Migration.MigrationValidation where - -import Control.Monad (unless) -import Control.Monad.Except (throwError) - -import Shared.Common.Model.Error.Error -import Wizard.Database.DAO.Questionnaire.MigratorDAO -import Wizard.Localization.Messages.Public - -validateMigrationExistence oldQtnUuid = do - states <- findMigratorStatesByOldQuestionnaireUuid oldQtnUuid - unless (null states) (throwError . UserError $ _ERROR_VALIDATION__QTN_MIGRATION_UNIQUENESS) diff --git a/wizard-server/src/Wizard/Service/Questionnaire/Migration/Migrator/Sanitizer.hs b/wizard-server/src/Wizard/Service/Questionnaire/Migration/Migrator/Sanitizer.hs deleted file mode 100644 index 81ca6fbd0..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/Migration/Migrator/Sanitizer.hs +++ /dev/null @@ -1,77 +0,0 @@ -module Wizard.Service.Questionnaire.Migration.Migrator.Sanitizer ( - sanitizeQuestionnaireEvents, -) where - -import Control.Monad.Reader (liftIO) -import qualified Data.Map.Strict as M -import Data.Time -import qualified Data.UUID as U - -import Shared.Common.Util.Uuid -import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.AppContextHelpers -import Wizard.Model.Questionnaire.QuestionnaireContent -import Wizard.Model.Questionnaire.QuestionnaireEventList -import Wizard.Model.Questionnaire.QuestionnaireReply -import Wizard.Service.Questionnaire.Compiler.CompilerService -import qualified Wizard.Service.Questionnaire.Migration.Migrator.ChangeQTypeSanitizer as CTS -import qualified Wizard.Service.Questionnaire.Migration.Migrator.MoveSanitizer as MS -import Wizard.Service.User.UserMapper - -sanitizeQuestionnaireEvents :: U.UUID -> KnowledgeModel -> KnowledgeModel -> [QuestionnaireEventList] -> AppContextM [QuestionnaireEventList] -sanitizeQuestionnaireEvents qtnUuid oldKm newKm events = do - let oldQtnContent = compileQuestionnaire events - let oldReplies = oldQtnContent.replies - now <- liftIO getCurrentTime - let sanitizedReplies = M.fromList . sanitizeReplies now oldKm newKm . M.toList $ oldReplies - clearReplyEvents <- generateClearReplyEvents qtnUuid oldReplies sanitizedReplies - setReplyEvents <- generateSetReplyEvents qtnUuid oldReplies sanitizedReplies - return $ events ++ clearReplyEvents ++ setReplyEvents - --- -------------------------------- --- PRIVATE --- -------------------------------- -sanitizeReplies :: UTCTime -> KnowledgeModel -> KnowledgeModel -> [ReplyTuple] -> [ReplyTuple] -sanitizeReplies now oldKm newKm = MS.sanitizeReplies now oldKm newKm . CTS.sanitizeReplies newKm - -generateClearReplyEvents :: U.UUID -> M.Map String Reply -> M.Map String Reply -> AppContextM [QuestionnaireEventList] -generateClearReplyEvents qtnUuid oldReplies sanitizedReplies = traverse generateEvent repliesToBeDeleted - where - repliesToBeDeleted :: [ReplyTuple] - repliesToBeDeleted = M.toList . M.filterWithKey (\k _ -> k `M.notMember` sanitizedReplies) $ oldReplies - generateEvent :: ReplyTuple -> AppContextM QuestionnaireEventList - generateEvent (k, _) = do - eUuid <- liftIO generateUuid - now <- liftIO getCurrentTime - user <- getCurrentUser - return . ClearReplyEventList' $ ClearReplyEventList eUuid k (Just (toSuggestion' user)) now - -generateSetReplyEvents :: U.UUID -> M.Map String Reply -> M.Map String Reply -> AppContextM [QuestionnaireEventList] -generateSetReplyEvents qtnUuid oldReplies sanitizedReplies = foldl generateEvent (return []) (M.toList sanitizedReplies) - where - generateEvent :: AppContextM [QuestionnaireEventList] -> ReplyTuple -> AppContextM [QuestionnaireEventList] - generateEvent accM (keyFromSanitizedReply, valueFromSanitizedReply) = do - acc <- accM - eUuid <- liftIO generateUuid - now <- liftIO getCurrentTime - user <- getCurrentUser - return $ - case M.lookup keyFromSanitizedReply oldReplies of - Just valueFromOldReply -> - if valueFromOldReply.value == valueFromSanitizedReply.value - then acc - else - acc - ++ [ SetReplyEventList' $ - SetReplyEventList - eUuid - keyFromSanitizedReply - valueFromSanitizedReply.value - (Just (toSuggestion' user)) - now - ] - Nothing -> - acc - ++ [ SetReplyEventList' $ SetReplyEventList eUuid keyFromSanitizedReply valueFromSanitizedReply.value (Just (toSuggestion' user)) now - ] diff --git a/wizard-server/src/Wizard/Service/Questionnaire/ProjectTag/ProjectTagService.hs b/wizard-server/src/Wizard/Service/Questionnaire/ProjectTag/ProjectTagService.hs deleted file mode 100644 index 1012a18fb..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/ProjectTag/ProjectTagService.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Wizard.Service.Questionnaire.ProjectTag.ProjectTagService where - -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.Pageable -import Shared.Common.Model.Common.Sort -import Wizard.Database.DAO.Questionnaire.QuestionnaireProjectTagDAO -import Wizard.Model.Context.AclContext -import Wizard.Model.Context.AppContext - -getProjectTagSuggestions :: Maybe String -> [String] -> Pageable -> [Sort] -> AppContextM (Page String) -getProjectTagSuggestions mQuery excludeTags pageable sort = do - checkPermission _QTN_PERM - findQuestionnaireProjectTagsPage mQuery excludeTags pageable sort diff --git a/wizard-server/src/Wizard/Service/Questionnaire/QuestionnaireAcl.hs b/wizard-server/src/Wizard/Service/Questionnaire/QuestionnaireAcl.hs deleted file mode 100644 index a41189704..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/QuestionnaireAcl.hs +++ /dev/null @@ -1,198 +0,0 @@ -module Wizard.Service.Questionnaire.QuestionnaireAcl where - -import Control.Monad (unless) -import Control.Monad.Except (throwError) - -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Wizard.Api.Resource.User.UserDTO -import Wizard.Model.Context.AclContext -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.AppContextHelpers -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireAclHelpers -import Wizard.Model.Questionnaire.QuestionnairePerm -import Wizard.Model.Tenant.Config.TenantConfig -import Wizard.Service.Tenant.Config.ConfigService -import WizardLib.Public.Database.DAO.User.UserGroupMembershipDAO -import WizardLib.Public.Model.User.UserGroupMembership - -checkCreatePermissionToQtn :: AppContextM () -checkCreatePermissionToQtn = do - tcQuestionnaire <- getCurrentTenantConfigQuestionnaire - let qtnSharingEnabled = tcQuestionnaire.questionnaireSharing.enabled - let qtnSharingAnonymousEnabled = tcQuestionnaire.questionnaireSharing.anonymousEnabled - let qtnCreation = tcQuestionnaire.questionnaireCreation - case (qtnSharingEnabled, qtnSharingAnonymousEnabled, qtnCreation) of - (True, True, CustomQuestionnaireCreation) -> return () - (True, True, TemplateAndCustomQuestionnaireCreation) -> return () - (_, _, TemplateQuestionnaireCreation) -> do - checkPermission _QTN_PERM - checkPermission _QTN_TML_PERM - (_, _, _) -> checkPermission _QTN_PERM - -checkCreateFromTemplatePermissionToQtn :: Bool -> AppContextM () -checkCreateFromTemplatePermissionToQtn isTemplate = do - checkPermission _QTN_PERM - tcQuestionnaire <- getCurrentTenantConfigQuestionnaire - let qtnCreation = tcQuestionnaire.questionnaireCreation - case qtnCreation of - CustomQuestionnaireCreation -> - throwError . UserError . _ERROR_SERVICE_COMMON__FEATURE_IS_DISABLED $ "Questionnaire Template" - _ -> unless isTemplate (throwError . ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN "Questionnaire Template") - -checkClonePermissionToQtn :: QuestionnairePermC questionnairePerm => QuestionnaireVisibility -> QuestionnaireSharing -> [questionnairePerm] -> AppContextM () -checkClonePermissionToQtn visibility sharing permissions = do - checkPermission _QTN_PERM - checkViewPermissionToQtn visibility sharing permissions - -checkViewPermissionToQtn :: QuestionnairePermC questionnairePerm => QuestionnaireVisibility -> QuestionnaireSharing -> [questionnairePerm] -> AppContextM () -checkViewPermissionToQtn visibility sharing perms = do - result <- hasViewPermissionToQtn visibility sharing perms - if result - then return () - else throwError . ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN "View Questionnaire" - -hasViewPermissionToQtn :: QuestionnairePermC questionnairePerm => QuestionnaireVisibility -> QuestionnaireSharing -> [questionnairePerm] -> AppContextM Bool -hasViewPermissionToQtn visibility sharing perms = - if sharing == AnyoneWithLinkViewQuestionnaire - || sharing == AnyoneWithLinkCommentQuestionnaire - || sharing - == AnyoneWithLinkEditQuestionnaire - then return True - else do - checkPermission _QTN_PERM - currentUser <- getCurrentUser - userGroupMemberships <- findUserGroupMembershipsByUserUuid currentUser.uuid - let currentUserGroupUuids = fmap (.userGroupUuid) userGroupMemberships - if or - [ currentUser.uRole == _USER_ROLE_ADMIN - , -- Check visibility - visibility == VisibleViewQuestionnaire - , visibility == VisibleCommentQuestionnaire - , visibility == VisibleEditQuestionnaire - , -- Check membership - currentUser.uuid `elem` getUserUuidsForViewerPerm perms - , currentUser.uuid `elem` getUserUuidsForCommenterPerm perms - , currentUser.uuid `elem` getUserUuidsForEditorPerm perms - , currentUser.uuid `elem` getUserUuidsForOwnerPerm perms - , -- Check groups - or (fmap (`elem` getUserGroupUuidsForViewerPerm perms) currentUserGroupUuids) - , or (fmap (`elem` getUserGroupUuidsForCommenterPerm perms) currentUserGroupUuids) - , or (fmap (`elem` getUserGroupUuidsForEditorPerm perms) currentUserGroupUuids) - , or (fmap (`elem` getUserGroupUuidsForOwnerPerm perms) currentUserGroupUuids) - ] - then return True - else return False - -checkCommentPermissionToQtn :: QuestionnairePermC questionnairePerm => QuestionnaireVisibility -> QuestionnaireSharing -> [questionnairePerm] -> AppContextM () -checkCommentPermissionToQtn visibility sharing perms = do - result <- hasCommentPermissionToQtn visibility sharing perms - if result - then return () - else throwError . ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN "Comment Questionnaire" - -hasCommentPermissionToQtn :: QuestionnairePermC questionnairePerm => QuestionnaireVisibility -> QuestionnaireSharing -> [questionnairePerm] -> AppContextM Bool -hasCommentPermissionToQtn visibility sharing perms = - if sharing == AnyoneWithLinkCommentQuestionnaire || sharing == AnyoneWithLinkEditQuestionnaire - then return True - else do - checkPermission _QTN_PERM - currentUser <- getCurrentUser - userGroupMemberships <- findUserGroupMembershipsByUserUuid currentUser.uuid - let currentUserGroupUuids = fmap (.userGroupUuid) userGroupMemberships - if or - [ currentUser.uRole == _USER_ROLE_ADMIN - , -- Check visibility - visibility == VisibleCommentQuestionnaire - , visibility == VisibleEditQuestionnaire - , -- Check membership - currentUser.uuid `elem` getUserUuidsForCommenterPerm perms - , currentUser.uuid `elem` getUserUuidsForEditorPerm perms - , currentUser.uuid `elem` getUserUuidsForOwnerPerm perms - , -- Check groups - or (fmap (`elem` getUserGroupUuidsForCommenterPerm perms) currentUserGroupUuids) - , or (fmap (`elem` getUserGroupUuidsForEditorPerm perms) currentUserGroupUuids) - , or (fmap (`elem` getUserGroupUuidsForOwnerPerm perms) currentUserGroupUuids) - ] - then return True - else return False - -checkEditPermissionToQtn :: QuestionnairePermC questionnairePerm => QuestionnaireVisibility -> QuestionnaireSharing -> [questionnairePerm] -> AppContextM () -checkEditPermissionToQtn visibility sharing perms = do - result <- hasEditPermissionToQtn visibility sharing perms - if result - then return () - else throwError . ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN "Edit Questionnaire" - -hasEditPermissionToQtn :: QuestionnairePermC questionnairePerm => QuestionnaireVisibility -> QuestionnaireSharing -> [questionnairePerm] -> AppContextM Bool -hasEditPermissionToQtn visibility sharing perms = - if sharing == AnyoneWithLinkEditQuestionnaire - then return True - else do - checkPermission _QTN_PERM - currentUser <- getCurrentUser - userGroupMemberships <- findUserGroupMembershipsByUserUuid currentUser.uuid - let currentUserGroupUuids = fmap (.userGroupUuid) userGroupMemberships - if or - [ currentUser.uRole == _USER_ROLE_ADMIN - , -- Check visibility - visibility == VisibleEditQuestionnaire - , -- Check membership - currentUser.uuid `elem` getUserUuidsForEditorPerm perms - , currentUser.uuid `elem` getUserUuidsForOwnerPerm perms - , -- Check groups - or (fmap (`elem` getUserGroupUuidsForEditorPerm perms) currentUserGroupUuids) - , or (fmap (`elem` getUserGroupUuidsForOwnerPerm perms) currentUserGroupUuids) - ] - then return True - else return False - -checkOwnerPermissionToQtn :: QuestionnairePermC questionnairePerm => QuestionnaireVisibility -> [questionnairePerm] -> AppContextM () -checkOwnerPermissionToQtn visibility perms = do - result <- hasOwnerPermissionToQtn visibility perms - if result - then return () - else throwError . ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN "Administrate Questionnaire" - -hasOwnerPermissionToQtn :: QuestionnairePermC questionnairePerm => QuestionnaireVisibility -> [questionnairePerm] -> AppContextM Bool -hasOwnerPermissionToQtn visibility perms = do - checkPermission _QTN_PERM - currentUser <- getCurrentUser - userGroupMemberships <- findUserGroupMembershipsByUserUuid currentUser.uuid - let currentUserGroupUuids = fmap (.userGroupUuid) userGroupMemberships - if or - [ currentUser.uRole == _USER_ROLE_ADMIN - , -- Check membership - currentUser.uuid `elem` getUserUuidsForOwnerPerm perms - , -- Check groups - or (fmap (`elem` getUserGroupUuidsForOwnerPerm perms) currentUserGroupUuids) - ] - then return True - else return False - -checkMigrationPermissionToQtn :: QuestionnairePermC questionnairePerm => QuestionnaireVisibility -> [questionnairePerm] -> AppContextM () -checkMigrationPermissionToQtn visibility perms = do - result <- hasMigrationPermissionToQtn visibility perms - if result - then return () - else throwError . ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN "Migrate Questionnaire" - -hasMigrationPermissionToQtn :: QuestionnairePermC questionnairePerm => QuestionnaireVisibility -> [questionnairePerm] -> AppContextM Bool -hasMigrationPermissionToQtn visibility perms = do - currentUser <- getCurrentUser - userGroupMemberships <- findUserGroupMembershipsByUserUuid currentUser.uuid - let currentUserGroupUuids = fmap (.userGroupUuid) userGroupMemberships - if or - [ currentUser.uRole == _USER_ROLE_ADMIN - , -- Check visibility - visibility == VisibleEditQuestionnaire - , -- Check membership - currentUser.uuid `elem` getUserUuidsForEditorPerm perms - , currentUser.uuid `elem` getUserUuidsForOwnerPerm perms - , -- Check groups - or (fmap (`elem` getUserGroupUuidsForEditorPerm perms) currentUserGroupUuids) - , or (fmap (`elem` getUserGroupUuidsForOwnerPerm perms) currentUserGroupUuids) - ] - then return True - else return False diff --git a/wizard-server/src/Wizard/Service/Questionnaire/QuestionnaireAudit.hs b/wizard-server/src/Wizard/Service/Questionnaire/QuestionnaireAudit.hs deleted file mode 100644 index 37f142379..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/QuestionnaireAudit.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Wizard.Service.Questionnaire.QuestionnaireAudit where - -import qualified Data.UUID as U - -import Shared.Audit.Service.Audit.AuditService -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.ContextLenses () - -auditQuestionnaireListEvents :: U.UUID -> AppContextM () -auditQuestionnaireListEvents qtnUuid = logAudit "questionnaire" "listEvents" (U.toString qtnUuid) - -auditQuestionnaireDetailEvent :: U.UUID -> AppContextM () -auditQuestionnaireDetailEvent qtnUuid = logAudit "questionnaire" "detailEvent" (U.toString qtnUuid) diff --git a/wizard-server/src/Wizard/Service/Questionnaire/QuestionnaireCommandExecutor.hs b/wizard-server/src/Wizard/Service/Questionnaire/QuestionnaireCommandExecutor.hs deleted file mode 100644 index d942f29d5..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/QuestionnaireCommandExecutor.hs +++ /dev/null @@ -1,31 +0,0 @@ -module Wizard.Service.Questionnaire.QuestionnaireCommandExecutor where - -import Control.Monad.Except (throwError) -import Data.Aeson (eitherDecode) -import qualified Data.ByteString.Lazy.Char8 as BSL -import qualified Data.UUID as U - -import Shared.Common.Model.Error.Error -import Shared.Common.Util.Logger -import Shared.PersistentCommand.Model.PersistentCommand.PersistentCommand -import Wizard.Model.Context.AppContext -import Wizard.Service.Questionnaire.QuestionnaireService -import WizardLib.Public.Model.PersistentCommand.Questionnaire.CreateQuestionnaireCommand - -cComponent = "questionnaire" - -execute :: PersistentCommand U.UUID -> AppContextM (PersistentCommandState, Maybe String) -execute command - | command.function == cCreateQuestionnairesName = cCreateQuestionnaires command - | otherwise = throwError . GeneralServerError $ "Unknown command function: " <> command.function - -cCreateQuestionnairesName = "createQuestionnaires" - -cCreateQuestionnaires :: PersistentCommand U.UUID -> AppContextM (PersistentCommandState, Maybe String) -cCreateQuestionnaires persistentCommand = do - let eCommands = eitherDecode (BSL.pack persistentCommand.body) :: Either String [CreateQuestionnaireCommand] - case eCommands of - Right commands -> do - createQuestionnairesFromCommands commands - return (DonePersistentCommandState, Nothing) - Left error -> return (ErrorPersistentCommandState, Just $ f' "Problem in deserialization of JSON: %s" [error]) diff --git a/wizard-server/src/Wizard/Service/Questionnaire/QuestionnaireMapper.hs b/wizard-server/src/Wizard/Service/Questionnaire/QuestionnaireMapper.hs deleted file mode 100644 index a51b096f5..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/QuestionnaireMapper.hs +++ /dev/null @@ -1,371 +0,0 @@ -module Wizard.Service.Questionnaire.QuestionnaireMapper where - -import qualified Data.Map.Strict as M -import Data.Time -import qualified Data.UUID as U - -import Shared.DocumentTemplate.Api.Resource.DocumentTemplate.DocumentTemplateDTO -import Shared.DocumentTemplate.Constant.DocumentTemplate -import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplate -import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplateFormatSimple -import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel -import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackage -import qualified Shared.KnowledgeModel.Service.KnowledgeModel.Package.KnowledgeModelPackageMapper as SPM -import Wizard.Api.Resource.Questionnaire.QuestionnaireContentChangeDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireContentDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireCreateDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireCreateFromTemplateDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailQuestionnaireDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailWsDTO -import Wizard.Api.Resource.Questionnaire.QuestionnairePermChangeDTO -import Wizard.Api.Resource.Questionnaire.QuestionnairePermDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireReportDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireSettingsChangeDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireShareChangeDTO -import Wizard.Api.Resource.User.UserDTO -import Wizard.Constant.Acl -import Wizard.Model.DocumentTemplate.DocumentTemplateState -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireCommentList -import Wizard.Model.Questionnaire.QuestionnaireContent -import Wizard.Model.Questionnaire.QuestionnaireDetail -import Wizard.Model.Questionnaire.QuestionnaireDetailQuestionnaire -import Wizard.Model.Questionnaire.QuestionnaireEvent -import Wizard.Model.Questionnaire.QuestionnaireEventList -import Wizard.Model.Questionnaire.QuestionnaireList -import Wizard.Model.Questionnaire.QuestionnairePerm -import Wizard.Model.Questionnaire.QuestionnaireReply -import Wizard.Model.Questionnaire.QuestionnaireSimple -import Wizard.Model.Questionnaire.QuestionnaireState -import Wizard.Model.Questionnaire.QuestionnaireSuggestion -import Wizard.Model.Questionnaire.QuestionnaireVersionList -import Wizard.Model.Report.Report -import Wizard.Model.Tenant.Config.TenantConfig -import Wizard.Model.User.User -import Wizard.Service.Acl.AclMapper -import Wizard.Service.Questionnaire.Event.QuestionnaireEventMapper -import WizardLib.Public.Model.PersistentCommand.Questionnaire.CreateQuestionnaireCommand -import WizardLib.Public.Model.User.UserGroup - -toDTO :: Questionnaire -> KnowledgeModelPackage -> QuestionnaireState -> [QuestionnairePermDTO] -> QuestionnaireDTO -toDTO qtn kmPackage state permissions = - QuestionnaireDTO - { uuid = qtn.uuid - , name = qtn.name - , description = qtn.description - , visibility = qtn.visibility - , sharing = qtn.sharing - , state = state - , knowledgeModelPackage = SPM.toSimple kmPackage - , permissions = permissions - , isTemplate = qtn.isTemplate - , createdAt = qtn.createdAt - , updatedAt = qtn.updatedAt - } - -toDTO' :: QuestionnaireList -> QuestionnaireDTO -toDTO' qtn = - QuestionnaireDTO - { uuid = qtn.uuid - , name = qtn.name - , description = qtn.description - , visibility = qtn.visibility - , sharing = qtn.sharing - , state = qtn.state - , knowledgeModelPackage = qtn.knowledgeModelPackage - , permissions = qtn.permissions - , isTemplate = qtn.isTemplate - , createdAt = qtn.createdAt - , updatedAt = qtn.updatedAt - } - -toSimpleDTO :: Questionnaire -> KnowledgeModelPackage -> QuestionnaireState -> [QuestionnairePermDTO] -> QuestionnaireDTO -toSimpleDTO qtn kmPackage state permissions = - QuestionnaireDTO - { uuid = qtn.uuid - , name = qtn.name - , description = qtn.description - , visibility = qtn.visibility - , sharing = qtn.sharing - , state = state - , knowledgeModelPackage = SPM.toSimple kmPackage - , permissions = permissions - , isTemplate = qtn.isTemplate - , createdAt = qtn.createdAt - , updatedAt = qtn.updatedAt - } - -toDetailQuestionnaire :: Questionnaire -> Maybe U.UUID -> [QuestionnairePermDTO] -> Int -> Int -> QuestionnaireDetailQuestionnaire -toDetailQuestionnaire qtn migrationUuid permissions questionnaireActionsAvailable questionnaireImportersAvailable = - QuestionnaireDetailQuestionnaire - { uuid = qtn.uuid - , name = qtn.name - , visibility = qtn.visibility - , sharing = qtn.sharing - , knowledgeModelPackageId = qtn.knowledgeModelPackageId - , selectedQuestionTagUuids = qtn.selectedQuestionTagUuids - , isTemplate = qtn.isTemplate - , migrationUuid = migrationUuid - , permissions = permissions - , files = [] - , questionnaireActionsAvailable = questionnaireActionsAvailable - , questionnaireImportersAvailable = questionnaireImportersAvailable - } - -toDetailDTO :: QuestionnaireDetail -> QuestionnaireDetailDTO -toDetailDTO QuestionnaireDetail {..} = - QuestionnaireDetailDTO {..} - -toDetailQuestionnaireDTO :: QuestionnaireDetailQuestionnaire -> M.Map String (M.Map U.UUID Int) -> M.Map String (M.Map U.UUID Int) -> KnowledgeModel -> Maybe U.UUID -> M.Map String Reply -> M.Map String [U.UUID] -> QuestionnaireDetailQuestionnaireDTO -toDetailQuestionnaireDTO QuestionnaireDetailQuestionnaire {..} unresolvedCommentCounts resolvedCommentCounts knowledgeModel phaseUuid replies labels = - let fileCount = length files - in QuestionnaireDetailQuestionnaireDTO {..} - -toDetailWsDTO :: Questionnaire -> Maybe DocumentTemplateDTO -> Maybe DocumentTemplateFormatSimple -> [QuestionnairePermDTO] -> M.Map String [U.UUID] -> M.Map String (M.Map U.UUID Int) -> M.Map String (M.Map U.UUID Int) -> QuestionnaireDetailWsDTO -toDetailWsDTO qtn mTemplate mFormat qtnPerms labels unresolvedCommentCounts resolvedCommentCounts = - QuestionnaireDetailWsDTO - { name = qtn.name - , description = qtn.description - , visibility = qtn.visibility - , sharing = qtn.sharing - , projectTags = qtn.projectTags - , documentTemplateId = qtn.documentTemplateId - , documentTemplate = mTemplate - , formatUuid = qtn.formatUuid - , format = mFormat - , permissions = qtnPerms - , isTemplate = qtn.isTemplate - , labels = labels - , unresolvedCommentCounts = unresolvedCommentCounts - , resolvedCommentCounts = resolvedCommentCounts - } - -toContentDTO - :: QuestionnaireContent - -> M.Map String [QuestionnaireCommentThreadList] - -> [QuestionnaireEventList] - -> [QuestionnaireVersionList] - -> QuestionnaireContentDTO -toContentDTO qtnCtn threads events versions = - QuestionnaireContentDTO - { phaseUuid = qtnCtn.phaseUuid - , replies = qtnCtn.replies - , commentThreadsMap = threads - , labels = qtnCtn.labels - , events = events - , versions = versions - } - -toQuestionnaireReportDTO :: [Indication] -> QuestionnaireReportDTO -toQuestionnaireReportDTO indications = QuestionnaireReportDTO {indications = indications} - -toChangeDTO :: Questionnaire -> QuestionnaireShareChangeDTO -toChangeDTO qtn = - QuestionnaireShareChangeDTO - { visibility = qtn.visibility - , sharing = qtn.sharing - , permissions = fmap toQuestionnairePermChangeDTO qtn.permissions - } - -toUserQuestionnairePerm :: U.UUID -> U.UUID -> [String] -> U.UUID -> QuestionnairePerm -toUserQuestionnairePerm questionnaireUuid userUuid perms tenantUuid = - QuestionnairePerm - { questionnaireUuid = questionnaireUuid - , memberType = UserQuestionnairePermType - , memberUuid = userUuid - , perms = perms - , tenantUuid = tenantUuid - } - -toUserGroupQuestionnairePerm :: U.UUID -> U.UUID -> [String] -> U.UUID -> QuestionnairePerm -toUserGroupQuestionnairePerm questionnaireUuid userGroupUuid perms tenantUuid = - QuestionnairePerm - { questionnaireUuid = questionnaireUuid - , memberType = UserGroupQuestionnairePermType - , memberUuid = userGroupUuid - , perms = perms - , tenantUuid = tenantUuid - } - -toUserQuestionnairePermDTO :: QuestionnairePerm -> User -> QuestionnairePermDTO -toUserQuestionnairePermDTO qtnPerm user = - QuestionnairePermDTO - { questionnaireUuid = qtnPerm.questionnaireUuid - , member = toUserMemberDTO user - , perms = qtnPerm.perms - } - -toUserGroupQuestionnairePermDTO :: QuestionnairePerm -> UserGroup -> QuestionnairePermDTO -toUserGroupQuestionnairePermDTO qtnPerm userGroup = - QuestionnairePermDTO - { questionnaireUuid = qtnPerm.questionnaireUuid - , member = toUserGroupMemberDTO userGroup - , perms = qtnPerm.perms - } - -toQuestionnairePermChangeDTO :: QuestionnairePerm -> QuestionnairePermChangeDTO -toQuestionnairePermChangeDTO qtnPerm = - QuestionnairePermChangeDTO - { memberUuid = qtnPerm.memberUuid - , memberType = qtnPerm.memberType - , perms = qtnPerm.perms - } - -toSimple :: Questionnaire -> QuestionnaireSimple -toSimple qtn = QuestionnaireSimple {uuid = qtn.uuid, name = qtn.name} - -toSuggestion :: Questionnaire -> QuestionnaireSuggestion -toSuggestion qtn = QuestionnaireSuggestion {uuid = qtn.uuid, name = qtn.name, description = qtn.description} - -toCreateFromTemplateDTO :: Questionnaire -> QuestionnaireCreateFromTemplateDTO -toCreateFromTemplateDTO qtn = - QuestionnaireCreateFromTemplateDTO - { name = qtn.name - , questionnaireUuid = qtn.uuid - } - -toQuestionnaireDetailTemplateState :: Maybe DocumentTemplate -> Maybe DocumentTemplateState -toQuestionnaireDetailTemplateState = - fmap - ( \tml -> - if tml.metamodelVersion /= documentTemplateMetamodelVersion - then UnsupportedMetamodelVersionDocumentTemplateState - else DefaultDocumentTemplateState - ) - -fromShareChangeDTO :: Questionnaire -> QuestionnaireShareChangeDTO -> QuestionnaireVisibility -> QuestionnaireSharing -> UTCTime -> Questionnaire -fromShareChangeDTO qtn dto visibility sharing now = - Questionnaire - { uuid = qtn.uuid - , name = qtn.name - , description = qtn.description - , visibility = visibility - , sharing = sharing - , knowledgeModelPackageId = qtn.knowledgeModelPackageId - , selectedQuestionTagUuids = qtn.selectedQuestionTagUuids - , projectTags = qtn.projectTags - , documentTemplateId = qtn.documentTemplateId - , formatUuid = qtn.formatUuid - , creatorUuid = qtn.creatorUuid - , permissions = fmap (fromQuestionnairePermChangeDTO qtn.uuid qtn.tenantUuid) dto.permissions - , isTemplate = qtn.isTemplate - , squashed = qtn.squashed - , tenantUuid = qtn.tenantUuid - , createdAt = qtn.createdAt - , updatedAt = now - } - -fromSettingsChangeDTO :: Questionnaire -> QuestionnaireSettingsChangeDTO -> UserDTO -> UTCTime -> Questionnaire -fromSettingsChangeDTO qtn dto currentUser now = - Questionnaire - { uuid = qtn.uuid - , name = dto.name - , description = dto.description - , visibility = qtn.visibility - , sharing = qtn.sharing - , knowledgeModelPackageId = qtn.knowledgeModelPackageId - , selectedQuestionTagUuids = qtn.selectedQuestionTagUuids - , projectTags = dto.projectTags - , documentTemplateId = dto.documentTemplateId - , formatUuid = dto.formatUuid - , creatorUuid = qtn.creatorUuid - , permissions = qtn.permissions - , isTemplate = - if _QTN_TML_PERM `elem` currentUser.permissions - then dto.isTemplate - else qtn.isTemplate - , squashed = qtn.squashed - , tenantUuid = qtn.tenantUuid - , createdAt = qtn.createdAt - , updatedAt = now - } - -fromQuestionnaireCreateDTO - :: QuestionnaireCreateDTO - -> U.UUID - -> QuestionnaireVisibility - -> QuestionnaireSharing - -> Maybe U.UUID - -> String - -> U.UUID - -> Maybe U.UUID - -> U.UUID - -> UTCTime - -> (Questionnaire, [QuestionnaireEvent]) -fromQuestionnaireCreateDTO dto qtnUuid visibility sharing mCurrentUserUuid pkgId phaseEventUuid mPhase tenantUuid now = - ( Questionnaire - { uuid = qtnUuid - , name = dto.name - , description = Nothing - , visibility = visibility - , sharing = sharing - , knowledgeModelPackageId = pkgId - , selectedQuestionTagUuids = dto.questionTagUuids - , projectTags = [] - , documentTemplateId = dto.documentTemplateId - , formatUuid = dto.formatUuid - , creatorUuid = mCurrentUserUuid - , permissions = - case mCurrentUserUuid of - Just currentUserUuid -> [toUserQuestionnairePerm qtnUuid currentUserUuid ownerPermissions tenantUuid] - Nothing -> [] - , isTemplate = False - , squashed = True - , tenantUuid = tenantUuid - , createdAt = now - , updatedAt = now - } - , case mPhase of - Just phase -> - [ SetPhaseEvent' $ - SetPhaseEvent - { uuid = phaseEventUuid - , phaseUuid = Just phase - , questionnaireUuid = qtnUuid - , tenantUuid = tenantUuid - , createdBy = mCurrentUserUuid - , createdAt = now - } - ] - Nothing -> [] - ) - -fromContentChangeDTO :: Questionnaire -> [QuestionnaireEvent] -> QuestionnaireContentChangeDTO -> Maybe UserDTO -> UTCTime -> (Questionnaire, [QuestionnaireEvent]) -fromContentChangeDTO qtn events dto mCurrentUser now = - let newTodoEvents = fmap (\e -> fromEventChangeDTO e qtn.uuid qtn.tenantUuid (fmap (.uuid) mCurrentUser) now) dto.events - updatedEvents = events ++ newTodoEvents - in (qtn {updatedAt = now}, updatedEvents) - -fromQuestionnairePermChangeDTO :: U.UUID -> U.UUID -> QuestionnairePermChangeDTO -> QuestionnairePerm -fromQuestionnairePermChangeDTO qtnUuid tenantUuid dto = - QuestionnairePerm - { questionnaireUuid = qtnUuid - , memberType = dto.memberType - , memberUuid = dto.memberUuid - , perms = dto.perms - , tenantUuid = tenantUuid - } - -fromCreateQuestionnaireCommand :: CreateQuestionnaireCommand -> U.UUID -> [QuestionnairePerm] -> TenantConfigQuestionnaire -> U.UUID -> UTCTime -> Questionnaire -fromCreateQuestionnaireCommand command uuid permissions tcQuestionnaire createdBy now = do - Questionnaire - { uuid = uuid - , name = command.name - , description = Nothing - , visibility = tcQuestionnaire.questionnaireVisibility.defaultValue - , sharing = tcQuestionnaire.questionnaireSharing.defaultValue - , knowledgeModelPackageId = command.knowledgeModelPackageId - , selectedQuestionTagUuids = [] - , projectTags = [] - , documentTemplateId = command.documentTemplateId - , formatUuid = Nothing - , creatorUuid = Just createdBy - , permissions = permissions - , isTemplate = False - , squashed = True - , tenantUuid = tcQuestionnaire.tenantUuid - , createdAt = now - , updatedAt = now - } diff --git a/wizard-server/src/Wizard/Service/Questionnaire/QuestionnaireService.hs b/wizard-server/src/Wizard/Service/Questionnaire/QuestionnaireService.hs deleted file mode 100644 index 9f590aace..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/QuestionnaireService.hs +++ /dev/null @@ -1,454 +0,0 @@ -module Wizard.Service.Questionnaire.QuestionnaireService where - -import Control.Monad (void, when) -import Control.Monad.Except (catchError, throwError) -import Control.Monad.Reader (asks, liftIO) -import Data.Foldable (traverse_) -import qualified Data.List as L -import qualified Data.Map.Strict as M -import Data.Time -import qualified Data.UUID as U - -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Common.Lens -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.Pageable -import Shared.Common.Model.Common.Sort -import Shared.Common.Model.Error.Error -import Shared.Common.Util.List -import Shared.Common.Util.Logger -import Shared.Common.Util.Uuid -import Shared.DocumentTemplate.Database.DAO.DocumentTemplate.DocumentTemplateDAO -import Shared.DocumentTemplate.Database.DAO.DocumentTemplate.DocumentTemplateFormatDAO -import qualified Shared.DocumentTemplate.Service.DocumentTemplate.DocumentTemplateMapper as STM -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel -import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackage -import Shared.KnowledgeModel.Service.KnowledgeModel.Package.KnowledgeModelPackageUtil -import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSimpleDTO -import Wizard.Api.Resource.Questionnaire.Event.QuestionnaireEventDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireContentChangeDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireCreateDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireCreateFromTemplateDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailQuestionnaireDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireSettingsChangeDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireShareChangeDTO -import Wizard.Api.Resource.User.UserDTO -import Wizard.Database.DAO.Common -import Wizard.Database.DAO.Document.DocumentDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireCommentThreadDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireEventDAO -import Wizard.Database.DAO.User.UserDAO -import Wizard.Localization.Messages.Internal -import Wizard.Model.Context.AclContext -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.AppContextHelpers -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireAclHelpers -import Wizard.Model.Questionnaire.QuestionnaireContent -import Wizard.Model.Questionnaire.QuestionnaireDetail -import Wizard.Model.Questionnaire.QuestionnaireDetailPreview -import Wizard.Model.Questionnaire.QuestionnaireDetailQuestionnaire -import Wizard.Model.Questionnaire.QuestionnaireDetailSettings -import Wizard.Model.Questionnaire.QuestionnaireEventList -import Wizard.Model.Questionnaire.QuestionnaireFile -import Wizard.Model.Questionnaire.QuestionnairePerm -import Wizard.Model.Questionnaire.QuestionnaireReply -import Wizard.Model.Tenant.Config.TenantConfig -import Wizard.Service.KnowledgeModel.KnowledgeModelService -import Wizard.Service.KnowledgeModel.Package.KnowledgeModelPackageService -import Wizard.Service.Mail.Mailer -import Wizard.Service.Questionnaire.Collaboration.CollaborationService -import Wizard.Service.Questionnaire.Comment.QuestionnaireCommentService -import Wizard.Service.Questionnaire.Compiler.CompilerService -import Wizard.Service.Questionnaire.Event.QuestionnaireEventMapper -import Wizard.Service.Questionnaire.File.QuestionnaireFileService -import Wizard.Service.Questionnaire.QuestionnaireAcl -import Wizard.Service.Questionnaire.QuestionnaireAudit -import Wizard.Service.Questionnaire.QuestionnaireMapper -import Wizard.Service.Questionnaire.QuestionnaireUtil -import Wizard.Service.Questionnaire.QuestionnaireValidation -import Wizard.Service.Questionnaire.Version.QuestionnaireVersionService -import Wizard.Service.Tenant.Config.ConfigService -import Wizard.Service.Tenant.Limit.LimitService -import WizardLib.Public.Model.PersistentCommand.Questionnaire.CreateQuestionnaireCommand - -getQuestionnairesForCurrentUserPageDto - :: Maybe String - -> Maybe Bool - -> Maybe Bool - -> Maybe [String] - -> Maybe String - -> Maybe [String] - -> Maybe String - -> Maybe [String] - -> Maybe String - -> Pageable - -> [Sort] - -> AppContextM (Page QuestionnaireDTO) -getQuestionnairesForCurrentUserPageDto mQuery mIsTemplate mIsMigrating mProjectTags mProjectTagsOp mUserUuids mUserUuidsOp mKnowledgeModelPackageIds mKnowledgeModelPackageIdsOp pageable sort = do - checkPermission _QTN_PERM - currentUser <- getCurrentUser - qtnPage <- - findQuestionnairesForCurrentUserPage - mQuery - mIsTemplate - mIsMigrating - mProjectTags - mProjectTagsOp - mUserUuids - mUserUuidsOp - mKnowledgeModelPackageIds - mKnowledgeModelPackageIdsOp - pageable - sort - return . fmap toDTO' $ qtnPage - -createQuestionnaire :: QuestionnaireCreateDTO -> AppContextM QuestionnaireDTO -createQuestionnaire questionnaireCreateDto = - liftIO generateUuid >>= createQuestionnaireWithGivenUuid questionnaireCreateDto - -createQuestionnaireWithGivenUuid :: QuestionnaireCreateDTO -> U.UUID -> AppContextM QuestionnaireDTO -createQuestionnaireWithGivenUuid reqDto qtnUuid = - runInTransaction $ do - checkQuestionnaireLimit - checkCreatePermissionToQtn - pkgId <- resolvePackageId reqDto.knowledgeModelPackageId - pkg <- findPackageById pkgId - qtnState <- getQuestionnaireState qtnUuid pkgId - now <- liftIO getCurrentTime - tenantUuid <- asks currentTenantUuid - visibility <- extractVisibility reqDto - sharing <- extractSharing reqDto - mCurrentUser <- asks currentUser - knowledgeModel <- compileKnowledgeModel [] (Just pkgId) reqDto.questionTagUuids - phaseEventUuid <- liftIO generateUuid - let (qtn, qtnEvents) = - fromQuestionnaireCreateDTO - reqDto - qtnUuid - visibility - sharing - (fmap (.uuid) mCurrentUser) - pkgId - phaseEventUuid - (headSafe knowledgeModel.phaseUuids) - tenantUuid - now - insertQuestionnaire qtn - insertQuestionnaireEvents qtnEvents - permissionDtos <- traverse enhanceQuestionnairePerm qtn.permissions - return $ toSimpleDTO qtn pkg qtnState permissionDtos - -createQuestionnaireFromTemplate :: QuestionnaireCreateFromTemplateDTO -> AppContextM QuestionnaireDTO -createQuestionnaireFromTemplate reqDto = - runInTransaction $ do - checkQuestionnaireLimit - originQtn <- findQuestionnaireByUuid reqDto.questionnaireUuid - checkCreateFromTemplatePermissionToQtn originQtn.isTemplate - pkg <- findPackageById originQtn.knowledgeModelPackageId - newQtnUuid <- liftIO generateUuid - currentUser <- getCurrentUser - now <- liftIO getCurrentTime - tcQuestionnaire <- getCurrentTenantConfigQuestionnaire - originQtnEvents <- findQuestionnaireEventListsByQuestionnaireUuid reqDto.questionnaireUuid - let newVisibility = tcQuestionnaire.questionnaireVisibility.defaultValue - let newSharing = tcQuestionnaire.questionnaireSharing.defaultValue - let newPermissions = [toUserQuestionnairePerm newQtnUuid currentUser.uuid ownerPermissions tcQuestionnaire.tenantUuid] - let newQtn = - originQtn - { uuid = newQtnUuid - , name = reqDto.name - , description = Nothing - , sharing = newSharing - , visibility = newVisibility - , permissions = newPermissions - , isTemplate = False - , creatorUuid = Just $ currentUser.uuid - , createdAt = now - , updatedAt = now - } - :: Questionnaire - insertQuestionnaire newQtn - clonedFiles <- cloneQuestionnaireFiles originQtn.uuid newQtn.uuid - newQtnEventsWithOldEventUuid <- cloneQuestionnaireEventsWithOldEventUuid originQtnEvents - let newQtnEvents = fmap snd newQtnEventsWithOldEventUuid - let newQtnEventsWithReplacedFiles = replaceQuestionnaireEventsWithNewFiles clonedFiles newQtnEvents - insertQuestionnaireEvents (fmap (toEvent newQtnUuid newQtn.tenantUuid) newQtnEventsWithReplacedFiles) - duplicateCommentThreads reqDto.questionnaireUuid newQtnUuid - cloneQuestionnaireVersions originQtn.uuid newQtn.uuid newQtnEventsWithOldEventUuid - state <- getQuestionnaireState newQtnUuid pkg.pId - permissionDtos <- traverse enhanceQuestionnairePerm newQtn.permissions - return $ toSimpleDTO newQtn pkg state permissionDtos - -cloneQuestionnaire :: U.UUID -> AppContextM QuestionnaireDTO -cloneQuestionnaire cloneUuid = - runInTransaction $ do - checkQuestionnaireLimit - originQtn <- findQuestionnaireByUuid cloneUuid - checkClonePermissionToQtn originQtn.visibility originQtn.sharing originQtn.permissions - pkg <- findPackageById originQtn.knowledgeModelPackageId - newQtnUuid <- liftIO generateUuid - currentUser <- getCurrentUser - now <- liftIO getCurrentTime - originQtnEvents <- findQuestionnaireEventListsByQuestionnaireUuid originQtn.uuid - let ownerPerm = toUserQuestionnairePerm newQtnUuid currentUser.uuid ownerPermissions originQtn.tenantUuid - let newPermissions = ownerPerm : removeUserPermission currentUser.uuid originQtn.permissions - let newDuplicatedPermissions = fmap (\permission -> permission {questionnaireUuid = newQtnUuid} :: QuestionnairePerm) newPermissions - let newQtn = - originQtn - { uuid = newQtnUuid - , name = "Copy of " ++ originQtn.name - , permissions = newDuplicatedPermissions - , updatedAt = now - } - :: Questionnaire - insertQuestionnaire newQtn - clonedFiles <- cloneQuestionnaireFiles originQtn.uuid newQtn.uuid - newQtnEventsWithOldEventUuid <- cloneQuestionnaireEventsWithOldEventUuid originQtnEvents - let newQtnEvents = fmap snd newQtnEventsWithOldEventUuid - let newQtnEventsWithReplacedFiles = replaceQuestionnaireEventsWithNewFiles clonedFiles newQtnEvents - insertQuestionnaireEvents (fmap (toEvent newQtnUuid newQtn.tenantUuid) newQtnEventsWithReplacedFiles) - cloneQuestionnaireVersions originQtn.uuid newQtn.uuid newQtnEventsWithOldEventUuid - duplicateCommentThreads cloneUuid newQtnUuid - state <- getQuestionnaireState newQtnUuid pkg.pId - permissionDtos <- traverse enhanceQuestionnairePerm newQtn.permissions - return $ toSimpleDTO newQtn pkg state permissionDtos - -createQuestionnairesFromCommands :: [CreateQuestionnaireCommand] -> AppContextM () -createQuestionnairesFromCommands = runInTransaction . traverse_ create - where - create :: CreateQuestionnaireCommand -> AppContextM () - create command = do - uuid <- liftIO generateUuid - currentUser <- getCurrentUser - now <- liftIO getCurrentTime - tcQuestionnaire <- getCurrentTenantConfigQuestionnaire - users <- findUsersByEmails command.emails - let permissions = fmap (createPermission uuid) users - let questionnaire = fromCreateQuestionnaireCommand command uuid permissions tcQuestionnaire currentUser.uuid now - insertQuestionnaire questionnaire - return () - createPermission :: U.UUID -> User -> QuestionnairePerm - createPermission questionnaireUuid user = toUserQuestionnairePerm questionnaireUuid user.uuid ownerPermissions user.tenantUuid - -getQuestionnaireById :: U.UUID -> AppContextM QuestionnaireDTO -getQuestionnaireById qtnUuid = do - mQtn <- getQuestionnaireById' qtnUuid - case mQtn of - Just qtn -> return qtn - Nothing -> throwError $ NotExistsError $ _ERROR_DATABASE__ENTITY_NOT_FOUND "questionnaire" [("uuid", U.toString qtnUuid)] - -getQuestionnaireById' :: U.UUID -> AppContextM (Maybe QuestionnaireDTO) -getQuestionnaireById' qtnUuid = do - mQtn <- findQuestionnaireByUuid' qtnUuid - case mQtn of - Just qtn -> do - checkViewPermissionToQtn qtn.visibility qtn.sharing qtn.permissions - package <- getPackageById qtn.knowledgeModelPackageId - state <- getQuestionnaireState qtnUuid package.pId - permissionDtos <- traverse enhanceQuestionnairePerm qtn.permissions - return . Just $ toDTO qtn package state permissionDtos - Nothing -> return Nothing - -getQuestionnaireDetailByUuid :: U.UUID -> AppContextM QuestionnaireDetailDTO -getQuestionnaireDetailByUuid qtnUuid = do - qtn <- findQuestionnaireDetail qtnUuid - checkViewPermissionToQtn qtn.visibility qtn.sharing qtn.permissions - return $ toDetailDTO qtn - -getQuestionnaireDetailQuestionnaireByUuid :: U.UUID -> AppContextM QuestionnaireDetailQuestionnaireDTO -getQuestionnaireDetailQuestionnaireByUuid qtnUuid = do - qtn <- findQuestionnaireDetailQuestionnaire qtnUuid - qtnEvents <- findQuestionnaireEventListsByQuestionnaireUuid qtnUuid - checkViewPermissionToQtn qtn.visibility qtn.sharing qtn.permissions - editor <- catchError (hasEditPermissionToQtn qtn.visibility qtn.sharing qtn.permissions) (\_ -> return False) - commenter <- catchError (hasCommentPermissionToQtn qtn.visibility qtn.sharing qtn.permissions) (\_ -> return False) - unresolvedCommentCounts <- - if commenter - then findQuestionnaireCommentThreadsSimple qtnUuid False editor - else return M.empty - resolvedCommentCounts <- - if commenter - then findQuestionnaireCommentThreadsSimple qtnUuid True editor - else return M.empty - knowledgeModel <- compileKnowledgeModel [] (Just qtn.knowledgeModelPackageId) qtn.selectedQuestionTagUuids - let qtnCtn = compileQuestionnaire qtnEvents - let labels = - if editor - then qtnCtn.labels - else M.empty - return $ toDetailQuestionnaireDTO qtn unresolvedCommentCounts resolvedCommentCounts knowledgeModel qtnCtn.phaseUuid qtnCtn.replies labels - -getQuestionnaireDetailPreviewById :: U.UUID -> AppContextM QuestionnaireDetailPreview -getQuestionnaireDetailPreviewById qtnUuid = do - qtn <- findQuestionnaireDetailPreview qtnUuid - checkViewPermissionToQtn qtn.visibility qtn.sharing qtn.permissions - return qtn - -getQuestionnaireDetailSettingsById :: U.UUID -> AppContextM QuestionnaireDetailSettings -getQuestionnaireDetailSettingsById qtnUuid = do - qtn <- findQuestionnaireDetailSettings qtnUuid - checkViewPermissionToQtn qtn.visibility qtn.sharing qtn.permissions - knowledgeModel <- compileKnowledgeModel [] (Just qtn.knowledgeModelPackage.pId) qtn.selectedQuestionTagUuids - return $ qtn {knowledgeModelTags = M.elems knowledgeModel.entities.tags} - -getQuestionnaireEventsPage :: U.UUID -> Pageable -> [Sort] -> AppContextM (Page QuestionnaireEventList) -getQuestionnaireEventsPage qtnUuid pageable sort = do - qtn <- findQuestionnaireByUuid qtnUuid - events <- findQuestionnaireEventsPage qtnUuid pageable sort - checkViewPermissionToQtn qtn.visibility qtn.sharing qtn.permissions - auditQuestionnaireListEvents qtnUuid - return events - -getQuestionnaireEventForQtnUuid :: U.UUID -> U.UUID -> AppContextM QuestionnaireEventDTO -getQuestionnaireEventForQtnUuid qtnUuid eventUuid = do - qtn <- findQuestionnaireByUuid qtnUuid - checkViewPermissionToQtn qtn.visibility qtn.sharing qtn.permissions - auditQuestionnaireDetailEvent qtnUuid - event <- findQuestionnaireEventByUuid eventUuid - mUser <- - case getCreatedBy event of - Just userUuid -> findUserByUuid' userUuid - Nothing -> return Nothing - return $ toEventDTO event mUser - -modifyQuestionnaireShare :: U.UUID -> QuestionnaireShareChangeDTO -> AppContextM QuestionnaireShareChangeDTO -modifyQuestionnaireShare qtnUuid reqDto = - runInTransaction $ do - checkPermission _QTN_PERM - qtn <- findQuestionnaireByUuid qtnUuid - skipIfAssigningProject qtn (checkOwnerPermissionToQtn qtn.visibility qtn.permissions) - now <- liftIO getCurrentTime - qVisibility <- extractVisibility reqDto - qSharing <- extractSharing reqDto - let updatedQtn = fromShareChangeDTO qtn reqDto qVisibility qSharing now - updateQuestionnaireByUuid updatedQtn - updatePermsForOnlineUsers qtnUuid updatedQtn.visibility updatedQtn.sharing updatedQtn.permissions - permissionDtos <- traverse enhanceQuestionnairePerm updatedQtn.permissions - skipIfAssigningProject - qtn - ( catchError - (sendQuestionnaireInvitationMail qtn updatedQtn) - (\errMessage -> throwError $ GeneralServerError _ERROR_SERVICE_QTN__INVITATION_EMAIL_NOT_SENT) - ) - mTemplate <- - case updatedQtn.documentTemplateId of - Just tId -> do - tml <- findDocumentTemplateById tId - formats <- findDocumentTemplateFormats tId - return . Just $ STM.toDTO tml formats - _ -> return Nothing - mFormat <- - case (updatedQtn.documentTemplateId, updatedQtn.formatUuid) of - (Just dtId, Just formatUuid) -> do - format <- findDocumentTemplateFormatByDocumentTemplateIdAndUuid dtId formatUuid - return $ Just format - _ -> return Nothing - qtnEvents <- findQuestionnaireEventListsByQuestionnaireUuid qtnUuid - let qtnCtn = compileQuestionnaire qtnEvents - unresolvedCommentCounts <- findQuestionnaireCommentThreadsSimple qtnUuid False True - resolvedCommentCounts <- findQuestionnaireCommentThreadsSimple qtnUuid True True - let restWsDto = toDetailWsDTO updatedQtn mTemplate mFormat permissionDtos qtnCtn.labels unresolvedCommentCounts resolvedCommentCounts - setQuestionnaire qtnUuid restWsDto - return reqDto - -modifyQuestionnaireSettings :: U.UUID -> QuestionnaireSettingsChangeDTO -> AppContextM QuestionnaireSettingsChangeDTO -modifyQuestionnaireSettings qtnUuid reqDto = - runInTransaction $ do - checkPermission _QTN_PERM - validateQuestionnaireSettingsChangeDTO reqDto - qtn <- findQuestionnaireByUuid qtnUuid - skipIfAssigningProject qtn (checkOwnerPermissionToQtn qtn.visibility qtn.permissions) - currentUser <- getCurrentUser - now <- liftIO getCurrentTime - let updatedQtn = fromSettingsChangeDTO qtn reqDto currentUser now - updateQuestionnaireByUuid updatedQtn - permissionDtos <- traverse enhanceQuestionnairePerm updatedQtn.permissions - deleteTemporalDocumentsByQuestionnaireUuid qtn.uuid - mTemplate <- - case updatedQtn.documentTemplateId of - Just tId -> do - tml <- findDocumentTemplateById tId - formats <- findDocumentTemplateFormats tId - return . Just $ STM.toDTO tml formats - _ -> return Nothing - mFormat <- - case (updatedQtn.documentTemplateId, updatedQtn.formatUuid) of - (Just dtId, Just formatUuid) -> do - format <- findDocumentTemplateFormatByDocumentTemplateIdAndUuid dtId formatUuid - return $ Just format - _ -> return Nothing - qtnEvents <- findQuestionnaireEventListsByQuestionnaireUuid qtnUuid - let qtnCtn = compileQuestionnaire qtnEvents - unresolvedCommentCounts <- findQuestionnaireCommentThreadsSimple qtnUuid False True - resolvedCommentCounts <- findQuestionnaireCommentThreadsSimple qtnUuid True True - let restWsDto = toDetailWsDTO updatedQtn mTemplate mFormat permissionDtos qtnCtn.labels unresolvedCommentCounts resolvedCommentCounts - setQuestionnaire qtnUuid restWsDto - return reqDto - -deleteQuestionnaire :: U.UUID -> Bool -> AppContextM () -deleteQuestionnaire qtnUuid shouldValidatePermission = - runInTransaction $ do - qtn <- findQuestionnaireByUuid qtnUuid - validateQuestionnaireDeletion qtnUuid - when shouldValidatePermission (checkOwnerPermissionToQtn qtn.visibility qtn.permissions) - deleteQuestionnaireByUuid qtnUuid - void $ logOutOnlineUsersWhenQtnDramaticallyChanged qtnUuid - -modifyContent :: U.UUID -> QuestionnaireContentChangeDTO -> AppContextM QuestionnaireContentChangeDTO -modifyContent qtnUuid reqDto = - runInTransaction $ do - qtn <- findQuestionnaireByUuid qtnUuid - checkEditPermissionToQtn qtn.visibility qtn.sharing qtn.permissions - mCurrentUser <- asks currentUser - now <- liftIO getCurrentTime - qtnEvents <- findQuestionnaireEventsByQuestionnaireUuid qtnUuid - let (updatedQtn, updatedQtnEvents) = fromContentChangeDTO qtn qtnEvents reqDto mCurrentUser now - syncQuestionnaireEventsWithDb qtnEvents updatedQtnEvents - updateQuestionnaireSquashedAndUpdatedAtByUuid qtnUuid False now - return reqDto - -cleanQuestionnaires :: AppContextM () -cleanQuestionnaires = - runInTransaction $ do - qtns <- findQuestionnaireWithZeroAcl - traverse_ - ( \qtn -> do - logInfoI _CMP_SERVICE (f' "Clean questionnaire with empty ACL (qtnUuid: '%s')" [U.toString qtn.uuid]) - deleteQuestionnaire qtn.uuid False - ) - qtns - -cloneQuestionnaireEvents :: [QuestionnaireEventList] -> AppContextM [QuestionnaireEventList] -cloneQuestionnaireEvents oldEvents = do - newEvents <- cloneQuestionnaireEventsWithOldEventUuid oldEvents - return $ fmap snd newEvents - -cloneQuestionnaireEventsWithOldEventUuid :: [QuestionnaireEventList] -> AppContextM [(U.UUID, QuestionnaireEventList)] -cloneQuestionnaireEventsWithOldEventUuid = - traverse - ( \event -> do - newEventUuid <- liftIO generateUuid - return (getUuid event, setUuid event newEventUuid) - ) - -replaceQuestionnaireEventsWithNewFiles :: [(QuestionnaireFile, QuestionnaireFile)] -> [QuestionnaireEventList] -> [QuestionnaireEventList] -replaceQuestionnaireEventsWithNewFiles clonedFiles qtnEvents = - let findFile :: U.UUID -> Maybe (QuestionnaireFile, QuestionnaireFile) - findFile fileUuid = L.find (\(oldFile, newFile) -> oldFile.uuid == fileUuid) clonedFiles - replaceEvent :: QuestionnaireEventList -> QuestionnaireEventList - replaceEvent (SetReplyEventList' 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 SetReplyEventList' (event {value = value'}) - replaceEvent event' = event' - in fmap replaceEvent qtnEvents diff --git a/wizard-server/src/Wizard/Service/Questionnaire/QuestionnaireUtil.hs b/wizard-server/src/Wizard/Service/Questionnaire/QuestionnaireUtil.hs deleted file mode 100644 index 0b9e58c42..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/QuestionnaireUtil.hs +++ /dev/null @@ -1,60 +0,0 @@ -module Wizard.Service.Questionnaire.QuestionnaireUtil where - -import Control.Monad (when) -import qualified Data.UUID as U - -import Wizard.Api.Resource.Questionnaire.QuestionnairePermDTO -import Wizard.Database.DAO.Questionnaire.MigratorDAO -import Wizard.Database.DAO.User.UserDAO -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireEventLenses () -import Wizard.Model.Questionnaire.QuestionnairePerm -import Wizard.Model.Questionnaire.QuestionnaireState -import Wizard.Model.Tenant.Config.TenantConfig -import Wizard.Service.KnowledgeModel.Package.KnowledgeModelPackageService -import Wizard.Service.Questionnaire.QuestionnaireMapper -import Wizard.Service.Tenant.Config.ConfigService -import WizardLib.Public.Database.DAO.User.UserGroupDAO - -extractVisibility dto = do - tcQuestionnaire <- getCurrentTenantConfigQuestionnaire - if tcQuestionnaire.questionnaireVisibility.enabled - then return dto.visibility - else return $ tcQuestionnaire.questionnaireVisibility.defaultValue - -extractSharing dto = do - tcQuestionnaire <- getCurrentTenantConfigQuestionnaire - if tcQuestionnaire.questionnaireSharing.enabled - then return dto.sharing - else return $ tcQuestionnaire.questionnaireSharing.defaultValue - -enhanceQuestionnairePerm :: QuestionnairePerm -> AppContextM QuestionnairePermDTO -enhanceQuestionnairePerm qtnPerm = - case qtnPerm.memberType of - UserQuestionnairePermType -> do - user <- findUserByUuid qtnPerm.memberUuid - return $ toUserQuestionnairePermDTO qtnPerm user - UserGroupQuestionnairePermType -> do - userGroup <- findUserGroupByUuid qtnPerm.memberUuid - return $ toUserGroupQuestionnairePermDTO qtnPerm userGroup - -getQuestionnaireState :: U.UUID -> String -> AppContextM QuestionnaireState -getQuestionnaireState qtnUuid pkgId = do - mMs <- findMigratorStateByNewQuestionnaireUuid' qtnUuid - case mMs of - Just _ -> return QSMigrating - Nothing -> do - pkgs <- getNewerPackages pkgId True - if null pkgs - then return QSDefault - else return QSOutdated - -skipIfAssigningProject :: Questionnaire -> AppContextM () -> AppContextM () -skipIfAssigningProject qtn action = do - tcQuestionnaire <- getCurrentTenantConfigQuestionnaire - let questionnaireSharingEnabled = tcQuestionnaire.questionnaireSharing.enabled - let questionnaireSharingAnonymousEnabled = tcQuestionnaire.questionnaireSharing.anonymousEnabled - when - (not (questionnaireSharingEnabled && questionnaireSharingAnonymousEnabled) || (not . null $ qtn.permissions)) - action diff --git a/wizard-server/src/Wizard/Service/Questionnaire/QuestionnaireValidation.hs b/wizard-server/src/Wizard/Service/Questionnaire/QuestionnaireValidation.hs deleted file mode 100644 index 4c7d8afc4..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/QuestionnaireValidation.hs +++ /dev/null @@ -1,39 +0,0 @@ -module Wizard.Service.Questionnaire.QuestionnaireValidation where - -import Control.Monad.Except (throwError) -import Data.Foldable (forM_, traverse_) -import qualified Data.Map.Strict as M -import qualified Data.UUID as U -import Text.Regex.TDFA - -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Wizard.Api.Resource.Questionnaire.QuestionnaireSettingsChangeDTO -import Wizard.Database.DAO.Questionnaire.MigratorDAO -import Wizard.Localization.Messages.Public -import Wizard.Model.Context.AppContext - -validateQuestionnaireSettingsChangeDTO :: QuestionnaireSettingsChangeDTO -> AppContextM () -validateQuestionnaireSettingsChangeDTO reqDto = validateQuestionnaireTags reqDto.projectTags - -validateQuestionnaireDeletion :: U.UUID -> AppContextM () -validateQuestionnaireDeletion = validateUsageByQtnMigration - -validateUsageByQtnMigration :: U.UUID -> AppContextM () -validateUsageByQtnMigration qtnUuid = do - result <- findMigratorStatesByOldQuestionnaireUuid qtnUuid - case result of - [] -> return () - _ -> throwError . UserError $ _ERROR_SERVICE_QTN__QTN_CANT_BE_DELETED_BECAUSE_IT_IS_USED_IN_MIGRATION - -validateQuestionnaireTags :: [String] -> AppContextM () -validateQuestionnaireTags = traverse_ validateQuestionnaireTag - -validateQuestionnaireTag :: String -> AppContextM () -validateQuestionnaireTag tag = forM_ (isValidProjectTag tag) throwError - -isValidProjectTag :: String -> Maybe AppError -isValidProjectTag tag = - if tag =~ "^[^,]+$" - then Nothing - else Just $ ValidationError [] (M.singleton "tags" [_ERROR_VALIDATION__FORBIDDEN_CHARACTERS tag]) diff --git a/wizard-server/src/Wizard/Service/Questionnaire/User/QuestionnaireUserService.hs b/wizard-server/src/Wizard/Service/Questionnaire/User/QuestionnaireUserService.hs deleted file mode 100644 index 2658e652d..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/User/QuestionnaireUserService.hs +++ /dev/null @@ -1,29 +0,0 @@ -module Wizard.Service.Questionnaire.User.QuestionnaireUserService where - -import qualified Data.UUID as U - -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.Pageable -import Shared.Common.Model.Common.Sort -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireUserDAO -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Service.Questionnaire.QuestionnaireAcl -import Wizard.Service.User.UserMapper -import Wizard.Service.User.UserService -import WizardLib.Public.Model.User.UserSuggestion - -getQuestionnaireUserSuggestionsPage :: U.UUID -> Maybe String -> Maybe Bool -> Pageable -> [Sort] -> AppContextM (Page UserSuggestion) -getQuestionnaireUserSuggestionsPage qtnUuid mQuery mEditor pageable sort = do - qtn <- findQuestionnaireByUuid qtnUuid - checkCommentPermissionToQtn qtn.visibility qtn.sharing qtn.permissions - if qtn.visibility == VisibleCommentQuestionnaire || qtn.visibility == VisibleEditQuestionnaire || qtn.sharing == AnyoneWithLinkCommentQuestionnaire || qtn.sharing == AnyoneWithLinkEditQuestionnaire - then getUserSuggestionsPage mQuery Nothing Nothing pageable sort - else do - let perm = - case mEditor of - Just True -> "EDIT" - _ -> "COMMENT" - suggestionPage <- findQuestionnaireUserSuggestionsPage qtnUuid perm mQuery pageable sort - return . fmap toSuggestion $ suggestionPage diff --git a/wizard-server/src/Wizard/Service/Questionnaire/Version/QuestionnaireVersionMapper.hs b/wizard-server/src/Wizard/Service/Questionnaire/Version/QuestionnaireVersionMapper.hs deleted file mode 100644 index ef8e9e073..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/Version/QuestionnaireVersionMapper.hs +++ /dev/null @@ -1,68 +0,0 @@ -module Wizard.Service.Questionnaire.Version.QuestionnaireVersionMapper where - -import Data.Time -import qualified Data.UUID as U - -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionChangeDTO -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionRevertDTO -import Wizard.Api.Resource.User.UserDTO -import Wizard.Model.Questionnaire.QuestionnaireVersion -import Wizard.Model.Questionnaire.QuestionnaireVersionList -import qualified Wizard.Service.User.UserMapper as UM - -toVersionList :: QuestionnaireVersion -> Maybe UserDTO -> QuestionnaireVersionList -toVersionList version createdBy = - QuestionnaireVersionList - { uuid = version.uuid - , name = version.name - , description = version.description - , eventUuid = version.eventUuid - , createdBy = fmap UM.toSuggestion' createdBy - , createdAt = version.createdAt - , updatedAt = version.updatedAt - } - --- --------------------------------------------------------------------------------------------------------------------- --- --------------------------------------------------------------------------------------------------------------------- -toVersionChangeDTO :: QuestionnaireVersion -> QuestionnaireVersionChangeDTO -toVersionChangeDTO version = - QuestionnaireVersionChangeDTO - { name = version.name - , description = version.description - , eventUuid = version.eventUuid - } - --- --------------------------------------------------------------------------------------------------------------------- --- --------------------------------------------------------------------------------------------------------------------- -toVersionRevertDTO :: U.UUID -> QuestionnaireVersionRevertDTO -toVersionRevertDTO eventUuid = QuestionnaireVersionRevertDTO {eventUuid = eventUuid} - --- --------------------------------------------------------------------------------------------------------------------- --- --------------------------------------------------------------------------------------------------------------------- -fromVersionChangeDTO :: QuestionnaireVersionChangeDTO -> U.UUID -> U.UUID -> U.UUID -> U.UUID -> UTCTime -> QuestionnaireVersion -fromVersionChangeDTO reqDto uuid questionnaireUuid tenantUuid createdBy now = - QuestionnaireVersion - { uuid = uuid - , name = reqDto.name - , description = reqDto.description - , eventUuid = reqDto.eventUuid - , questionnaireUuid = questionnaireUuid - , tenantUuid = tenantUuid - , createdBy = Just createdBy - , createdAt = now - , updatedAt = now - } - -fromVersionChangeDTO' :: QuestionnaireVersion -> QuestionnaireVersionChangeDTO -> UTCTime -> QuestionnaireVersion -fromVersionChangeDTO' version reqDto now = - QuestionnaireVersion - { uuid = version.uuid - , name = reqDto.name - , description = reqDto.description - , eventUuid = reqDto.eventUuid - , questionnaireUuid = version.questionnaireUuid - , tenantUuid = version.tenantUuid - , createdBy = version.createdBy - , createdAt = version.createdAt - , updatedAt = now - } diff --git a/wizard-server/src/Wizard/Service/Questionnaire/Version/QuestionnaireVersionService.hs b/wizard-server/src/Wizard/Service/Questionnaire/Version/QuestionnaireVersionService.hs deleted file mode 100644 index cbff99257..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/Version/QuestionnaireVersionService.hs +++ /dev/null @@ -1,141 +0,0 @@ -module Wizard.Service.Questionnaire.Version.QuestionnaireVersionService where - -import Control.Monad (void, when) -import Control.Monad.Except (catchError) -import Control.Monad.Reader (asks, liftIO) -import qualified Data.List as L -import qualified Data.Map.Strict as M -import qualified Data.Set as S -import Data.Time -import qualified Data.UUID as U - -import Shared.Common.Model.Common.Lens -import Shared.Common.Util.List -import Shared.Common.Util.Uuid -import Wizard.Api.Resource.Questionnaire.QuestionnaireContentDTO -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionChangeDTO -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionRevertDTO -import Wizard.Api.Resource.User.UserDTO -import Wizard.Database.DAO.Common -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireEventDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireFileDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireVersionDAO -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.AppContextHelpers -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireEventList -import Wizard.Model.Questionnaire.QuestionnaireEventListLenses () -import Wizard.Model.Questionnaire.QuestionnaireVersion -import Wizard.Model.Questionnaire.QuestionnaireVersionList -import Wizard.Service.Questionnaire.Collaboration.CollaborationService -import Wizard.Service.Questionnaire.Comment.QuestionnaireCommentService -import Wizard.Service.Questionnaire.Compiler.CompilerService -import Wizard.Service.Questionnaire.QuestionnaireAcl -import Wizard.Service.Questionnaire.QuestionnaireMapper -import Wizard.Service.Questionnaire.Version.QuestionnaireVersionMapper -import Wizard.Service.Questionnaire.Version.QuestionnaireVersionValidation -import Wizard.Service.User.UserService - -getVersions :: U.UUID -> AppContextM [QuestionnaireVersionList] -getVersions qtnUuid = do - qtn <- findQuestionnaireByUuid qtnUuid - checkViewPermissionToQtn qtn.visibility qtn.sharing qtn.permissions - findQuestionnaireVersionListByQuestionnaireUuidAndCreatedAt qtnUuid Nothing - -createVersion :: U.UUID -> QuestionnaireVersionChangeDTO -> AppContextM QuestionnaireVersionList -createVersion qtnUuid reqDto = - runInTransaction $ do - qtn <- findQuestionnaireByUuid qtnUuid - checkOwnerPermissionToQtn qtn.visibility qtn.permissions - validateQuestionnaireVersionCreate qtnUuid reqDto - uuid <- liftIO generateUuid - tenantUuid <- asks currentTenantUuid - currentUser <- getCurrentUser - now <- liftIO getCurrentTime - let version = fromVersionChangeDTO reqDto uuid qtnUuid tenantUuid currentUser.uuid now - insertQuestionnaireVersion version - return $ toVersionList version (Just currentUser) - -cloneQuestionnaireVersions :: U.UUID -> U.UUID -> [(U.UUID, QuestionnaireEventList)] -> AppContextM [(QuestionnaireVersion, QuestionnaireVersion)] -cloneQuestionnaireVersions oldQtnUuid newQtnUuid newQtnEventsWithOldEventUuid = do - runInTransaction $ do - oldVersions <- findQuestionnaireVersionsByQuestionnaireUuid oldQtnUuid - traverse - ( \oldVersion -> do - newVersionUuid <- liftIO generateUuid - let newEvenUuid = - case L.find (\(oldEventUuid, newEvent) -> oldVersion.eventUuid == oldEventUuid) newQtnEventsWithOldEventUuid of - Just (_, newEvent) -> getUuid newEvent - Nothing -> oldVersion.eventUuid - let newVersion = oldVersion {uuid = newVersionUuid, questionnaireUuid = newQtnUuid, eventUuid = newEvenUuid} - insertQuestionnaireVersion newVersion - return (oldVersion, newVersion) - ) - oldVersions - -modifyVersion :: U.UUID -> U.UUID -> QuestionnaireVersionChangeDTO -> AppContextM QuestionnaireVersionList -modifyVersion qtnUuid versionUuid reqDto = - runInTransaction $ do - qtn <- findQuestionnaireByUuid qtnUuid - checkOwnerPermissionToQtn qtn.visibility qtn.permissions - validateQuestionnaireVersionUpdate reqDto - now <- liftIO getCurrentTime - version <- findQuestionnaireVersionByUuid versionUuid - let updatedVersion = fromVersionChangeDTO' version reqDto now - updateQuestionnaireVersionByUuid updatedVersion - createdBy <- - case version.createdBy of - Just vCreatedBy -> do - user <- getUserById vCreatedBy - return . Just $ user - Nothing -> return Nothing - return $ toVersionList updatedVersion createdBy - -deleteVersion :: U.UUID -> U.UUID -> AppContextM () -deleteVersion qtnUuid vUuid = - runInTransaction $ do - qtn <- findQuestionnaireByUuid qtnUuid - checkOwnerPermissionToQtn qtn.visibility qtn.permissions - _ <- findQuestionnaireVersionByUuid vUuid - void $ deleteQuestionnaireVersionByUuid vUuid - -revertToEvent :: U.UUID -> QuestionnaireVersionRevertDTO -> Bool -> AppContextM QuestionnaireContentDTO -revertToEvent qtnUuid reqDto shouldSave = - runInTransaction $ do - qtn <- findQuestionnaireByUuid qtnUuid - if shouldSave - then checkOwnerPermissionToQtn qtn.visibility qtn.permissions - else checkViewPermissionToQtn qtn.visibility qtn.sharing qtn.permissions - qtnVersions <- findQuestionnaireVersionsByQuestionnaireUuid qtnUuid - qtnEvents <- findQuestionnaireEventListsByQuestionnaireUuid qtnUuid - let updatedEvents = takeWhileInclusive (\e -> getUuid e /= reqDto.eventUuid) qtnEvents - let eventsToDelete = dropWhileExclusive (\e -> getUuid e /= reqDto.eventUuid) qtnEvents - let updatedEventUuids = S.fromList . fmap getUuid $ updatedEvents - let updatedVersions = filter (\v -> S.member v.eventUuid updatedEventUuids) qtnVersions - when - shouldSave - ( do - let versionsToDelete = fmap (.uuid) . filter (\v -> not $ S.member v.eventUuid updatedEventUuids) $ qtnVersions - deleteQuestionnaireVersionsByUuids versionsToDelete - deleteQuestionnaireEventsByUuids (fmap getUuid eventsToDelete) - event <- findQuestionnaireEventByUuid reqDto.eventUuid - deleteQuestionnaireFilesNewerThen qtnUuid (getCreatedAt event) - void $ updateQuestionnaireUpdatedAtByUuid qtnUuid - ) - let qtnCtn = compileQuestionnaire updatedEvents - versionDto <- - traverse - ( \version -> do - createdBy <- - case version.createdBy of - Just vCreatedBy -> do - user <- getUserById vCreatedBy - return . Just $ user - Nothing -> return Nothing - return $ toVersionList version createdBy - ) - updatedVersions - when shouldSave (logOutOnlineUsersWhenQtnDramaticallyChanged qtnUuid) - commentThreadsMap <- catchError (getQuestionnaireCommentsByQuestionnaireUuid qtnUuid Nothing Nothing) (\_ -> return M.empty) - return $ toContentDTO qtnCtn commentThreadsMap updatedEvents versionDto diff --git a/wizard-server/src/Wizard/Service/Questionnaire/Version/QuestionnaireVersionValidation.hs b/wizard-server/src/Wizard/Service/Questionnaire/Version/QuestionnaireVersionValidation.hs deleted file mode 100644 index cb0af9c91..000000000 --- a/wizard-server/src/Wizard/Service/Questionnaire/Version/QuestionnaireVersionValidation.hs +++ /dev/null @@ -1,34 +0,0 @@ -module Wizard.Service.Questionnaire.Version.QuestionnaireVersionValidation where - -import Control.Monad (when) -import Control.Monad.Except (throwError) -import Data.Maybe (isJust) -import qualified Data.UUID as U - -import Shared.Common.Model.Error.Error -import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionChangeDTO -import Wizard.Database.DAO.Questionnaire.QuestionnaireEventDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireVersionDAO -import Wizard.Localization.Messages.Public -import Wizard.Model.Context.AppContext - -validateQuestionnaireVersionCreate :: U.UUID -> QuestionnaireVersionChangeDTO -> AppContextM () -validateQuestionnaireVersionCreate qtnUuid reqDto = do - validateQuestionnaireVersionEventExistence reqDto - validateQuestionnaireVersionUniqueness qtnUuid reqDto - -validateQuestionnaireVersionUpdate :: QuestionnaireVersionChangeDTO -> AppContextM () -validateQuestionnaireVersionUpdate = validateQuestionnaireVersionEventExistence - -validateQuestionnaireVersionUniqueness :: U.UUID -> QuestionnaireVersionChangeDTO -> AppContextM () -validateQuestionnaireVersionUniqueness qtnUuid reqDto = do - mQtnVersion <- findQuestionnaireVersionByEventUuid' qtnUuid reqDto.eventUuid - when - (isJust mQtnVersion) - (throwError . UserError $ _ERROR_SERVICE_QTN_VERSION__VERSION_UNIQUENESS (U.toString $ reqDto.eventUuid)) - -validateQuestionnaireVersionEventExistence :: QuestionnaireVersionChangeDTO -> AppContextM () -validateQuestionnaireVersionEventExistence reqDto = - findQuestionnaireEventByUuid' reqDto.eventUuid >>= \case - Just _ -> return () - Nothing -> throwError . UserError $ _ERROR_SERVICE_QTN_VERSION__NON_EXISTENT_EVENT_UUID (U.toString $ reqDto.eventUuid) diff --git a/wizard-server/src/Wizard/Service/QuestionnaireAction/QuestionnaireActionAudit.hs b/wizard-server/src/Wizard/Service/QuestionnaireAction/QuestionnaireActionAudit.hs deleted file mode 100644 index 0a0c0d9d9..000000000 --- a/wizard-server/src/Wizard/Service/QuestionnaireAction/QuestionnaireActionAudit.hs +++ /dev/null @@ -1,8 +0,0 @@ -module Wizard.Service.QuestionnaireAction.QuestionnaireActionAudit where - -import Shared.Audit.Service.Audit.AuditService -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.ContextLenses () - -auditQuestionnaireActionStartEvent :: String -> AppContextM () -auditQuestionnaireActionStartEvent = logAudit "questionnaireAction" "startEvent" diff --git a/wizard-server/src/Wizard/Service/QuestionnaireAction/QuestionnaireActionMapper.hs b/wizard-server/src/Wizard/Service/QuestionnaireAction/QuestionnaireActionMapper.hs deleted file mode 100644 index 15afd861e..000000000 --- a/wizard-server/src/Wizard/Service/QuestionnaireAction/QuestionnaireActionMapper.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Wizard.Service.QuestionnaireAction.QuestionnaireActionMapper where - -import Data.Time - -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionChangeDTO -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionDTO -import Wizard.Model.QuestionnaireAction.QuestionnaireAction - -toDTO :: QuestionnaireAction -> QuestionnaireActionDTO -toDTO action = - QuestionnaireActionDTO - { qaId = action.qaId - , name = action.name - , description = action.description - , url = action.url - , enabled = action.enabled - , createdAt = action.createdAt - , updatedAt = action.updatedAt - } - -toChangeDTO :: QuestionnaireAction -> QuestionnaireActionChangeDTO -toChangeDTO action = QuestionnaireActionChangeDTO {enabled = action.enabled} - -fromChangeDTO :: QuestionnaireAction -> QuestionnaireActionChangeDTO -> UTCTime -> QuestionnaireAction -fromChangeDTO action reqDto now = - action {enabled = reqDto.enabled, updatedAt = now} diff --git a/wizard-server/src/Wizard/Service/QuestionnaireAction/QuestionnaireActionService.hs b/wizard-server/src/Wizard/Service/QuestionnaireAction/QuestionnaireActionService.hs deleted file mode 100644 index 685376e46..000000000 --- a/wizard-server/src/Wizard/Service/QuestionnaireAction/QuestionnaireActionService.hs +++ /dev/null @@ -1,74 +0,0 @@ -module Wizard.Service.QuestionnaireAction.QuestionnaireActionService where - -import Control.Monad.Reader (liftIO) -import Data.Maybe (fromMaybe) -import Data.Time -import qualified Data.UUID as U - -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.PageMetadata -import Shared.Common.Model.Common.Pageable -import Shared.Common.Model.Common.Sort -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionChangeDTO -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionDTO -import Wizard.Database.DAO.Common -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.QuestionnaireAction.QuestionnaireActionDAO -import Wizard.Model.Context.AclContext -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.AppContextHelpers -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.QuestionnaireAction.QuestionnaireAction -import Wizard.Service.QuestionnaireAction.QuestionnaireActionAudit -import Wizard.Service.QuestionnaireAction.QuestionnaireActionMapper -import Wizard.Service.QuestionnaireAction.QuestionnaireActionUtil - -getQuestionnaireActionsPageDto :: Maybe String -> Pageable -> [Sort] -> AppContextM (Page QuestionnaireActionDTO) -getQuestionnaireActionsPageDto mQuery pageable sort = do - checkPermission _QTN_PERM - currentUser <- getCurrentUser - importersPage <- findQuestionnaireActionsPage Nothing Nothing mQuery Nothing pageable sort - return $ fmap toDTO importersPage - -getQuestionnaireActionSuggestions - :: Maybe U.UUID -> Maybe String -> Maybe Bool -> Pageable -> [Sort] -> AppContextM (Page QuestionnaireActionDTO) -getQuestionnaireActionSuggestions mQuestionnaireUuid mQuery mEnabled pageable sort = do - checkPermission _QTN_PERM - mPkgId <- - case mQuestionnaireUuid of - Just qtnUuid -> do - qtn <- findQuestionnaireByUuid qtnUuid - return . Just $ qtn.knowledgeModelPackageId - Nothing -> return Nothing - page <- findQuestionnaireActionsPage Nothing Nothing mQuery mEnabled (Pageable (Just 0) (Just 999999999)) sort - return . fmap toDTO . updatePage page . filterImportersInGroup mPkgId $ page - where - updatePage :: Page QuestionnaireAction -> [QuestionnaireAction] -> Page QuestionnaireAction - updatePage (Page name _ _) array = - let updatedArray = take updatedSize array - updatedSize = fromMaybe 20 pageable.size - updatedTotalElements = length updatedArray - updatedTotalPages = computeTotalPage updatedTotalElements updatedSize - updatedNumber = fromMaybe 0 pageable.page - in Page name (PageMetadata updatedSize updatedTotalElements updatedTotalPages updatedNumber) updatedArray - filterImportersInGroup :: Maybe String -> Page QuestionnaireAction -> [QuestionnaireAction] - filterImportersInGroup mPkgId page = - filter isQuestionnaireActionSupported . filterQuestionnaireActions mPkgId $ page.entities - -getQuestionnaireAction :: String -> AppContextM QuestionnaireActionDTO -getQuestionnaireAction qiId = - runInTransaction $ do - checkPermission _QTN_PERM - importer <- findQuestionnaireActionById qiId - auditQuestionnaireActionStartEvent qiId - return $ toDTO importer - -modifyQuestionnaireAction :: String -> QuestionnaireActionChangeDTO -> AppContextM QuestionnaireActionDTO -modifyQuestionnaireAction qiId reqDto = - runInTransaction $ do - checkPermission _QTN_ACTION_PERM - importer <- findQuestionnaireActionById qiId - now <- liftIO getCurrentTime - let updatedImporter = fromChangeDTO importer reqDto now - updateQuestionnaireActionById updatedImporter - return $ toDTO updatedImporter diff --git a/wizard-server/src/Wizard/Service/QuestionnaireAction/QuestionnaireActionUtil.hs b/wizard-server/src/Wizard/Service/QuestionnaireAction/QuestionnaireActionUtil.hs deleted file mode 100644 index 6c1b145ad..000000000 --- a/wizard-server/src/Wizard/Service/QuestionnaireAction/QuestionnaireActionUtil.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Wizard.Service.QuestionnaireAction.QuestionnaireActionUtil where - -import Shared.Coordinate.Util.Coordinate -import Shared.KnowledgeModel.Service.KnowledgeModel.Package.KnowledgeModelPackageUtil -import Wizard.Constant.QuestionnaireAction -import Wizard.Model.QuestionnaireAction.QuestionnaireAction - -isQuestionnaireActionSupported :: QuestionnaireAction -> Bool -isQuestionnaireActionSupported importer = importer.metamodelVersion == questionnaireActionMetamodelVersion - -filterQuestionnaireActions :: Maybe String -> [QuestionnaireAction] -> [QuestionnaireAction] -filterQuestionnaireActions mPkgId importers = - case mPkgId of - Just pkgId -> filter (filterQuestionnaireAction . splitCoordinate $ pkgId) importers - Nothing -> importers - where - filterQuestionnaireAction :: [String] -> QuestionnaireAction -> Bool - filterQuestionnaireAction pkgIdSplit importer = fitsIntoKMSpecs pkgIdSplit importer.allowedPackages diff --git a/wizard-server/src/Wizard/Service/QuestionnaireImporter/QuestionnaireImporterAudit.hs b/wizard-server/src/Wizard/Service/QuestionnaireImporter/QuestionnaireImporterAudit.hs deleted file mode 100644 index 9b21a0878..000000000 --- a/wizard-server/src/Wizard/Service/QuestionnaireImporter/QuestionnaireImporterAudit.hs +++ /dev/null @@ -1,8 +0,0 @@ -module Wizard.Service.QuestionnaireImporter.QuestionnaireImporterAudit where - -import Shared.Audit.Service.Audit.AuditService -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.ContextLenses () - -auditQuestionnaireImporterStartEvent :: String -> AppContextM () -auditQuestionnaireImporterStartEvent = logAudit "questionnaireImporter" "startEvent" diff --git a/wizard-server/src/Wizard/Service/QuestionnaireImporter/QuestionnaireImporterMapper.hs b/wizard-server/src/Wizard/Service/QuestionnaireImporter/QuestionnaireImporterMapper.hs deleted file mode 100644 index 2bcf859a0..000000000 --- a/wizard-server/src/Wizard/Service/QuestionnaireImporter/QuestionnaireImporterMapper.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Wizard.Service.QuestionnaireImporter.QuestionnaireImporterMapper where - -import Data.Time - -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterChangeDTO -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterDTO -import Wizard.Model.QuestionnaireImporter.QuestionnaireImporter - -toDTO :: QuestionnaireImporter -> QuestionnaireImporterDTO -toDTO importer = - QuestionnaireImporterDTO - { qiId = importer.qiId - , name = importer.name - , description = importer.description - , url = importer.url - , enabled = importer.enabled - , createdAt = importer.createdAt - , updatedAt = importer.updatedAt - } - -toChangeDTO :: QuestionnaireImporter -> QuestionnaireImporterChangeDTO -toChangeDTO importer = QuestionnaireImporterChangeDTO {enabled = importer.enabled} - -fromChangeDTO :: QuestionnaireImporter -> QuestionnaireImporterChangeDTO -> UTCTime -> QuestionnaireImporter -fromChangeDTO importer reqDto now = - importer {enabled = reqDto.enabled, updatedAt = now} diff --git a/wizard-server/src/Wizard/Service/QuestionnaireImporter/QuestionnaireImporterService.hs b/wizard-server/src/Wizard/Service/QuestionnaireImporter/QuestionnaireImporterService.hs deleted file mode 100644 index 82e4b91cf..000000000 --- a/wizard-server/src/Wizard/Service/QuestionnaireImporter/QuestionnaireImporterService.hs +++ /dev/null @@ -1,74 +0,0 @@ -module Wizard.Service.QuestionnaireImporter.QuestionnaireImporterService where - -import Control.Monad.Reader (liftIO) -import Data.Maybe (fromMaybe) -import Data.Time -import qualified Data.UUID as U - -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.PageMetadata -import Shared.Common.Model.Common.Pageable -import Shared.Common.Model.Common.Sort -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterChangeDTO -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterDTO -import Wizard.Database.DAO.Common -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.QuestionnaireImporter.QuestionnaireImporterDAO -import Wizard.Model.Context.AclContext -import Wizard.Model.Context.AppContext -import Wizard.Model.Context.AppContextHelpers -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.QuestionnaireImporter.QuestionnaireImporter -import Wizard.Service.QuestionnaireImporter.QuestionnaireImporterAudit -import Wizard.Service.QuestionnaireImporter.QuestionnaireImporterMapper -import Wizard.Service.QuestionnaireImporter.QuestionnaireImporterUtil - -getQuestionnaireImportersPageDto :: Maybe String -> Pageable -> [Sort] -> AppContextM (Page QuestionnaireImporterDTO) -getQuestionnaireImportersPageDto mQuery pageable sort = do - checkPermission _QTN_PERM - currentUser <- getCurrentUser - importersPage <- findQuestionnaireImportersPage Nothing Nothing mQuery Nothing pageable sort - return $ fmap toDTO importersPage - -getQuestionnaireImporterSuggestions - :: Maybe U.UUID -> Maybe String -> Maybe Bool -> Pageable -> [Sort] -> AppContextM (Page QuestionnaireImporterDTO) -getQuestionnaireImporterSuggestions mQuestionnaireUuid mQuery mEnabled pageable sort = do - checkPermission _QTN_PERM - mPkgId <- - case mQuestionnaireUuid of - Just qtnUuid -> do - qtn <- findQuestionnaireByUuid qtnUuid - return . Just $ qtn.knowledgeModelPackageId - Nothing -> return Nothing - page <- findQuestionnaireImportersPage Nothing Nothing mQuery mEnabled (Pageable (Just 0) (Just 999999999)) sort - return . fmap toDTO . updatePage page . filterImportersInGroup mPkgId $ page - where - updatePage :: Page QuestionnaireImporter -> [QuestionnaireImporter] -> Page QuestionnaireImporter - updatePage (Page name _ _) array = - let updatedArray = take updatedSize array - updatedSize = fromMaybe 20 pageable.size - updatedTotalElements = length updatedArray - updatedTotalPages = computeTotalPage updatedTotalElements updatedSize - updatedNumber = fromMaybe 0 pageable.page - in Page name (PageMetadata updatedSize updatedTotalElements updatedTotalPages updatedNumber) updatedArray - filterImportersInGroup :: Maybe String -> Page QuestionnaireImporter -> [QuestionnaireImporter] - filterImportersInGroup mPkgId page = - filter isQuestionnaireImporterSupported . filterQuestionnaireImporters mPkgId $ page.entities - -getQuestionnaireImporter :: String -> AppContextM QuestionnaireImporterDTO -getQuestionnaireImporter qiId = - runInTransaction $ do - checkPermission _QTN_PERM - importer <- findQuestionnaireImporterById qiId - auditQuestionnaireImporterStartEvent qiId - return $ toDTO importer - -modifyQuestionnaireImporter :: String -> QuestionnaireImporterChangeDTO -> AppContextM QuestionnaireImporterDTO -modifyQuestionnaireImporter qiId reqDto = - runInTransaction $ do - checkPermission _QTN_IMPORTER_PERM - importer <- findQuestionnaireImporterById qiId - now <- liftIO getCurrentTime - let updatedImporter = fromChangeDTO importer reqDto now - updateQuestionnaireImporterById updatedImporter - return $ toDTO updatedImporter diff --git a/wizard-server/src/Wizard/Service/QuestionnaireImporter/QuestionnaireImporterUtil.hs b/wizard-server/src/Wizard/Service/QuestionnaireImporter/QuestionnaireImporterUtil.hs deleted file mode 100644 index 9474e324a..000000000 --- a/wizard-server/src/Wizard/Service/QuestionnaireImporter/QuestionnaireImporterUtil.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Wizard.Service.QuestionnaireImporter.QuestionnaireImporterUtil where - -import Shared.Coordinate.Util.Coordinate -import Shared.KnowledgeModel.Service.KnowledgeModel.Package.KnowledgeModelPackageUtil -import Wizard.Constant.QuestionnaireImporter -import Wizard.Model.QuestionnaireImporter.QuestionnaireImporter - -isQuestionnaireImporterSupported :: QuestionnaireImporter -> Bool -isQuestionnaireImporterSupported importer = importer.metamodelVersion == questionnaireImporterMetamodelVersion - -filterQuestionnaireImporters :: Maybe String -> [QuestionnaireImporter] -> [QuestionnaireImporter] -filterQuestionnaireImporters mPkgId importers = - case mPkgId of - Just pkgId -> filter (filterQuestionnaireImporter . splitCoordinate $ pkgId) importers - Nothing -> importers - where - filterQuestionnaireImporter :: [String] -> QuestionnaireImporter -> Bool - filterQuestionnaireImporter pkgIdSplit importer = fitsIntoKMSpecs pkgIdSplit importer.allowedPackages diff --git a/wizard-server/src/Wizard/Service/Report/Evaluator/Common.hs b/wizard-server/src/Wizard/Service/Report/Evaluator/Common.hs index 2b3ec8efb..bf187fb6a 100644 --- a/wizard-server/src/Wizard/Service/Report/Evaluator/Common.hs +++ b/wizard-server/src/Wizard/Service/Report/Evaluator/Common.hs @@ -4,20 +4,20 @@ import qualified Data.List as L import Data.Maybe (fromMaybe, isNothing) import qualified Data.UUID as U -import Wizard.Model.Questionnaire.QuestionnaireReply +import Wizard.Model.Project.ProjectReply getReply :: [ReplyTuple] -> String -> Maybe ReplyTuple getReply replies p = L.find (\(path, _) -> path == p) replies isRequiredNow :: [U.UUID] -> Maybe U.UUID -> Maybe U.UUID -> Int -> Int -isRequiredNow phaseUuids mQPhase mQtnPhase currentValue - | isNothing mQtnPhase = currentValue - | qPhaseIndex <= qtnPhaseIndex = currentValue +isRequiredNow phaseUuids mQPhase mProjectPhase currentValue + | isNothing mProjectPhase = currentValue + | qPhaseIndex <= projectPhaseIndex = currentValue | otherwise = 0 where - qtnPhaseIndex = - case mQtnPhase of - Just qtnPhase -> fromMaybe 9999 (qtnPhase `L.elemIndex` phaseUuids) + projectPhaseIndex = + case mProjectPhase of + Just projectPhase -> fromMaybe 9999 (projectPhase `L.elemIndex` phaseUuids) Nothing -> 9999 qPhaseIndex = case mQPhase of diff --git a/wizard-server/src/Wizard/Service/Report/Evaluator/Indication.hs b/wizard-server/src/Wizard/Service/Report/Evaluator/Indication.hs index 95f744261..4cb3ab3fc 100644 --- a/wizard-server/src/Wizard/Service/Report/Evaluator/Indication.hs +++ b/wizard-server/src/Wizard/Service/Report/Evaluator/Indication.hs @@ -8,90 +8,90 @@ import qualified Data.UUID as U import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModelAccessors import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModelLenses -import Wizard.Model.Questionnaire.QuestionnaireReply +import Wizard.Model.Project.ProjectReply import Wizard.Model.Report.Report import Wizard.Service.Report.Evaluator.Common computeIndications :: Maybe U.UUID -> KnowledgeModel -> M.Map String Reply -> Chapter -> [Indication] -computeIndications mQtnPhase km replies ch = - [computePhasesAnsweredIndication mQtnPhase km replies ch, computeAnsweredIndication Nothing km replies ch] +computeIndications mProjectPhase km replies ch = + [computePhasesAnsweredIndication mProjectPhase km replies ch, computeAnsweredIndication Nothing km replies ch] -- -------------------------------- -- PRIVATE -- -------------------------------- computeAnsweredIndication :: Maybe U.UUID -> KnowledgeModel -> M.Map String Reply -> Chapter -> Indication -computeAnsweredIndication mQtnPhase km replies ch = +computeAnsweredIndication mProjectPhase km replies ch = AnsweredIndication' $ AnsweredIndication - { answeredQuestions = evaluateChapter 1 0 mQtnPhase km replies ch - , unansweredQuestions = evaluateChapter 0 1 mQtnPhase km replies ch + { answeredQuestions = evaluateChapter 1 0 mProjectPhase km replies ch + , unansweredQuestions = evaluateChapter 0 1 mProjectPhase km replies ch } computePhasesAnsweredIndication :: Maybe U.UUID -> KnowledgeModel -> M.Map String Reply -> Chapter -> Indication -computePhasesAnsweredIndication mQtnPhase km replies ch = +computePhasesAnsweredIndication mProjectPhase km replies ch = PhasesAnsweredIndication' $ PhasesAnsweredIndication - { answeredQuestions = evaluateChapter 1 0 mQtnPhase km replies ch - , unansweredQuestions = evaluateChapter 0 1 mQtnPhase km replies ch + { answeredQuestions = evaluateChapter 1 0 mProjectPhase km replies ch + , unansweredQuestions = evaluateChapter 0 1 mProjectPhase km replies ch } evaluateChapter :: Int -> Int -> Maybe U.UUID -> KnowledgeModel -> M.Map String Reply -> Chapter -> Int -evaluateChapter found notFound mQtnPhase km replies ch = +evaluateChapter found notFound mProjectPhase km replies ch = let currentPath = U.toString $ ch.uuid qs = getQuestionsForChapterUuid km ch.uuid - in sum . fmap (evaluateQuestion found notFound mQtnPhase km replies currentPath) $ qs + in sum . fmap (evaluateQuestion found notFound mProjectPhase km replies currentPath) $ qs evaluateQuestion :: Int -> Int -> Maybe U.UUID -> KnowledgeModel -> M.Map String Reply -> String -> Question -> Int -evaluateQuestion found notFound mQtnPhase km replies path q' = +evaluateQuestion found notFound mProjectPhase km replies path q' = let currentPath = composePathUuid path $ getUuid q' in case M.lookup currentPath replies of Just reply -> children currentPath - Nothing -> isRequiredNow km.phaseUuids (getRequiredPhaseUuid q') mQtnPhase notFound + Nothing -> isRequiredNow km.phaseUuids (getRequiredPhaseUuid q') mProjectPhase notFound where children currentPath = case q' of - MultiChoiceQuestion' q -> evaluateMultiChoiceQuestion q found notFound mQtnPhase km replies currentPath + MultiChoiceQuestion' q -> evaluateMultiChoiceQuestion q found notFound mProjectPhase km replies currentPath ValueQuestion' q -> rFound IntegrationQuestion' q -> rFound ItemSelectQuestion' q -> rFound - OptionsQuestion' q -> rFound + evaluateOptionsQuestion q found notFound mQtnPhase km replies currentPath - ListQuestion' q -> evaluateListQuestion found notFound mQtnPhase km replies currentPath q + OptionsQuestion' q -> rFound + evaluateOptionsQuestion q found notFound mProjectPhase km replies currentPath + ListQuestion' q -> evaluateListQuestion found notFound mProjectPhase km replies currentPath q FileQuestion' q -> rFound where - rFound = isRequiredNow km.phaseUuids (getRequiredPhaseUuid q') mQtnPhase found + rFound = isRequiredNow km.phaseUuids (getRequiredPhaseUuid q') mProjectPhase found evaluateOptionsQuestion :: OptionsQuestion -> Int -> Int -> Maybe U.UUID -> KnowledgeModel -> M.Map String Reply -> String -> Int -evaluateOptionsQuestion q found notFound mQtnPhase km replies path = +evaluateOptionsQuestion q found notFound mProjectPhase km replies path = case M.lookup path replies of Just (Reply {value = AnswerReply {..}}) -> let currentPath = composePathUuid path aValue qs = getQuestionsForAnswerUuid km aValue - in sum . fmap (evaluateQuestion found notFound mQtnPhase km replies currentPath) $ qs - _ -> isRequiredNow km.phaseUuids q.requiredPhaseUuid mQtnPhase notFound + in sum . fmap (evaluateQuestion found notFound mProjectPhase km replies currentPath) $ qs + _ -> isRequiredNow km.phaseUuids q.requiredPhaseUuid mProjectPhase notFound evaluateListQuestion :: Int -> Int -> Maybe U.UUID -> KnowledgeModel -> M.Map String Reply -> String -> ListQuestion -> Int -evaluateListQuestion found notFound mQtnPhase km replies currentPath q = +evaluateListQuestion found notFound mProjectPhase km replies currentPath q = let itemQs = getItemTemplateQuestionsForQuestionUuid km $ q.uuid items = case M.lookup currentPath replies of Just (Reply {value = ItemListReply {..}}) -> ilValue _ -> [] evaluateQuestion' item = - fmap (evaluateQuestion found notFound mQtnPhase km replies (composePath currentPath $ U.toString item)) itemQs + fmap (evaluateQuestion found notFound mProjectPhase km replies (composePath currentPath $ U.toString item)) itemQs current = if not (null items) - then isRequiredNow km.phaseUuids q.requiredPhaseUuid mQtnPhase found - else isRequiredNow km.phaseUuids q.requiredPhaseUuid mQtnPhase notFound + then isRequiredNow km.phaseUuids q.requiredPhaseUuid mProjectPhase found + else isRequiredNow km.phaseUuids q.requiredPhaseUuid mProjectPhase notFound children = sum . concatMap evaluateQuestion' $ items in current + children evaluateMultiChoiceQuestion :: MultiChoiceQuestion -> Int -> Int -> Maybe U.UUID -> KnowledgeModel -> M.Map String Reply -> String -> Int -evaluateMultiChoiceQuestion q found notFound mQtnPhase km replies path = +evaluateMultiChoiceQuestion q found notFound mProjectPhase km replies path = case M.lookup path replies of Just (Reply {value = MultiChoiceReply {..}}) -> if not (null mcValue) - then isRequiredNow km.phaseUuids q.requiredPhaseUuid mQtnPhase found - else isRequiredNow km.phaseUuids q.requiredPhaseUuid mQtnPhase notFound - _ -> isRequiredNow km.phaseUuids q.requiredPhaseUuid mQtnPhase notFound + then isRequiredNow km.phaseUuids q.requiredPhaseUuid mProjectPhase found + else isRequiredNow km.phaseUuids q.requiredPhaseUuid mProjectPhase notFound + _ -> isRequiredNow km.phaseUuids q.requiredPhaseUuid mProjectPhase notFound diff --git a/wizard-server/src/Wizard/Service/Report/Evaluator/Metric.hs b/wizard-server/src/Wizard/Service/Report/Evaluator/Metric.hs index 025547c8f..acb5725b5 100644 --- a/wizard-server/src/Wizard/Service/Report/Evaluator/Metric.hs +++ b/wizard-server/src/Wizard/Service/Report/Evaluator/Metric.hs @@ -8,7 +8,7 @@ import Shared.Common.Util.Math import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModelAccessors import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModelLenses -import Wizard.Model.Questionnaire.QuestionnaireReply +import Wizard.Model.Project.ProjectReply import Wizard.Model.Report.Report import Wizard.Service.Report.Evaluator.Common diff --git a/wizard-server/src/Wizard/Service/Report/ReportGenerator.hs b/wizard-server/src/Wizard/Service/Report/ReportGenerator.hs index 4e8b168fa..c8dd6f608 100644 --- a/wizard-server/src/Wizard/Service/Report/ReportGenerator.hs +++ b/wizard-server/src/Wizard/Service/Report/ReportGenerator.hs @@ -9,7 +9,7 @@ import Shared.Common.Util.Uuid import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModelAccessors import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.QuestionnaireReply +import Wizard.Model.Project.ProjectReply import Wizard.Model.Report.Report import Wizard.Service.Report.Evaluator.Indication import Wizard.Service.Report.Evaluator.Metric diff --git a/wizard-server/src/Wizard/Service/Report/ReportMapper.hs b/wizard-server/src/Wizard/Service/Report/ReportMapper.hs index b157776c8..5433b942e 100644 --- a/wizard-server/src/Wizard/Service/Report/ReportMapper.hs +++ b/wizard-server/src/Wizard/Service/Report/ReportMapper.hs @@ -1,21 +1,21 @@ module Wizard.Service.Report.ReportMapper where -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailQuestionnaireDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailReportDTO +import Wizard.Api.Resource.Project.Detail.ProjectDetailQuestionnaireDTO +import Wizard.Api.Resource.Project.Detail.ProjectDetailReportDTO import Wizard.Model.Report.Report -toDTO :: QuestionnaireDetailQuestionnaireDTO -> Report -> QuestionnaireDetailReportDTO -toDTO qtn report = - QuestionnaireDetailReportDTO - { uuid = qtn.uuid - , name = qtn.name - , visibility = qtn.visibility - , sharing = qtn.sharing - , knowledgeModelPackageId = qtn.knowledgeModelPackageId - , isTemplate = qtn.isTemplate - , permissions = qtn.permissions - , migrationUuid = qtn.migrationUuid - , fileCount = qtn.fileCount +toDTO :: ProjectDetailQuestionnaireDTO -> Report -> ProjectDetailReportDTO +toDTO project report = + ProjectDetailReportDTO + { uuid = project.uuid + , name = project.name + , visibility = project.visibility + , sharing = project.sharing + , knowledgeModelPackageId = project.knowledgeModelPackageId + , isTemplate = project.isTemplate + , permissions = project.permissions + , migrationUuid = project.migrationUuid + , fileCount = project.fileCount , totalReport = report.totalReport , chapters = report.chapters , chapterReports = report.chapterReports diff --git a/wizard-server/src/Wizard/Service/Report/ReportService.hs b/wizard-server/src/Wizard/Service/Report/ReportService.hs index 30f793247..c68113285 100644 --- a/wizard-server/src/Wizard/Service/Report/ReportService.hs +++ b/wizard-server/src/Wizard/Service/Report/ReportService.hs @@ -2,17 +2,17 @@ module Wizard.Service.Report.ReportService where import qualified Data.UUID as U -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailQuestionnaireDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailReportDTO +import Wizard.Api.Resource.Project.Detail.ProjectDetailQuestionnaireDTO +import Wizard.Api.Resource.Project.Detail.ProjectDetailReportDTO import Wizard.Model.Context.AppContext import Wizard.Service.KnowledgeModel.KnowledgeModelService -import Wizard.Service.Questionnaire.QuestionnaireService +import Wizard.Service.Project.ProjectService import Wizard.Service.Report.ReportGenerator import Wizard.Service.Report.ReportMapper -getReportByQuestionnaireUuid :: U.UUID -> AppContextM QuestionnaireDetailReportDTO -getReportByQuestionnaireUuid qtnUuid = do - qtnDto <- getQuestionnaireDetailQuestionnaireByUuid qtnUuid - knowledgeModel <- compileKnowledgeModel [] (Just qtnDto.knowledgeModelPackageId) qtnDto.selectedQuestionTagUuids - report <- generateReport qtnDto.phaseUuid knowledgeModel qtnDto.replies - return $ toDTO qtnDto report +getReportByProjectUuid :: U.UUID -> AppContextM ProjectDetailReportDTO +getReportByProjectUuid projectUuid = do + projectDto <- getProjectDetailQuestionnaireByUuid projectUuid + knowledgeModel <- compileKnowledgeModel [] (Just projectDto.knowledgeModelPackageId) projectDto.selectedQuestionTagUuids + report <- generateReport projectDto.phaseUuid knowledgeModel projectDto.replies + return $ toDTO projectDto report diff --git a/wizard-server/src/Wizard/Service/Statistics/StatisticsService.hs b/wizard-server/src/Wizard/Service/Statistics/StatisticsService.hs index 52785bae5..9d246bddb 100644 --- a/wizard-server/src/Wizard/Service/Statistics/StatisticsService.hs +++ b/wizard-server/src/Wizard/Service/Statistics/StatisticsService.hs @@ -4,7 +4,7 @@ import Shared.DocumentTemplate.Database.DAO.DocumentTemplate.DocumentTemplateDAO import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO import Wizard.Database.DAO.Document.DocumentDAO import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelEditorDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO +import Wizard.Database.DAO.Project.ProjectDAO import Wizard.Database.DAO.User.UserDAO import Wizard.Model.Context.AppContext import Wizard.Model.Statistics.InstanceStatistics @@ -13,7 +13,7 @@ getInstanceStatistics :: AppContextM InstanceStatistics getInstanceStatistics = do uCount <- countUsers pCount <- countPackagesGroupedByOrganizationIdAndKmId - qCount <- countQuestionnaires + qCount <- countProjects bCount <- countKnowledgeModelEditors docCount <- countDocuments tmlCount <- countDocumentTemplatesGroupedByOrganizationIdAndKmId @@ -21,7 +21,7 @@ getInstanceStatistics = do InstanceStatistics { userCount = uCount , pkgCount = pCount - , qtnCount = qCount + , prjCount = qCount , knowledgeModelEditorCount = bCount , docCount = docCount , tmlCount = tmlCount diff --git a/wizard-server/src/Wizard/Service/Submission/SubmissionAcl.hs b/wizard-server/src/Wizard/Service/Submission/SubmissionAcl.hs index 71ba56c1a..db344b840 100644 --- a/wizard-server/src/Wizard/Service/Submission/SubmissionAcl.hs +++ b/wizard-server/src/Wizard/Service/Submission/SubmissionAcl.hs @@ -8,9 +8,9 @@ import Wizard.Service.Document.DocumentAcl checkViewPermissionToSubmission :: Document -> AppContextM () checkViewPermissionToSubmission doc = do checkPermission _SUBM_PERM - checkViewPermissionToDoc doc.questionnaireUuid + checkViewPermissionToDoc doc.projectUuid checkEditPermissionToSubmission :: Document -> AppContextM () checkEditPermissionToSubmission doc = do checkPermission _SUBM_PERM - checkEditPermissionToDoc doc.questionnaireUuid + checkEditPermissionToDoc doc.projectUuid diff --git a/wizard-server/src/Wizard/Service/Submission/SubmissionService.hs b/wizard-server/src/Wizard/Service/Submission/SubmissionService.hs index 59521c44f..b706d089c 100644 --- a/wizard-server/src/Wizard/Service/Submission/SubmissionService.hs +++ b/wizard-server/src/Wizard/Service/Submission/SubmissionService.hs @@ -41,7 +41,7 @@ getSubmissionsForDocument :: U.UUID -> AppContextM [SubmissionList] getSubmissionsForDocument docUuid = do checkIfSubmissionIsEnabled doc <- findDocumentByUuid docUuid - checkViewPermissionToDoc doc.questionnaireUuid + checkViewPermissionToDoc doc.projectUuid findSubmissionsByDocumentUuid docUuid submitDocument :: U.UUID -> SubmissionCreateDTO -> AppContextM SubmissionList diff --git a/wizard-server/src/Wizard/Service/Tenant/Config/ConfigMapper.hs b/wizard-server/src/Wizard/Service/Tenant/Config/ConfigMapper.hs index c5f173a0f..230a935e8 100644 --- a/wizard-server/src/Wizard/Service/Tenant/Config/ConfigMapper.hs +++ b/wizard-server/src/Wizard/Service/Tenant/Config/ConfigMapper.hs @@ -28,11 +28,11 @@ toChangeDTO -> TenantConfigLookAndFeelChangeDTO -> TenantConfigRegistryChangeDTO -> TenantConfigKnowledgeModelChangeDTO - -> TenantConfigQuestionnaireChangeDTO + -> TenantConfigProjectChangeDTO -> TenantConfigSubmissionChangeDTO -> TenantConfigFeaturesChangeDTO -> TenantConfigChangeDTO -toChangeDTO organization authentication privacyAndSupport dashboardAndLoginScreen lookAndFeel registry knowledgeModel questionnaire submission features = TenantConfigChangeDTO {..} +toChangeDTO organization authentication privacyAndSupport dashboardAndLoginScreen lookAndFeel registry knowledgeModel project submission features = TenantConfigChangeDTO {..} toSubmissionServiceSimple :: TenantConfigSubmissionService -> TenantConfigSubmissionServiceSimple toSubmissionServiceSimple config = @@ -50,12 +50,12 @@ toTenantConfig -> TenantConfigLookAndFeel -> TenantConfigRegistry -> TenantConfigKnowledgeModel - -> TenantConfigQuestionnaire + -> TenantConfigProject -> TenantConfigSubmission -> TenantConfigFeatures -> TenantConfigOwl -> TenantConfig -toTenantConfig organization authentication privacyAndSupport dashboardAndLoginScreen lookAndFeel registry knowledgeModel questionnaire submission features owl = +toTenantConfig organization authentication privacyAndSupport dashboardAndLoginScreen lookAndFeel registry knowledgeModel project submission features owl = let uuid = organization.tenantUuid mailConfigUuid = Nothing createdAt = organization.createdAt @@ -94,8 +94,8 @@ fromKnowledgeModelChangeDTO dto@TenantConfigKnowledgeModelChangeDTO {..} tenantU fromKnowledgeModelPublicPackagePatternChangeDTO :: KnowledgeModelPackagePattern -> U.UUID -> Int -> UTCTime -> UTCTime -> TenantConfigKnowledgeModelPublicPackagePattern fromKnowledgeModelPublicPackagePatternChangeDTO KnowledgeModelPackagePattern {..} tenantUuid position createdAt updatedAt = TenantConfigKnowledgeModelPublicPackagePattern {..} -fromQuestionnaireChangeDTO :: TenantConfigQuestionnaireChangeDTO -> U.UUID -> UTCTime -> UTCTime -> TenantConfigQuestionnaire -fromQuestionnaireChangeDTO TenantConfigQuestionnaireChangeDTO {..} tenantUuid createdAt updatedAt = TenantConfigQuestionnaire {..} +fromProjectChangeDTO :: TenantConfigProjectChangeDTO -> U.UUID -> UTCTime -> UTCTime -> TenantConfigProject +fromProjectChangeDTO TenantConfigProjectChangeDTO {..} tenantUuid createdAt updatedAt = TenantConfigProject {..} fromSubmissionChangeDTO :: TenantConfigSubmissionChangeDTO -> U.UUID -> UTCTime -> UTCTime -> TenantConfigSubmission fromSubmissionChangeDTO dto@TenantConfigSubmissionChangeDTO {..} tenantUuid createdAt updatedAt = diff --git a/wizard-server/src/Wizard/Service/Tenant/Config/ConfigService.hs b/wizard-server/src/Wizard/Service/Tenant/Config/ConfigService.hs index 3623ae72f..8dba47b85 100644 --- a/wizard-server/src/Wizard/Service/Tenant/Config/ConfigService.hs +++ b/wizard-server/src/Wizard/Service/Tenant/Config/ConfigService.hs @@ -13,7 +13,7 @@ import Wizard.Database.DAO.Tenant.Config.TenantConfigKnowledgeModelDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigOrganizationDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigOwlDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigPrivacyAndSupportDAO -import Wizard.Database.DAO.Tenant.Config.TenantConfigQuestionnaireDAO +import Wizard.Database.DAO.Tenant.Config.TenantConfigProjectDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigRegistryDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigSubmissionDAO import Wizard.Model.Config.ServerConfig @@ -38,11 +38,11 @@ getCurrentTenantConfigDto = do tcLookAndFeel <- findTenantConfigLookAndFeel tcRegistry <- getCurrentTenantConfigRegistry tcKnowledgeModel <- getCurrentTenantConfigKnowledgeModel - tcQuestionnaire <- getCurrentTenantConfigQuestionnaire + tcProject <- getCurrentTenantConfigProject tcSubmission <- findTenantConfigSubmission tcFeatures <- findTenantConfigFeatures tcOwl <- findTenantConfigOwl - return $ toTenantConfig tcOrganization tcAuthentication tcPrivacyAndSupport tcDashboardAndLoginScreen tcLookAndFeel tcRegistry tcKnowledgeModel tcQuestionnaire tcSubmission tcFeatures tcOwl + return $ toTenantConfig tcOrganization tcAuthentication tcPrivacyAndSupport tcDashboardAndLoginScreen tcLookAndFeel tcRegistry tcKnowledgeModel tcProject tcSubmission tcFeatures tcOwl modifyTenantConfigDto :: TenantConfigChangeDTO -> AppContextM TenantConfig modifyTenantConfigDto reqDto = @@ -78,10 +78,10 @@ modifyTenantConfigDto reqDto = tcKnowledgeModelUpdated <- getCurrentTenantConfigKnowledgeModel let tcKnowledgeModelUpdatedUpdated = fromKnowledgeModelChangeDTO reqDto.knowledgeModel tcKnowledgeModelUpdated.tenantUuid tcKnowledgeModelUpdated.createdAt now modifyTenantConfigKnowledgeModel tcKnowledgeModelUpdatedUpdated - -- Questionnaire - tcQuestionnaire <- getCurrentTenantConfigQuestionnaire - let tcQuestionnaireUpdated = fromQuestionnaireChangeDTO reqDto.questionnaire tcQuestionnaire.tenantUuid tcQuestionnaire.createdAt now - modifyTenantConfigQuestionnaire tcQuestionnaireUpdated + -- Project + tcProject <- getCurrentTenantConfigProject + let tcProjectUpdated = fromProjectChangeDTO reqDto.project tcProject.tenantUuid tcProject.createdAt now + modifyTenantConfigProject tcProjectUpdated -- Submission tcSubmission <- findTenantConfigSubmission let tcSubmissionUpdated = fromSubmissionChangeDTO reqDto.submission tcSubmission.tenantUuid tcSubmission.createdAt now @@ -92,7 +92,7 @@ modifyTenantConfigDto reqDto = updateTenantConfigFeatures tcFeaturesUpdated -- Owl tcOwl <- findTenantConfigOwl - return $ toTenantConfig tcOrganizationUpdated tcAuthenticationUpdated tcPrivacyAndSupportUpdated tcDashboardAndLoginScreenUpdated tcLookAndFeelUpdated tcRegistryUpdated tcKnowledgeModelUpdated tcQuestionnaireUpdated tcSubmissionUpdated tcFeaturesUpdated tcOwl + return $ toTenantConfig tcOrganizationUpdated tcAuthenticationUpdated tcPrivacyAndSupportUpdated tcDashboardAndLoginScreenUpdated tcLookAndFeelUpdated tcRegistryUpdated tcKnowledgeModelUpdated tcProjectUpdated tcSubmissionUpdated tcFeaturesUpdated tcOwl getCurrentTenantConfigAuthentication :: AppContextM TenantConfigAuthentication getCurrentTenantConfigAuthentication = do @@ -154,22 +154,22 @@ modifyTenantConfigKnowledgeModel tcKnowledgeModel = updateTenantConfigKnowledgeModel encryptedUpdatedTcKnowledgeModel return tcKnowledgeModel -getCurrentTenantConfigQuestionnaire :: AppContextM TenantConfigQuestionnaire -getCurrentTenantConfigQuestionnaire = do +getCurrentTenantConfigProject :: AppContextM TenantConfigProject +getCurrentTenantConfigProject = do serverConfig <- asks serverConfig - encryptedTcQuestionnaire <- findTenantConfigQuestionnaire - return $ process serverConfig.general.secret encryptedTcQuestionnaire + encryptedTcProject <- findTenantConfigProject + return $ process serverConfig.general.secret encryptedTcProject -getTenantConfigQuestionnaireByUuid :: U.UUID -> AppContextM TenantConfigQuestionnaire -getTenantConfigQuestionnaireByUuid tenantUuid = do +getTenantConfigProjectByUuid :: U.UUID -> AppContextM TenantConfigProject +getTenantConfigProjectByUuid tenantUuid = do serverConfig <- asks serverConfig - encryptedTcQuestionnaire <- findTenantConfigQuestionnaireByUuid tenantUuid - return $ process serverConfig.general.secret encryptedTcQuestionnaire + encryptedTcProject <- findTenantConfigProjectByUuid tenantUuid + return $ process serverConfig.general.secret encryptedTcProject -modifyTenantConfigQuestionnaire :: TenantConfigQuestionnaire -> AppContextM TenantConfigQuestionnaire -modifyTenantConfigQuestionnaire tcQuestionnaire = +modifyTenantConfigProject :: TenantConfigProject -> AppContextM TenantConfigProject +modifyTenantConfigProject tcProject = runInTransaction $ do serverConfig <- asks serverConfig - let encryptedUpdatedTcQuestionnaire = process serverConfig.general.secret tcQuestionnaire - updateTenantConfigQuestionnaire encryptedUpdatedTcQuestionnaire - return tcQuestionnaire + let encryptedUpdatedTcProject = process serverConfig.general.secret tcProject + updateTenantConfigProject encryptedUpdatedTcProject + return tcProject diff --git a/wizard-server/src/Wizard/Service/Tenant/Config/ConfigValidation.hs b/wizard-server/src/Wizard/Service/Tenant/Config/ConfigValidation.hs index 3022f4676..7094e14d0 100644 --- a/wizard-server/src/Wizard/Service/Tenant/Config/ConfigValidation.hs +++ b/wizard-server/src/Wizard/Service/Tenant/Config/ConfigValidation.hs @@ -12,13 +12,13 @@ import Shared.Coordinate.Localization.Messages.Public import Wizard.Api.Resource.Tenant.Config.TenantConfigChangeDTO import Wizard.Model.Context.AppContext import Wizard.Model.Tenant.Config.TenantConfig -import Wizard.Service.Questionnaire.QuestionnaireValidation +import Wizard.Service.Project.ProjectValidation validateTenantConfig :: TenantConfigChangeDTO -> AppContextM () validateTenantConfig reqDto = do validateOrganization reqDto.organization validateAuthentication reqDto.authentication - validateQuestionnaire reqDto.questionnaire + validateProject reqDto.project validateOrganization :: TenantConfigOrganizationChangeDTO -> AppContextM () validateOrganization config = forM_ (isValidOrganizationId config.organizationId) throwError @@ -41,5 +41,5 @@ validateAuthentication config = validationRegex = mkRegex "^[a-z0-9-]+$" in traverse_ validate config.external.services -validateQuestionnaire :: TenantConfigQuestionnaireChangeDTO -> AppContextM () -validateQuestionnaire config = validateQuestionnaireTags config.projectTagging.tags +validateProject :: TenantConfigProjectChangeDTO -> AppContextM () +validateProject config = validateProjectTags config.projectTagging.tags diff --git a/wizard-server/src/Wizard/Service/Tenant/Limit/LimitMapper.hs b/wizard-server/src/Wizard/Service/Tenant/Limit/LimitMapper.hs index b069bbd24..eab400197 100644 --- a/wizard-server/src/Wizard/Service/Tenant/Limit/LimitMapper.hs +++ b/wizard-server/src/Wizard/Service/Tenant/Limit/LimitMapper.hs @@ -16,7 +16,7 @@ fromCreate aUuid now = , knowledgeModelEditors = -1000 , documentTemplates = -1000 , documentTemplateDrafts = -1000 - , questionnaires = -1000 + , projects = -1000 , documents = -1000 , locales = -1000 , storage = -1000 * 5 * 1000 * 1000 @@ -34,7 +34,7 @@ fromChangeDTO limitBundle reqDto now = , knowledgeModelEditors = reqDto.knowledgeModelEditors , documentTemplates = reqDto.documentTemplates , documentTemplateDrafts = reqDto.documentTemplateDrafts - , questionnaires = reqDto.questionnaires + , projects = reqDto.projects , documents = reqDto.documents , locales = reqDto.locales , storage = reqDto.storage diff --git a/wizard-server/src/Wizard/Service/Tenant/Limit/LimitService.hs b/wizard-server/src/Wizard/Service/Tenant/Limit/LimitService.hs index e1bb6db2e..5171f31f4 100644 --- a/wizard-server/src/Wizard/Service/Tenant/Limit/LimitService.hs +++ b/wizard-server/src/Wizard/Service/Tenant/Limit/LimitService.hs @@ -14,8 +14,8 @@ import Wizard.Database.DAO.Common import Wizard.Database.DAO.Document.DocumentDAO import Wizard.Database.DAO.DocumentTemplate.DocumentTemplateDraftDAO import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelEditorDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireFileDAO +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectFileDAO import Wizard.Database.DAO.Tenant.TenantLimitBundleDAO import Wizard.Database.DAO.User.UserDAO import Wizard.Model.Context.AclContext @@ -66,11 +66,11 @@ checkPackageLimit = do count <- countPackagesGroupedByOrganizationIdAndKmId checkLimit "knowledge models" count limit.knowledgeModels -checkQuestionnaireLimit :: AppContextM () -checkQuestionnaireLimit = do +checkProjectLimit :: AppContextM () +checkProjectLimit = do limit <- findLimitBundleForCurrentTenant - count <- countQuestionnaires - checkLimit "questionnaires" count limit.questionnaires + count <- countProjects + checkLimit "projects" count limit.projects checkDocumentTemplateLimit :: AppContextM () checkDocumentTemplateLimit = do @@ -101,6 +101,6 @@ checkStorageSize newFileSize = do limit <- findLimitBundleForCurrentTenant docSize <- sumDocumentFileSize templateAssetSize <- sumAssetFileSize - qtnFileSize <- sumQuestionnaireFileSize - let storageCount = docSize + templateAssetSize + qtnFileSize + projectFileSize <- sumProjectFileSize + let storageCount = docSize + templateAssetSize + projectFileSize checkLimit "storage" (storageCount + newFileSize) limit.storage diff --git a/wizard-server/src/Wizard/Service/Tenant/TenantService.hs b/wizard-server/src/Wizard/Service/Tenant/TenantService.hs index 4a4bc2118..e2a44ef54 100644 --- a/wizard-server/src/Wizard/Service/Tenant/TenantService.hs +++ b/wizard-server/src/Wizard/Service/Tenant/TenantService.hs @@ -24,7 +24,7 @@ import Wizard.Database.DAO.Tenant.Config.TenantConfigKnowledgeModelDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigOrganizationDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigOwlDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigPrivacyAndSupportDAO -import Wizard.Database.DAO.Tenant.Config.TenantConfigQuestionnaireDAO +import Wizard.Database.DAO.Tenant.Config.TenantConfigProjectDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigRegistryDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigSubmissionDAO import Wizard.Database.DAO.Tenant.TenantDAO @@ -153,7 +153,7 @@ createConfig uuid now = do insertTenantConfigLookAndFeel (defaultLookAndFeel {tenantUuid = uuid, createdAt = now, updatedAt = now} :: TenantConfigLookAndFeel) insertTenantConfigRegistry (defaultRegistry {tenantUuid = uuid, createdAt = now, updatedAt = now} :: TenantConfigRegistry) insertTenantConfigKnowledgeModel (defaultKnowledgeModel {tenantUuid = uuid, createdAt = now, updatedAt = now} :: TenantConfigKnowledgeModel) - insertTenantConfigQuestionnaire (defaultQuestionnaire {tenantUuid = uuid, createdAt = now, updatedAt = now} :: TenantConfigQuestionnaire) + insertTenantConfigProject (defaultProject {tenantUuid = uuid, createdAt = now, updatedAt = now} :: TenantConfigProject) insertTenantConfigSubmission (defaultSubmission {tenantUuid = uuid, createdAt = now, updatedAt = now} :: TenantConfigSubmission) insertTenantConfigMail (defaultMail {tenantUuid = uuid, createdAt = now, updatedAt = now}) insertTenantConfigFeatures (defaultFeatures {tenantUuid = uuid, createdAt = now, updatedAt = now}) diff --git a/wizard-server/src/Wizard/Service/Tenant/Usage/UsageMapper.hs b/wizard-server/src/Wizard/Service/Tenant/Usage/UsageMapper.hs index 81ad2fb2c..34e2d83a4 100644 --- a/wizard-server/src/Wizard/Service/Tenant/Usage/UsageMapper.hs +++ b/wizard-server/src/Wizard/Service/Tenant/Usage/UsageMapper.hs @@ -7,7 +7,7 @@ import Wizard.Model.Tenant.Limit.TenantLimitBundle import WizardLib.Public.Api.Resource.Tenant.Usage.WizardUsageDTO toDTO :: TenantLimitBundle -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int64 -> WizardUsageDTO -toDTO limitBundle userCount activeUserCount knowledgeModelEditorCount kmCount qtnCount tmlCount tmlDraftCount docCount localeCount storageSize = +toDTO limitBundle userCount activeUserCount knowledgeModelEditorCount kmCount prjCount tmlCount tmlDraftCount docCount localeCount storageSize = WizardUsageDTO { users = UsageEntryDTO @@ -39,10 +39,10 @@ toDTO limitBundle userCount activeUserCount knowledgeModelEditorCount kmCount qt { current = fromIntegral tmlDraftCount , max = fromIntegral limitBundle.documentTemplateDrafts } - , questionnaires = + , projects = UsageEntryDTO - { current = fromIntegral qtnCount - , max = fromIntegral limitBundle.questionnaires + { current = fromIntegral prjCount + , max = fromIntegral limitBundle.projects } , documents = UsageEntryDTO diff --git a/wizard-server/src/Wizard/Service/Tenant/Usage/UsageService.hs b/wizard-server/src/Wizard/Service/Tenant/Usage/UsageService.hs index 82c9376e1..fc3fb934f 100644 --- a/wizard-server/src/Wizard/Service/Tenant/Usage/UsageService.hs +++ b/wizard-server/src/Wizard/Service/Tenant/Usage/UsageService.hs @@ -9,8 +9,8 @@ import Shared.Locale.Database.DAO.Locale.LocaleDAO import Wizard.Database.DAO.Document.DocumentDAO import Wizard.Database.DAO.DocumentTemplate.DocumentTemplateDraftDAO import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelEditorDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireFileDAO +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectFileDAO import Wizard.Database.DAO.Tenant.TenantLimitBundleDAO import Wizard.Database.DAO.User.UserDAO import Wizard.Model.Context.AclContext @@ -25,16 +25,16 @@ getUsage tenantUuid = do activeUserCount <- countActiveUsersWithTenant tenantUuid knowledgeModelEditorCount <- countKnowledgeModelEditorsWithTenant tenantUuid kmCount <- countPackagesGroupedByOrganizationIdAndKmIdWithTenant tenantUuid - qtnCount <- countQuestionnairesWithTenant tenantUuid + prjCount <- countProjectsWithTenant tenantUuid documentTemplateCount <- countDocumentTemplatesGroupedByOrganizationIdAndKmIdWithTenant tenantUuid documentTemplateDraftCount <- countDraftsGroupedByOrganizationIdAndKmIdWithTenant tenantUuid docCount <- countDocumentsWithTenant tenantUuid localeCount <- countLocalesGroupedByOrganizationIdAndLocaleIdWithTenant tenantUuid docSize <- sumDocumentFileSizeWithTenant tenantUuid templateAssetSize <- sumAssetFileSizeWithTenant tenantUuid - qtnFileSize <- sumQuestionnaireFileSizeWithTenant tenantUuid - let storageCount = docSize + templateAssetSize + qtnFileSize - return $ toDTO limitBundle userCount activeUserCount knowledgeModelEditorCount kmCount qtnCount documentTemplateCount documentTemplateDraftCount docCount localeCount storageCount + projectFileSize <- sumProjectFileSizeWithTenant tenantUuid + let storageCount = docSize + templateAssetSize + projectFileSize + return $ toDTO limitBundle userCount activeUserCount knowledgeModelEditorCount kmCount prjCount documentTemplateCount documentTemplateDraftCount docCount localeCount storageCount getUsageForCurrentTenant :: AppContextM WizardUsageDTO getUsageForCurrentTenant = do @@ -44,13 +44,13 @@ getUsageForCurrentTenant = do activeUserCount <- countActiveUsers knowledgeModelEditorCount <- countKnowledgeModelEditors kmCount <- countPackagesGroupedByOrganizationIdAndKmId - qtnCount <- countQuestionnaires + prjCount <- countProjects documentTemplateCount <- countDocumentTemplatesGroupedByOrganizationIdAndKmId documentTemplateDraftCount <- countDraftsGroupedByOrganizationIdAndKmId docCount <- countDocuments localeCount <- countLocalesGroupedByOrganizationIdAndLocaleId docSize <- sumDocumentFileSize templateAssetSize <- sumAssetFileSize - qtnFileSize <- sumQuestionnaireFileSize - let storageCount = docSize + templateAssetSize + qtnFileSize - return $ toDTO limitBundle userCount activeUserCount knowledgeModelEditorCount kmCount qtnCount documentTemplateCount documentTemplateDraftCount docCount localeCount storageCount + projectFileSize <- sumProjectFileSize + let storageCount = docSize + templateAssetSize + projectFileSize + return $ toDTO limitBundle userCount activeUserCount knowledgeModelEditorCount kmCount prjCount documentTemplateCount documentTemplateDraftCount docCount localeCount storageCount diff --git a/wizard-server/src/Wizard/Service/TypeHint/TypeHintService.hs b/wizard-server/src/Wizard/Service/TypeHint/TypeHintService.hs index a6dc5da8e..10ae6320a 100644 --- a/wizard-server/src/Wizard/Service/TypeHint/TypeHintService.hs +++ b/wizard-server/src/Wizard/Service/TypeHint/TypeHintService.hs @@ -14,7 +14,7 @@ import Wizard.Database.DAO.Common import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelEditorDAO import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelEditorEventDAO import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelSecretDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO +import Wizard.Database.DAO.Project.ProjectDAO import Wizard.Integration.Http.TypeHint.Runner import Wizard.Integration.Resource.TypeHint.TypeHintIDTO import Wizard.Localization.Messages.Public @@ -22,11 +22,11 @@ import Wizard.Model.Context.AclContext import Wizard.Model.Context.AppContext import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditor import Wizard.Model.KnowledgeModel.KnowledgeModelSecret -import Wizard.Model.Questionnaire.Questionnaire +import Wizard.Model.Project.Project import Wizard.Service.Config.Integration.IntegrationConfigService import Wizard.Service.KnowledgeModel.Editor.EditorMapper import Wizard.Service.KnowledgeModel.KnowledgeModelService -import Wizard.Service.Questionnaire.QuestionnaireAcl +import Wizard.Service.Project.ProjectAcl getLegacyTypeHints :: TypeHintLegacyRequestDTO -> AppContextM [TypeHintLegacyIDTO] getLegacyTypeHints reqDto = @@ -73,11 +73,11 @@ getTypeHints (KnowledgeModelEditorQuestionTypeHintRequest' reqDto) = case integration' of ApiIntegration' integration -> runApiIntegrationTypeHints integration question.variables reqDto.q _ -> throwError . UserError $ _ERROR_SERVICE_TYPEHINT__BAD_TYPE_OF_INTEGRATION -getTypeHints (QuestionnaireTypeHintRequest' reqDto) = +getTypeHints (ProjectTypeHintRequest' reqDto) = runInTransaction $ do - qtn <- findQuestionnaireByUuid reqDto.questionnaireUuid - checkEditPermissionToQtn qtn.visibility qtn.sharing qtn.permissions - km <- compileKnowledgeModel [] (Just qtn.knowledgeModelPackageId) [] + project <- findProjectByUuid reqDto.projectUuid + checkEditPermissionToProject project.visibility project.sharing project.permissions + km <- compileKnowledgeModel [] (Just project.knowledgeModelPackageId) [] question <- getQuestion km reqDto.questionUuid integration' <- getIntegration km question.integrationUuid case integration' of diff --git a/wizard-server/src/Wizard/Service/User/Group/UserGroupService.hs b/wizard-server/src/Wizard/Service/User/Group/UserGroupService.hs index a6c6e2cb5..526b930ce 100644 --- a/wizard-server/src/Wizard/Service/User/Group/UserGroupService.hs +++ b/wizard-server/src/Wizard/Service/User/Group/UserGroupService.hs @@ -9,16 +9,16 @@ import Shared.Common.Model.Common.Page import Shared.Common.Model.Common.Pageable import Shared.Common.Model.Common.Sort import Wizard.Database.DAO.Common -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnairePermDAO +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectPermDAO import Wizard.Database.DAO.User.UserDAO import Wizard.Database.DAO.User.UserGroupDAO import Wizard.Model.Context.AppContext import Wizard.Model.Context.ContextLenses () -import Wizard.Model.Questionnaire.QuestionnairePerm -import Wizard.Model.Questionnaire.QuestionnaireSimpleWithPerm +import Wizard.Model.Project.Acl.ProjectPerm +import Wizard.Model.Project.ProjectSimpleWithPerm import Wizard.Model.User.UserGroupSuggestion -import Wizard.Service.Questionnaire.Collaboration.CollaborationService +import Wizard.Service.Project.Collaboration.ProjectCollaborationService import Wizard.Service.User.Group.UserGroupAcl import Wizard.Service.User.Group.UserGroupMapper import WizardLib.Public.Api.Resource.User.Group.UserGroupDetailDTO @@ -56,12 +56,12 @@ modifyUserGroup uuid name description private = do deleteUserGroup :: U.UUID -> AppContextM () deleteUserGroup userGroupUuid = runInTransaction $ do - -- 1. Recompute all questionnaire permissions for websockets - questionnaires <- findQuestionnairesSimpleWithPermByUserGroupUuid userGroupUuid - let questionnairesWithoutUserGroup = fmap (\qtn -> qtn {permissions = filter (\qtnPerm -> qtnPerm.memberUuid /= userGroupUuid) qtn.permissions}) questionnaires - traverse_ (\qtn -> updatePermsForOnlineUsers qtn.uuid qtn.visibility qtn.sharing qtn.permissions) questionnairesWithoutUserGroup - -- 2. Delete questionnaire perm group - deleteQuestionnairePermGroupByUserGroupUuid userGroupUuid + -- 1. Recompute all project permissions for websockets + projects <- findProjectsSimpleWithPermByUserGroupUuid userGroupUuid + let projectsWithoutUserGroup = fmap (\project -> project {permissions = filter (\projectPerm -> projectPerm.memberUuid /= userGroupUuid) project.permissions}) projects + traverse_ (\project -> updatePermsForOnlineUsers project.uuid project.visibility project.sharing project.permissions) projectsWithoutUserGroup + -- 2. Delete project perm group + deleteProjectPermGroupByUserGroupUuid userGroupUuid -- 3. Delete user group memberships deleteUserGroupMembershipsByUserGroupUuid userGroupUuid -- 4. Delete user group diff --git a/wizard-server/src/Wizard/Service/User/GroupMembership/UserGroupMembershipService.hs b/wizard-server/src/Wizard/Service/User/GroupMembership/UserGroupMembershipService.hs index e75039f13..506bab10a 100644 --- a/wizard-server/src/Wizard/Service/User/GroupMembership/UserGroupMembershipService.hs +++ b/wizard-server/src/Wizard/Service/User/GroupMembership/UserGroupMembershipService.hs @@ -9,11 +9,11 @@ import qualified Data.UUID as U import Shared.Common.Util.List import Wizard.Database.DAO.Common -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO +import Wizard.Database.DAO.Project.ProjectDAO import Wizard.Model.Context.AppContext import Wizard.Model.Context.ContextLenses () -import Wizard.Model.Questionnaire.QuestionnaireSimpleWithPerm -import Wizard.Service.Questionnaire.Collaboration.CollaborationService +import Wizard.Model.Project.ProjectSimpleWithPerm +import Wizard.Service.Project.Collaboration.ProjectCollaborationService import Wizard.Service.User.GroupMembership.UserGroupMembershipMapper import WizardLib.Public.Database.DAO.User.UserGroupDAO import WizardLib.Public.Database.DAO.User.UserGroupMembershipDAO @@ -44,6 +44,6 @@ deleteUserGroupMembership userGroupUuid userUuids = do deleteUserGroupMembershipsByUserGroupUuidAndUserUuids userGroupUuid userUuids -- 2. Remove user group from cached websocket records removeUserGroupFromUsers userGroupUuid userUuids - -- 3. Recompute all questionnaire permissions for websockets - questionnaires <- findQuestionnairesSimpleWithPermByUserGroupUuid userGroupUuid - traverse_ (\qtn -> updatePermsForOnlineUsers qtn.uuid qtn.visibility qtn.sharing qtn.permissions) questionnaires + -- 3. Recompute all project permissions for websockets + projects <- findProjectsSimpleWithPermByUserGroupUuid userGroupUuid + traverse_ (\project -> updatePermsForOnlineUsers project.uuid project.visibility project.sharing project.permissions) projects diff --git a/wizard-server/src/Wizard/Util/Websocket.hs b/wizard-server/src/Wizard/Util/Websocket.hs index 0fbde3b71..f49a5fe18 100644 --- a/wizard-server/src/Wizard/Util/Websocket.hs +++ b/wizard-server/src/Wizard/Util/Websocket.hs @@ -67,7 +67,7 @@ exceptMyself :: U.UUID -> WebsocketRecord -> Bool exceptMyself myConnectionUuid record = record.connectionUuid /= myConnectionUuid filterByEntityId :: String -> WebsocketRecord -> Bool -filterByEntityId questionnaireUuid record = questionnaireUuid == record.entityId +filterByEntityId projectUuid record = projectUuid == record.entityId -- Accessors getCollaborators :: U.UUID -> String -> [WebsocketRecord] -> [OnlineUserInfo] diff --git a/wizard-server/src/Wizard/Worker/CronWorkers.hs b/wizard-server/src/Wizard/Worker/CronWorkers.hs index 4d4db6c42..c1fb6c842 100644 --- a/wizard-server/src/Wizard/Worker/CronWorkers.hs +++ b/wizard-server/src/Wizard/Worker/CronWorkers.hs @@ -15,9 +15,9 @@ import Wizard.Service.Document.DocumentCleanService import Wizard.Service.Feedback.FeedbackService import Wizard.Service.KnowledgeModel.Editor.Event.EditorEventService hiding (squash) import Wizard.Service.PersistentCommand.PersistentCommandService -import Wizard.Service.Questionnaire.Comment.QuestionnaireCommentService -import Wizard.Service.Questionnaire.Event.QuestionnaireEventService hiding (squash) -import Wizard.Service.Questionnaire.QuestionnaireService +import Wizard.Service.Project.Comment.ProjectCommentService +import Wizard.Service.Project.Event.ProjectEventService hiding (squash) +import Wizard.Service.Project.ProjectService import Wizard.Service.Registry.RegistryService import Wizard.Service.UserToken.ApiKey.ApiKeyService import WizardLib.Public.Service.TemporaryFile.TemporaryFileService @@ -32,8 +32,8 @@ workers = , squashKnowledgeModelEditorEventsWorker , persistentCommandRetryWorker , persistentCommandRetryLambdaWorker - , cleanQuestionnaireWorker - , squashQuestionnaireEventsWorker + , cleanProjectWorker + , squashProjectEventsWorker , assigneeNotificationWorker , registrySyncWorker , temporaryFileWorker @@ -69,9 +69,9 @@ documentWorker :: CronWorker BaseContext AppContextM documentWorker = CronWorker { name = "DocumentWorker" - , condition = (.serverConfig.questionnaire.clean.enabled) + , condition = (.serverConfig.project.clean.enabled) , cronDefault = "0 */4 * * *" - , cron = (.serverConfig.questionnaire.clean.cron) + , cron = (.serverConfig.project.clean.cron) , function = cleanDocuments , wrapInTransaction = True } @@ -120,25 +120,25 @@ persistentCommandRetryLambdaWorker = , wrapInTransaction = False } -cleanQuestionnaireWorker :: CronWorker BaseContext AppContextM -cleanQuestionnaireWorker = +cleanProjectWorker :: CronWorker BaseContext AppContextM +cleanProjectWorker = CronWorker - { name = "CleanQuestionnaireWorker" - , condition = (.serverConfig.questionnaire.clean.enabled) + { name = "CleanProjectWorker" + , condition = (.serverConfig.project.clean.enabled) , cronDefault = "15 */4 * * *" - , cron = (.serverConfig.questionnaire.clean.cron) - , function = cleanQuestionnaires + , cron = (.serverConfig.project.clean.cron) + , function = cleanProjects , wrapInTransaction = True } -squashQuestionnaireEventsWorker :: CronWorker BaseContext AppContextM -squashQuestionnaireEventsWorker = +squashProjectEventsWorker :: CronWorker BaseContext AppContextM +squashProjectEventsWorker = CronWorker - { name = "SquashQuestionnaireEventsWorker" - , condition = (.serverConfig.questionnaire.squash.enabled) + { name = "SquashProjectEventsWorker" + , condition = (.serverConfig.project.squash.enabled) , cronDefault = "*/4 * * * *" - , cron = (.serverConfig.questionnaire.squash.cron) - , function = squashQuestionnaireEvents + , cron = (.serverConfig.project.squash.cron) + , function = squashProjectEvents , wrapInTransaction = True } @@ -146,9 +146,9 @@ assigneeNotificationWorker :: CronWorker BaseContext AppContextM assigneeNotificationWorker = CronWorker { name = "AssigneeNotificationWorker" - , condition = (.serverConfig.questionnaire.assigneeNotification.enabled) + , condition = (.serverConfig.project.assigneeNotification.enabled) , cronDefault = "*/5 * * * *" - , cron = (.serverConfig.questionnaire.assigneeNotification.cron) + , cron = (.serverConfig.project.assigneeNotification.cron) , function = sendNotificationToNewAssignees , wrapInTransaction = True } diff --git a/wizard-server/test/Spec.hs b/wizard-server/test/Spec.hs index e02fa8616..185d0eb87 100644 --- a/wizard-server/test/Spec.hs +++ b/wizard-server/test/Spec.hs @@ -25,7 +25,6 @@ import Wizard.Service.User.UserMapper import Wizard.Specs.API.ApiKey.APISpec import Wizard.Specs.API.AppKey.APISpec -import Wizard.Specs.API.CommentThread.APISpec import Wizard.Specs.API.Config.APISpec import Wizard.Specs.API.Document.APISpec import Wizard.Specs.API.DocumentTemplate.APISpec @@ -42,17 +41,11 @@ import Wizard.Specs.API.KnowledgeModelEditor.APISpec import Wizard.Specs.API.KnowledgeModelPackage.APISpec import Wizard.Specs.API.KnowledgeModelSecret.APISpec import Wizard.Specs.API.Locale.APISpec -import qualified Wizard.Specs.API.Migration.KnowledgeModel.APISpec as KM_MigrationAPI -import qualified Wizard.Specs.API.Migration.Questionnaire.APISpec as QTN_MigrationAPI import Wizard.Specs.API.Prefab.APISpec -import Wizard.Specs.API.Questionnaire.APISpec -import Wizard.Specs.API.Questionnaire.Comment.APISpec -import Wizard.Specs.API.Questionnaire.Event.APISpec -import Wizard.Specs.API.Questionnaire.ProjectTag.APISpec -import Wizard.Specs.API.Questionnaire.User.APISpec -import Wizard.Specs.API.Questionnaire.Version.APISpec -import Wizard.Specs.API.QuestionnaireAction.APISpec -import Wizard.Specs.API.QuestionnaireImporter.APISpec +import Wizard.Specs.API.Project.APISpec +import Wizard.Specs.API.ProjectAction.APISpec +import Wizard.Specs.API.ProjectCommentThread.APISpec +import Wizard.Specs.API.ProjectImporter.APISpec import Wizard.Specs.API.Submission.APISpec import Wizard.Specs.API.Swagger.APISpec import Wizard.Specs.API.Tenant.APISpec @@ -78,15 +71,15 @@ import qualified Wizard.Specs.Service.KnowledgeModel.Migration.Migrator.Sanitize import Wizard.Specs.Service.KnowledgeModel.Package.PackageUtilSpec import Wizard.Specs.Service.KnowledgeModel.Package.PackageValidationSpec import Wizard.Specs.Service.KnowledgeModel.Squash.SquasherSpec -import Wizard.Specs.Service.Questionnaire.Collaboration.CollaborationAclSpec -import Wizard.Specs.Service.Questionnaire.Compiler.CompilerServiceSpec -import Wizard.Specs.Service.Questionnaire.Event.QuestionnaireEventServiceSpec -import qualified Wizard.Specs.Service.Questionnaire.Migration.Migrator.ChangeQTypeSanitizerSpec as QTN_ChangeQTypeSanitizer -import qualified Wizard.Specs.Service.Questionnaire.Migration.Migrator.MoveSanitizerSpec as QTN_MoveSanitizerSpec -import qualified Wizard.Specs.Service.Questionnaire.Migration.Migrator.SanitizerSpec as QTN_SanitizerSpec -import Wizard.Specs.Service.Questionnaire.QuestionnaireAclSpec -import Wizard.Specs.Service.Questionnaire.QuestionnaireServiceSpec -import Wizard.Specs.Service.Questionnaire.QuestionnaireValidationSpec +import Wizard.Specs.Service.Project.Collaboration.ProjectCollaborationAclSpec +import Wizard.Specs.Service.Project.Compiler.ProjectCompilerServiceSpec +import Wizard.Specs.Service.Project.Event.ProjectEventServiceSpec +import qualified Wizard.Specs.Service.Project.Migration.Migrator.ChangeQTypeSanitizerSpec as PRJ_ChangeQTypeSanitizer +import qualified Wizard.Specs.Service.Project.Migration.Migrator.MoveSanitizerSpec as PRJ_MoveSanitizerSpec +import qualified Wizard.Specs.Service.Project.Migration.Migrator.SanitizerSpec as PRJ_SanitizerSpec +import Wizard.Specs.Service.Project.ProjectAclSpec +import Wizard.Specs.Service.Project.ProjectServiceSpec +import Wizard.Specs.Service.Project.ProjectValidationSpec import Wizard.Specs.Service.Report.ReportGeneratorSpec import Wizard.Specs.Service.Tenant.Config.TenantConfigValidationSpec import Wizard.Specs.Service.Tenant.TenantValidationSpec @@ -94,7 +87,7 @@ import Wizard.Specs.Service.User.UserServiceSpec import Wizard.Specs.Util.JinjaSpec import Wizard.Specs.Websocket.Common import Wizard.Specs.Websocket.KnowledgeModelEditor.Detail.WebsocketSpec -import Wizard.Specs.Websocket.Questionnaire.Detail.WebsocketSpec +import Wizard.Specs.Websocket.Project.Detail.WebsocketSpec import Wizard.TestMigration hLoadConfig fileName loadFn callback = do @@ -167,6 +160,10 @@ main = describe "SERVICE" $ do describe "Document Template" documentTemplateUtilSpec describe "KnowledgeModel" $ do + describe "Metamodel" $ + describe + "Migration" + eventMigratorSpec describe "Compiler" $ do describe "Modifier" modifierSpec compilerSpec @@ -174,16 +171,14 @@ main = describe "Squash" $ do squasherSpec knowledgeModelFilterSpec describe "Migration" $ do - describe "Metamodel" $ describe "Migrator" $ do - eventMigratorSpec - describe "Questionnaire" $ describe "Migrator" $ do - QTN_ChangeQTypeSanitizer.sanitizerSpec - QTN_MoveSanitizerSpec.sanitizerSpec - describe "Questionnaire" $ do + describe "Project" $ describe "Migration" $ do + PRJ_ChangeQTypeSanitizer.sanitizerSpec + PRJ_MoveSanitizerSpec.sanitizerSpec + describe "Project" $ do describe "Event" $ do - questionnaireCompilerServiceSpec - questionnaireEventServiceSpec - questionnaireValidationSpec + projectCompilerServiceSpec + projectEventServiceSpec + projectValidationSpec describe "Report" reportGeneratorSpec describe "Tenant" $ do describe "Config" tenantConfigValidationSpec @@ -192,7 +187,6 @@ main = describe "API" $ do apiKeyAPI baseContext appContext appKeyAPI baseContext appContext - commentThreadAPI baseContext appContext configAPI baseContext appContext documentAPI baseContext appContext documentTemplateAPI baseContext appContext @@ -209,17 +203,11 @@ main = knowledgeModelPackageAPI baseContext appContext knowledgeModelSecretAPI baseContext appContext localeAPI baseContext appContext - KM_MigrationAPI.migrationAPI baseContext appContext - QTN_MigrationAPI.migrationAPI baseContext appContext prefabAPI baseContext appContext - questionnaireAPI baseContext appContext - questionnaireCommentAPI baseContext appContext - questionnaireEventAPI baseContext appContext - questionnaireProjectTagAPI baseContext appContext - questionnaireUserAPI baseContext appContext - questionnaireVersionAPI baseContext appContext - questionnaireActionAPI baseContext appContext - questionnaireImporterAPI baseContext appContext + projectAPI baseContext appContext + projectActionAPI baseContext appContext + projectCommentThreadAPI baseContext appContext + projectImporterAPI baseContext appContext submissionAPI baseContext appContext swaggerAPI baseContext appContext tenantAPI baseContext appContext @@ -235,23 +223,22 @@ main = describe "SERVICE" $ do documentIntegrationSpec appContext describe "KnowledgeModel" $ do - describe "Editor" $ knowledgeModelEditorServiceSpec appContext - describe "Migration" $ - describe "Migrator" $ do + describe "Editor" $ do + describe "Migration" $ do migratorSpec appContext KM_SanitizerSpec.sanitizerSpec appContext + knowledgeModelEditorServiceSpec appContext describe "Package" $ packageValidationSpec appContext - describe "Questionnaire" $ do + describe "Project" $ do describe "Migration" $ - describe "Migrator" $ - QTN_SanitizerSpec.sanitizerIntegrationSpec appContext - questionnaireAclSpec appContext - questionnaireCollaborationAclSpec appContext - questionnaireServiceSpec appContext + PRJ_SanitizerSpec.sanitizerIntegrationSpec appContext + projectAclSpec appContext + projectCollaborationAclSpec appContext + projectServiceSpec appContext userServiceIntegrationSpec appContext describe "UTIL" $ do jinjaSpec describe "WEBSOCKET" $ do knowledgeModelEditorWebsocketAPI appContext - questionnaireWebsocketAPI appContext + projectWebsocketAPI appContext ) diff --git a/wizard-server/test/Wizard/Specs/API/CommentThread/APISpec.hs b/wizard-server/test/Wizard/Specs/API/CommentThread/APISpec.hs deleted file mode 100644 index 5fe223b2c..000000000 --- a/wizard-server/test/Wizard/Specs/API/CommentThread/APISpec.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Wizard.Specs.API.CommentThread.APISpec where - -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) - -import Wizard.Specs.API.Common - -import Wizard.Specs.API.CommentThread.List_GET - -commentThreadAPI baseContext appContext = - with (startWebApp baseContext appContext) $ - describe "COMMENT THREAD API Spec" $ do - list_GET appContext diff --git a/wizard-server/test/Wizard/Specs/API/CommentThread/List_GET.hs b/wizard-server/test/Wizard/Specs/API/CommentThread/List_GET.hs deleted file mode 100644 index e2796e7b5..000000000 --- a/wizard-server/test/Wizard/Specs/API/CommentThread/List_GET.hs +++ /dev/null @@ -1,104 +0,0 @@ -module Wizard.Specs.API.CommentThread.List_GET ( - list_GET, -) where - -import Data.Aeson (encode) -import Data.Foldable (traverse_) -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.PageMetadata -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Database.DAO.Questionnaire.QuestionnaireCommentDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireCommentThreadDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireComments -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Database.Migration.Development.User.Data.Users -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireComment -import Wizard.Model.Questionnaire.QuestionnaireCommentThreadAssigned -import Wizard.Model.User.User - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- GET /wizard-api/comment-threads --- ------------------------------------------------------------------------ -list_GET :: AppContext -> SpecWith ((), Application) -list_GET appContext = - describe "GET /wizard-api/comment-threads" $ do - test_200 appContext - test_401 appContext - test_403 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodGet - -reqUrl = "/wizard-api/comment-threads?sort=updatedAt,desc" - -reqHeadersT reqAuthHeader = [reqAuthHeader] - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = - it "HTTP 200 OK" $ - -- GIVEN: Prepare request - do - let reqHeaders = reqHeadersT reqAuthHeader - -- AND: Run migrations - runInContextIO TML_Migration.runMigration appContext - runInContextIO (insertPackage germanyKmPackage) appContext - runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - runInContextIO (insertQuestionnaire questionnaire1) appContext - -- AND: Create thread without assignee - thread1 <- liftIO . create_cmtQ1_t1 $ questionnaire1.uuid - comment1_1 <- liftIO . create_cmtQ1_t1_1 $ thread1.uuid - comment1_2 <- liftIO . create_cmtQ1_t1_2 $ thread1.uuid - runInContextIO (insertQuestionnaireCommentThread thread1) appContext - runInContextIO (insertQuestionnaireComment comment1_1) appContext - runInContextIO (insertQuestionnaireComment comment1_2) appContext - -- AND: Create thread with assignee - thread2 <- liftIO . create_cmtQ1_t1 $ questionnaire1.uuid - comment2_1 <- liftIO . create_cmtQ1_t1_1 $ thread2.uuid - comment2_2 <- liftIO . create_cmtQ1_t1_2 $ thread2.uuid - runInContextIO (insertQuestionnaireCommentThread (thread2 {assignedTo = Just userAlbert.uuid})) appContext - runInContextIO (insertQuestionnaireComment comment2_1) appContext - runInContextIO (insertQuestionnaireComment comment2_2) appContext - -- AND: Prepare expectation - let expStatus = 200 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = Page "commentThreads" (PageMetadata 20 1 1 0) [cmtAssigned {commentThreadUuid = thread2.uuid}] - let expBody = encode expDto - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod reqUrl [] reqBody - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [] reqBody "QTN_PERM" diff --git a/wizard-server/test/Wizard/Specs/API/Config/Common.hs b/wizard-server/test/Wizard/Specs/API/Config/Common.hs index 6c17a3da3..34f1cc2ad 100644 --- a/wizard-server/test/Wizard/Specs/API/Config/Common.hs +++ b/wizard-server/test/Wizard/Specs/API/Config/Common.hs @@ -12,11 +12,11 @@ import Wizard.Specs.Common -- -------------------------------- -- ASSERTS -- -------------------------------- -assertExistenceOfTenantConfigQuestionnaireInDB appContext tcQuestionnaire = do - eitherTcQuestionnaire <- runInContextIO getCurrentTenantConfigQuestionnaire appContext - liftIO $ isRight eitherTcQuestionnaire `shouldBe` True - let (Right tcQuestionnaireFromDb) = eitherTcQuestionnaire - compareDtos tcQuestionnaireFromDb tcQuestionnaire +assertExistenceOfTenantConfigProjectInDB appContext tcProject = do + eitherTcProject <- runInContextIO getCurrentTenantConfigProject appContext + liftIO $ isRight eitherTcProject `shouldBe` True + let (Right tcProjectFromDb) = eitherTcProject + compareDtos tcProjectFromDb tcProject -- -------------------------------- -- COMPARATORS diff --git a/wizard-server/test/Wizard/Specs/API/Config/List_Bootstrap_GET.hs b/wizard-server/test/Wizard/Specs/API/Config/List_Bootstrap_GET.hs index a57572212..2c6fdd7c3 100644 --- a/wizard-server/test/Wizard/Specs/API/Config/List_Bootstrap_GET.hs +++ b/wizard-server/test/Wizard/Specs/API/Config/List_Bootstrap_GET.hs @@ -54,7 +54,7 @@ create_test_200 title appContext authHeaders mUserProfile = -- AND: Prepare expectation let expStatus = 200 let expHeaders = resCtHeader : resCorsHeaders - let expDto = toClientConfigDTO appContext.serverConfig defaultOrganization defaultAuthentication defaultPrivacyAndSupport defaultDashboardAndLoginScreen defaultLookAndFeel defaultRegistry defaultQuestionnaire defaultSubmission defaultFeatures defaultOwl mUserProfile [] defaultTenant + let expDto = toClientConfigDTO appContext.serverConfig defaultOrganization defaultAuthentication defaultPrivacyAndSupport defaultDashboardAndLoginScreen defaultLookAndFeel defaultRegistry defaultProject defaultSubmission defaultFeatures defaultOwl mUserProfile [] defaultTenant let expBody = encode expDto -- AND: Run migrations runInContextIO U.runMigration appContext diff --git a/wizard-server/test/Wizard/Specs/API/Document/Common.hs b/wizard-server/test/Wizard/Specs/API/Document/Common.hs index 5156e449f..c026213a6 100644 --- a/wizard-server/test/Wizard/Specs/API/Document/Common.hs +++ b/wizard-server/test/Wizard/Specs/API/Document/Common.hs @@ -23,7 +23,7 @@ import Wizard.Specs.Common assertExistenceOfDocumentInDB appContext reqDto = do docFromDb <- getFirstFromDB findDocuments appContext liftIO $ docFromDb.name `shouldBe` reqDto.name - liftIO $ docFromDb.questionnaireUuid `shouldBe` Just reqDto.questionnaireUuid + liftIO $ docFromDb.projectUuid `shouldBe` Just reqDto.projectUuid liftIO $ docFromDb.documentTemplateId `shouldBe` reqDto.documentTemplateId liftIO $ docFromDb.formatUuid `shouldBe` reqDto.formatUuid @@ -41,5 +41,5 @@ assertAbsenceOfDocumentInDB appContext doc = do -- -------------------------------- compareDocumentDtos resDto expDto = do liftIO $ resDto.name `shouldBe` expDto.name - liftIO $ (fromJust resDto.questionnaire).uuid `shouldBe` expDto.questionnaireUuid + liftIO $ (fromJust resDto.project).uuid `shouldBe` expDto.projectUuid liftIO $ (fmap (.uuid) resDto.format) `shouldBe` Just expDto.formatUuid diff --git a/wizard-server/test/Wizard/Specs/API/Document/Detail_Available_Submission_Services_GET.hs b/wizard-server/test/Wizard/Specs/API/Document/Detail_Available_Submission_Services_GET.hs index 392605779..fa878a18d 100644 --- a/wizard-server/test/Wizard/Specs/API/Document/Detail_Available_Submission_Services_GET.hs +++ b/wizard-server/test/Wizard/Specs/API/Document/Detail_Available_Submission_Services_GET.hs @@ -13,18 +13,18 @@ import Shared.Common.Api.Resource.Error.ErrorJM () import Shared.Common.Localization.Messages.Public import Shared.Common.Model.Error.Error import Wizard.Database.DAO.Document.DocumentDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO +import Wizard.Database.DAO.Project.ProjectDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigSubmissionDAO import Wizard.Database.Migration.Development.Document.Data.Documents import Wizard.Database.Migration.Development.Document.DocumentMigration as DOC_Migration import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN_Migration +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ_Migration import Wizard.Database.Migration.Development.Tenant.Data.TenantConfigs import qualified Wizard.Database.Migration.Development.User.UserMigration as U_Migration import Wizard.Model.Context.AppContext import Wizard.Model.Document.Document -import Wizard.Model.Questionnaire.Questionnaire +import Wizard.Model.Project.Project import Wizard.Service.Tenant.Config.ConfigMapper import SharedTest.Specs.API.Common @@ -57,10 +57,10 @@ reqBody = "" -- ---------------------------------------------------- -- ---------------------------------------------------- test_200 appContext = do - create_test_200 "HTTP 200 OK (Owner, Private)" appContext questionnaire1 [reqAuthHeader] - create_test_200 "HTTP 200 OK (Non-Owner, VisibleEdit)" appContext questionnaire3 [reqNonAdminAuthHeader] + create_test_200 "HTTP 200 OK (Owner, Private)" appContext project1 [reqAuthHeader] + create_test_200 "HTTP 200 OK (Non-Owner, VisibleEdit)" appContext project3 [reqNonAdminAuthHeader] -create_test_200 title appContext qtn authHeader = +create_test_200 title appContext project authHeader = it title $ -- GIVEN: Prepare request do @@ -73,11 +73,11 @@ create_test_200 title appContext qtn authHeader = -- AND: Run migrations runInContextIO U_Migration.runMigration appContext runInContextIO TML_Migration.runMigration appContext - runInContextIO QTN_Migration.runMigration appContext - runInContextIO (insertQuestionnaire questionnaire10) appContext + runInContextIO PRJ_Migration.runMigration appContext + runInContextIO (insertProject project10) appContext runInContextIO DOC_Migration.runMigration appContext runInContextIO (deleteDocumentByUuid doc1.uuid) appContext - runInContextIO (insertDocument (doc1 {questionnaireUuid = Just qtn.uuid})) appContext + runInContextIO (insertDocument (doc1 {projectUuid = Just project.uuid})) appContext runInContextIO (insertOrUpdateConfigSubmissionService defaultSubmissionService) appContext -- WHEN: Call API response <- request reqMethod reqUrl reqHeaders reqBody @@ -98,17 +98,17 @@ test_403 appContext = do create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, Private)" appContext - questionnaire1 + project1 [reqNonAdminAuthHeader] - (_ERROR_VALIDATION__FORBIDDEN "Edit Questionnaire") + (_ERROR_VALIDATION__FORBIDDEN "Edit Project") create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, VisibleView)" appContext - questionnaire2 + project2 [reqNonAdminAuthHeader] - (_ERROR_VALIDATION__FORBIDDEN "Edit Questionnaire") + (_ERROR_VALIDATION__FORBIDDEN "Edit Project") -create_test_403 title appContext qtn authHeader errorMessage = +create_test_403 title appContext project authHeader errorMessage = it title $ -- GIVEN: Prepare request do @@ -121,11 +121,11 @@ create_test_403 title appContext qtn authHeader errorMessage = -- AND: Run migrations runInContextIO U_Migration.runMigration appContext runInContextIO TML_Migration.runMigration appContext - runInContextIO QTN_Migration.runMigration appContext + runInContextIO PRJ_Migration.runMigration appContext runInContextIO DOC_Migration.runMigration appContext - runInContextIO (insertQuestionnaire questionnaire7) appContext + runInContextIO (insertProject project7) appContext runInContextIO (deleteDocumentByUuid doc1.uuid) appContext - runInContextIO (insertDocument (doc1 {questionnaireUuid = Just qtn.uuid})) appContext + runInContextIO (insertDocument (doc1 {projectUuid = Just project.uuid})) appContext -- WHEN: Call API response <- request reqMethod reqUrl reqHeaders reqBody -- THEN: Compare response with expectation diff --git a/wizard-server/test/Wizard/Specs/API/Document/Detail_DELETE.hs b/wizard-server/test/Wizard/Specs/API/Document/Detail_DELETE.hs index c452bf0b3..867c60347 100644 --- a/wizard-server/test/Wizard/Specs/API/Document/Detail_DELETE.hs +++ b/wizard-server/test/Wizard/Specs/API/Document/Detail_DELETE.hs @@ -13,16 +13,16 @@ import Shared.Common.Api.Resource.Error.ErrorJM () import Shared.Common.Localization.Messages.Public import Shared.Common.Model.Error.Error import Wizard.Database.DAO.Document.DocumentDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO +import Wizard.Database.DAO.Project.ProjectDAO import Wizard.Database.Migration.Development.Document.Data.Documents import Wizard.Database.Migration.Development.Document.DocumentMigration as DOC_Migration import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN_Migration +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ_Migration import qualified Wizard.Database.Migration.Development.User.UserMigration as U_Migration import Wizard.Model.Context.AppContext import Wizard.Model.Document.Document -import Wizard.Model.Questionnaire.Questionnaire +import Wizard.Model.Project.Project import SharedTest.Specs.API.Common import Wizard.Specs.API.Common @@ -54,10 +54,10 @@ reqBody = "" -- ---------------------------------------------------- -- ---------------------------------------------------- test_204 appContext = do - create_test_204 "HTTP 204 NO CONTENT (Owner, Private)" appContext questionnaire1 [reqAuthHeader] - create_test_204 "HTTP 204 NO CONTENT (Non-Owner, VisibleEdit)" appContext questionnaire3 [reqNonAdminAuthHeader] + create_test_204 "HTTP 204 NO CONTENT (Owner, Private)" appContext project1 [reqAuthHeader] + create_test_204 "HTTP 204 NO CONTENT (Non-Owner, VisibleEdit)" appContext project3 [reqNonAdminAuthHeader] -create_test_204 title appContext qtn authHeader = +create_test_204 title appContext project authHeader = it title $ -- GIVEN: Prepare request do @@ -69,11 +69,11 @@ create_test_204 title appContext qtn authHeader = -- AND: Run migrations runInContextIO U_Migration.runMigration appContext runInContextIO TML_Migration.runMigration appContext - runInContextIO QTN_Migration.runMigration appContext - runInContextIO (insertQuestionnaire questionnaire10) appContext + runInContextIO PRJ_Migration.runMigration appContext + runInContextIO (insertProject project10) appContext runInContextIO DOC_Migration.runMigration appContext runInContextIO (deleteDocumentByUuid doc1.uuid) appContext - runInContextIO (insertDocument (doc1 {questionnaireUuid = Just qtn.uuid})) appContext + runInContextIO (insertDocument (doc1 {projectUuid = Just project.uuid})) appContext -- WHEN: Call API response <- request reqMethod reqUrl reqHeaders reqBody -- THEN: Compare response with expectation @@ -95,17 +95,17 @@ test_403 appContext = do create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, Private)" appContext - questionnaire1 + project1 [reqNonAdminAuthHeader] - (_ERROR_VALIDATION__FORBIDDEN "Edit Questionnaire") + (_ERROR_VALIDATION__FORBIDDEN "Edit Project") create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, VisibleView)" appContext - questionnaire2 + project2 [reqNonAdminAuthHeader] - (_ERROR_VALIDATION__FORBIDDEN "Edit Questionnaire") + (_ERROR_VALIDATION__FORBIDDEN "Edit Project") -create_test_403 title appContext qtn authHeader errorMessage = +create_test_403 title appContext project authHeader errorMessage = it title $ -- GIVEN: Prepare request do @@ -118,11 +118,11 @@ create_test_403 title appContext qtn authHeader errorMessage = -- AND: Run migrations runInContextIO U_Migration.runMigration appContext runInContextIO TML_Migration.runMigration appContext - runInContextIO QTN_Migration.runMigration appContext + runInContextIO PRJ_Migration.runMigration appContext runInContextIO DOC_Migration.runMigration appContext - runInContextIO (insertQuestionnaire questionnaire7) appContext + runInContextIO (insertProject project7) appContext runInContextIO (deleteDocumentByUuid doc1.uuid) appContext - runInContextIO (insertDocument (doc1 {questionnaireUuid = Just qtn.uuid})) appContext + runInContextIO (insertDocument (doc1 {projectUuid = Just project.uuid})) appContext -- WHEN: Call API response <- request reqMethod reqUrl reqHeaders reqBody -- THEN: Compare response with expectation diff --git a/wizard-server/test/Wizard/Specs/API/Document/List_GET.hs b/wizard-server/test/Wizard/Specs/API/Document/List_GET.hs index 61338179c..fa2e7784b 100644 --- a/wizard-server/test/Wizard/Specs/API/Document/List_GET.hs +++ b/wizard-server/test/Wizard/Specs/API/Document/List_GET.hs @@ -20,8 +20,8 @@ import Wizard.Api.Resource.Document.DocumentDTO import Wizard.Database.Migration.Development.Document.Data.Documents import Wizard.Database.Migration.Development.Document.DocumentMigration as DOC_Migration import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN_Migration +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ_Migration import qualified Wizard.Database.Migration.Development.User.UserMigration as U_Migration import Wizard.Model.Context.AppContext import Wizard.Service.Document.DocumentMapper @@ -62,16 +62,16 @@ test_200 appContext = do ( Page "documents" (PageMetadata 20 3 1 0) - [ toDTOWithDocTemplate doc1 questionnaire1 (Just "Version 1") [] wizardDocumentTemplate formatJsonSimple - , toDTOWithDocTemplate doc2 questionnaire2 (Just "Version 1") [] wizardDocumentTemplate formatJsonSimple - , toDTOWithDocTemplate doc3 questionnaire2 (Just "Version 1") [] wizardDocumentTemplate formatJsonSimple + [ toDTOWithDocTemplate doc1 project1 (Just "Version 1") [] wizardDocumentTemplate formatJsonSimple + , toDTOWithDocTemplate doc2 project2 (Just "Version 1") [] wizardDocumentTemplate formatJsonSimple + , toDTOWithDocTemplate doc3 project2 (Just "Version 1") [] wizardDocumentTemplate formatJsonSimple ] ) create_test_200 "HTTP 200 OK (query)" appContext "/wizard-api/documents?q=My exported document 2" - (Page "documents" (PageMetadata 20 1 1 0) [toDTOWithDocTemplate doc2 questionnaire2 (Just "Version 1") [] wizardDocumentTemplate formatJsonSimple]) + (Page "documents" (PageMetadata 20 1 1 0) [toDTOWithDocTemplate doc2 project2 (Just "Version 1") [] wizardDocumentTemplate formatJsonSimple]) create_test_200 "HTTP 200 OK (query for non-existing)" appContext @@ -80,13 +80,13 @@ test_200 appContext = do create_test_200 "HTTP 200 OK (documentTemplateId)" appContext - "/wizard-api/documents?documentTemplateId=global:questionnaire-report:1.0.0&sort=name,asc" + "/wizard-api/documents?documentTemplateId=global:project-report:1.0.0&sort=name,asc" ( Page "documents" (PageMetadata 20 3 1 0) - [ toDTOWithDocTemplate doc1 questionnaire1 (Just "Version 1") [] wizardDocumentTemplate formatJsonSimple - , toDTOWithDocTemplate doc2 questionnaire2 (Just "Version 1") [] wizardDocumentTemplate formatJsonSimple - , toDTOWithDocTemplate doc3 questionnaire2 (Just "Version 1") [] wizardDocumentTemplate formatJsonSimple + [ toDTOWithDocTemplate doc1 project1 (Just "Version 1") [] wizardDocumentTemplate formatJsonSimple + , toDTOWithDocTemplate doc2 project2 (Just "Version 1") [] wizardDocumentTemplate formatJsonSimple + , toDTOWithDocTemplate doc3 project2 (Just "Version 1") [] wizardDocumentTemplate formatJsonSimple ] ) @@ -102,7 +102,7 @@ create_test_200 title appContext reqUrl expDto = -- AND: Run migrations runInContextIO U_Migration.runMigration appContext runInContextIO TML_Migration.runMigration appContext - runInContextIO QTN_Migration.runMigration appContext + runInContextIO PRJ_Migration.runMigration appContext runInContextIO DOC_Migration.runMigration appContext -- WHEN: Call API response <- request reqMethod reqUrl reqHeaders reqBody @@ -132,7 +132,7 @@ test_403 appContext = -- AND: Run migrations runInContextIO U_Migration.runMigration appContext runInContextIO TML_Migration.runMigration appContext - runInContextIO QTN_Migration.runMigration appContext + runInContextIO PRJ_Migration.runMigration appContext runInContextIO DOC_Migration.runMigration appContext -- WHEN: Call API response <- request reqMethod reqUrl reqHeaders reqBody diff --git a/wizard-server/test/Wizard/Specs/API/Document/List_POST.hs b/wizard-server/test/Wizard/Specs/API/Document/List_POST.hs index b4c998c4a..0af702778 100644 --- a/wizard-server/test/Wizard/Specs/API/Document/List_POST.hs +++ b/wizard-server/test/Wizard/Specs/API/Document/List_POST.hs @@ -27,14 +27,14 @@ import Wizard.Api.Resource.Document.DocumentJM () import Wizard.Database.DAO.Document.DocumentDAO import Wizard.Database.Migration.Development.Document.Data.Documents import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN_Migration +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ_Migration import qualified Wizard.Database.Migration.Development.User.UserMigration as U_Migration import Wizard.Model.Context.AppContext import Wizard.Model.Document.Document -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireEventLenses () -import Wizard.Model.Questionnaire.QuestionnaireSimple +import Wizard.Model.Project.Event.ProjectEventLenses () +import Wizard.Model.Project.Project +import Wizard.Model.Project.ProjectSimple import SharedTest.Specs.API.Common import Wizard.Specs.API.Common @@ -61,30 +61,30 @@ reqUrl = "/wizard-api/documents" reqHeadersT authHeader = reqCtHeader : authHeader -reqDtoT qtn qtnEvents = +reqDtoT project projectEvents = DocumentCreateDTO { name = "Document" - , questionnaireUuid = qtn.uuid - , questionnaireEventUuid = Just . getUuid . last $ qtnEvents + , projectUuid = project.uuid + , projectEventUuid = Just . getUuid . last $ projectEvents , documentTemplateId = doc1.documentTemplateId , formatUuid = doc1.formatUuid } -reqBodyT qtn qtnEvents = encode $ reqDtoT qtn qtnEvents +reqBodyT project projectEvents = encode $ reqDtoT project projectEvents -- ---------------------------------------------------- -- ---------------------------------------------------- -- ---------------------------------------------------- test_201 appContext = do - create_test_201 "HTTP 201 CREATED (Owner, Private)" appContext questionnaire1 questionnaire1Events [reqAuthHeader] - create_test_201 "HTTP 201 CREATED (Non-Owner, VisibleEdit)" appContext questionnaire3 questionnaire3Events [reqNonAdminAuthHeader] + create_test_201 "HTTP 201 CREATED (Owner, Private)" appContext project1 project1Events [reqAuthHeader] + create_test_201 "HTTP 201 CREATED (Non-Owner, VisibleEdit)" appContext project3 project3Events [reqNonAdminAuthHeader] -create_test_201 title appContext qtn qtnEvents authHeader = +create_test_201 title appContext project projectEvents authHeader = it title $ -- GIVEN: Prepare request do let reqHeaders = reqHeadersT authHeader - let reqDto = reqDtoT qtn qtnEvents + let reqDto = reqDtoT project projectEvents let reqBody = encode reqDto -- AND: Prepare expectation let expStatus = 201 @@ -92,7 +92,7 @@ create_test_201 title appContext qtn qtnEvents authHeader = -- AND: Run migrations runInContextIO U_Migration.runMigration appContext runInContextIO TML_Migration.runMigration appContext - runInContextIO QTN_Migration.runMigration appContext + runInContextIO PRJ_Migration.runMigration appContext runInContextIO deleteDocuments appContext -- WHEN: Call API response <- request reqMethod reqUrl reqHeaders reqBody @@ -114,7 +114,7 @@ test_400 appContext = do -- GIVEN: Prepare request do let reqHeaders = reqHeadersT [reqAuthHeader] - let reqDto = reqDtoT questionnaire1 questionnaire1Events + let reqDto = reqDtoT project1 project1Events let reqBody = encode reqDto -- AND: Prepare expectation let expStatus = 400 @@ -126,7 +126,7 @@ test_400 appContext = do -- AND: Run migrations runInContextIO U_Migration.runMigration appContext runInContextIO TML_Migration.runMigration appContext - runInContextIO QTN_Migration.runMigration appContext + runInContextIO PRJ_Migration.runMigration appContext runInContextIO (updateDocumentTemplateById (wizardDocumentTemplate {metamodelVersion = SemVer2Tuple 1 0})) appContext runInContextIO deleteDocuments appContext -- WHEN: Call API @@ -141,7 +141,7 @@ test_400 appContext = do -- ---------------------------------------------------- -- ---------------------------------------------------- -- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod reqUrl [reqCtHeader] (reqBodyT questionnaire1 questionnaire1Events) +test_401 appContext = createAuthTest reqMethod reqUrl [reqCtHeader] (reqBodyT project1 project1Events) -- ---------------------------------------------------- -- ---------------------------------------------------- @@ -150,24 +150,24 @@ test_403 appContext = do create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, Private)" appContext - questionnaire1 - questionnaire1Events + project1 + project1Events [reqNonAdminAuthHeader] - (_ERROR_VALIDATION__FORBIDDEN "Edit Questionnaire") + (_ERROR_VALIDATION__FORBIDDEN "Edit Project") create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, VisibleView)" appContext - questionnaire2 - questionnaire2Events + project2 + project2Events [reqNonAdminAuthHeader] - (_ERROR_VALIDATION__FORBIDDEN "Edit Questionnaire") + (_ERROR_VALIDATION__FORBIDDEN "Edit Project") -create_test_403 title appContext qtn qtnEvents authHeader errorMessage = +create_test_403 title appContext project projectEvents authHeader errorMessage = it title $ -- GIVEN: Prepare request do let reqHeaders = reqHeadersT authHeader - let reqDto = reqDtoT qtn qtnEvents + let reqDto = reqDtoT project projectEvents let reqBody = encode reqDto -- AND: Prepare expectation let expStatus = 403 @@ -177,7 +177,7 @@ create_test_403 title appContext qtn qtnEvents authHeader errorMessage = -- AND: Run migrations runInContextIO U_Migration.runMigration appContext runInContextIO TML_Migration.runMigration appContext - runInContextIO QTN_Migration.runMigration appContext + runInContextIO PRJ_Migration.runMigration appContext runInContextIO deleteDocuments appContext -- WHEN: Call API response <- request reqMethod reqUrl reqHeaders reqBody diff --git a/wizard-server/test/Wizard/Specs/API/DocumentTemplate/Detail_DELETE.hs b/wizard-server/test/Wizard/Specs/API/DocumentTemplate/Detail_DELETE.hs index 773f9f461..5e327242d 100644 --- a/wizard-server/test/Wizard/Specs/API/DocumentTemplate/Detail_DELETE.hs +++ b/wizard-server/test/Wizard/Specs/API/DocumentTemplate/Detail_DELETE.hs @@ -14,7 +14,7 @@ import Shared.DocumentTemplate.Database.DAO.DocumentTemplate.DocumentTemplateDAO import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplates import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplate import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN_Migration +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ_Migration import Wizard.Localization.Messages.Public import Wizard.Model.Context.AppContext @@ -39,7 +39,7 @@ detail_DELETE appContext = -- ---------------------------------------------------- reqMethod = methodDelete -reqUrl = "/wizard-api/document-templates/global:questionnaire-report:1.0.0" +reqUrl = "/wizard-api/document-templates/global:project-report:1.0.0" reqHeadersT reqAuthHeader = [reqAuthHeader] @@ -85,11 +85,11 @@ test_400 appContext = UserError $ _ERROR_VALIDATION__TML_CANT_BE_DELETED_BECAUSE_IT_IS_USED_BY_SOME_OTHER_ENTITY wizardDocumentTemplate.tId - "questionnaire" + "project" let expBody = encode expDto -- AND: Run migrations runInContextIO TML_Migration.runMigration appContext - runInContextIO QTN_Migration.runMigration appContext + runInContextIO PRJ_Migration.runMigration appContext -- WHEN: Call API response <- request reqMethod reqUrl reqHeaders reqBody -- THEN: Compare response with expectation diff --git a/wizard-server/test/Wizard/Specs/API/DocumentTemplate/Detail_GET.hs b/wizard-server/test/Wizard/Specs/API/DocumentTemplate/Detail_GET.hs index 3f0fcfb4d..14e3132e6 100644 --- a/wizard-server/test/Wizard/Specs/API/DocumentTemplate/Detail_GET.hs +++ b/wizard-server/test/Wizard/Specs/API/DocumentTemplate/Detail_GET.hs @@ -33,7 +33,7 @@ detail_GET appContext = -- ---------------------------------------------------- reqMethod = methodGet -reqUrl = "/wizard-api/document-templates/global:questionnaire-report:1.0.0" +reqUrl = "/wizard-api/document-templates/global:project-report:1.0.0" reqHeadersT reqAuthHeader = reqAuthHeader @@ -72,8 +72,8 @@ create_test_200 title appContext reqAuthHeader = test_404 appContext = createNotFoundTest' reqMethod - "/wizard-api/document-templates/global:questionnaire-report:9.9.9" + "/wizard-api/document-templates/global:project-report:9.9.9" (reqHeadersT [reqAuthHeader]) reqBody "document_template" - [("id", "global:questionnaire-report:9.9.9")] + [("id", "global:project-report:9.9.9")] diff --git a/wizard-server/test/Wizard/Specs/API/DocumentTemplate/Detail_PUT.hs b/wizard-server/test/Wizard/Specs/API/DocumentTemplate/Detail_PUT.hs index 9481ba897..9e1606111 100644 --- a/wizard-server/test/Wizard/Specs/API/DocumentTemplate/Detail_PUT.hs +++ b/wizard-server/test/Wizard/Specs/API/DocumentTemplate/Detail_PUT.hs @@ -38,7 +38,7 @@ detail_PUT appContext = -- ---------------------------------------------------- reqMethod = methodPut -reqUrl = "/wizard-api/document-templates/global:questionnaire-report:1.0.0" +reqUrl = "/wizard-api/document-templates/global:project-report:1.0.0" reqHeadersT reqAuthHeader = [reqCtHeader, reqAuthHeader] diff --git a/wizard-server/test/Wizard/Specs/API/DocumentTemplate/List_DELETE.hs b/wizard-server/test/Wizard/Specs/API/DocumentTemplate/List_DELETE.hs index 2094c5672..9dbd99c02 100644 --- a/wizard-server/test/Wizard/Specs/API/DocumentTemplate/List_DELETE.hs +++ b/wizard-server/test/Wizard/Specs/API/DocumentTemplate/List_DELETE.hs @@ -15,7 +15,7 @@ import Shared.DocumentTemplate.Database.DAO.DocumentTemplate.DocumentTemplateDAO import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplates import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplate import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ import Wizard.Localization.Messages.Public import Wizard.Model.Context.AppContext @@ -39,7 +39,7 @@ list_DELETE appContext = -- ---------------------------------------------------- reqMethod = methodDelete -reqUrl = "/wizard-api/document-templates?organizationId=global&templateId=questionnaire-report" +reqUrl = "/wizard-api/document-templates?organizationId=global&templateId=project-report" reqHeaders = [reqAuthHeader, reqCtHeader] @@ -79,11 +79,11 @@ test_400 appContext = UserError $ _ERROR_VALIDATION__TML_CANT_BE_DELETED_BECAUSE_IT_IS_USED_BY_SOME_OTHER_ENTITY wizardDocumentTemplate.tId - "questionnaire" + "project" let expBody = encode expDto -- AND: Run migrations runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext + runInContextIO PRJ.runMigration appContext -- WHEN: Call API response <- request reqMethod reqUrl reqHeaders reqBody -- THEN: Compare response with expectation diff --git a/wizard-server/test/Wizard/Specs/API/DocumentTemplate/List_GET.hs b/wizard-server/test/Wizard/Specs/API/DocumentTemplate/List_GET.hs index 2271152de..d5aeaf904 100644 --- a/wizard-server/test/Wizard/Specs/API/DocumentTemplate/List_GET.hs +++ b/wizard-server/test/Wizard/Specs/API/DocumentTemplate/List_GET.hs @@ -56,19 +56,19 @@ test_200 appContext = do create_test_200 "HTTP 200 OK (query 'q')" appContext - "/wizard-api/document-templates?q=Questionnaire Report" + "/wizard-api/document-templates?q=Project Report" reqAuthHeader (Page "documentTemplates" (PageMetadata 20 1 1 0) [wizardDocumentTemplateSimpleDTO]) create_test_200 "HTTP 200 OK (query 'q' for non-existing)" appContext - "/wizard-api/document-templates?q=Non-existing Questionnaire Report" + "/wizard-api/document-templates?q=Non-existing Project Report" reqAuthHeader (Page "documentTemplates" (PageMetadata 20 0 0 0) ([] :: [DocumentTemplateSimpleDTO])) create_test_200 "HTTP 200 OK (query 'templateId')" appContext - "/wizard-api/document-templates?templateId=questionnaire-report" + "/wizard-api/document-templates?templateId=project-report" reqAuthHeader (Page "documentTemplates" (PageMetadata 20 1 1 0) [wizardDocumentTemplateSimpleDTO]) create_test_200 diff --git a/wizard-server/test/Wizard/Specs/API/DocumentTemplate/List_Suggestions_GET.hs b/wizard-server/test/Wizard/Specs/API/DocumentTemplate/List_Suggestions_GET.hs index e821e9a5e..a8c765e35 100644 --- a/wizard-server/test/Wizard/Specs/API/DocumentTemplate/List_Suggestions_GET.hs +++ b/wizard-server/test/Wizard/Specs/API/DocumentTemplate/List_Suggestions_GET.hs @@ -62,7 +62,7 @@ test_200 appContext = do create_test_200 "HTTP 200 OK (query 'q')" appContext - "/wizard-api/document-templates/suggestions?q=Questionnaire Report" + "/wizard-api/document-templates/suggestions?q=Project Report" reqAuthHeader (Page "documentTemplates" (PageMetadata 20 1 1 0) [toSuggestionDTO wizardDocumentTemplate wizardDocumentTemplateFormats]) create_test_200 @@ -80,7 +80,7 @@ test_200 appContext = do create_test_200 "HTTP 200 OK (query 'q' for non-existing)" appContext - "/wizard-api/document-templates/suggestions?q=Non-existing Questionnaire Report" + "/wizard-api/document-templates/suggestions?q=Non-existing Project Report" reqAuthHeader (Page "documentTemplates" (PageMetadata 20 0 0 0) ([] :: [DocumentTemplateSuggestionDTO])) diff --git a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Asset/Detail_DELETE.hs b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Asset/Detail_DELETE.hs index 8ca2f4e68..bfda0f620 100644 --- a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Asset/Detail_DELETE.hs +++ b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Asset/Detail_DELETE.hs @@ -34,7 +34,7 @@ detail_DELETE appContext = -- ---------------------------------------------------- reqMethod = methodDelete -reqUrl = "/wizard-api/document-template-drafts/global:questionnaire-report:1.0.0/assets/6c367648-9b60-4307-93b2-0851938adee0" +reqUrl = "/wizard-api/document-template-drafts/global:project-report:1.0.0/assets/6c367648-9b60-4307-93b2-0851938adee0" reqHeadersT reqAuthHeader = [reqAuthHeader] @@ -81,7 +81,7 @@ test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [reqCtH test_404 appContext = createNotFoundTest' reqMethod - "/wizard-api/document-template-drafts/global:questionnaire-report:1.0.0/assets/6c367648-9b60-4307-93b2-0851938adee0" + "/wizard-api/document-template-drafts/global:project-report:1.0.0/assets/6c367648-9b60-4307-93b2-0851938adee0" (reqHeadersT reqAuthHeader) reqBody "document_template_asset" diff --git a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Asset/Detail_GET.hs b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Asset/Detail_GET.hs index 0a0c1d8f6..f2cac0cf1 100644 --- a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Asset/Detail_GET.hs +++ b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Asset/Detail_GET.hs @@ -38,7 +38,7 @@ detail_GET appContext = -- ---------------------------------------------------- reqMethod = methodGet -reqUrl = "/wizard-api/document-template-drafts/global:questionnaire-report:1.0.0/assets/6c367648-9b60-4307-93b2-0851938adee0" +reqUrl = "/wizard-api/document-template-drafts/global:project-report:1.0.0/assets/6c367648-9b60-4307-93b2-0851938adee0" reqHeadersT reqAuthHeader = [reqAuthHeader] @@ -84,7 +84,7 @@ test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [reqCtH test_404 appContext = createNotFoundTest' reqMethod - "/wizard-api/document-template-drafts/global:questionnaire-report:1.0.0/assets/6c367648-9b60-4307-93b2-0851938adee0" + "/wizard-api/document-template-drafts/global:project-report:1.0.0/assets/6c367648-9b60-4307-93b2-0851938adee0" (reqHeadersT reqAuthHeader) reqBody "document_template_asset" diff --git a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Asset/Detail_PUT.hs b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Asset/Detail_PUT.hs index 6443a0324..7c1196f3c 100644 --- a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Asset/Detail_PUT.hs +++ b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Asset/Detail_PUT.hs @@ -37,7 +37,7 @@ detail_PUT appContext = -- ---------------------------------------------------- reqMethod = methodPut -reqUrl = "/wizard-api/document-template-drafts/global:questionnaire-report:1.0.0/assets/6c367648-9b60-4307-93b2-0851938adee0" +reqUrl = "/wizard-api/document-template-drafts/global:project-report:1.0.0/assets/6c367648-9b60-4307-93b2-0851938adee0" reqHeaders = [reqCtHeader, reqAuthHeader] diff --git a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Asset/List_GET.hs b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Asset/List_GET.hs index aff08c258..1b4694360 100644 --- a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Asset/List_GET.hs +++ b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Asset/List_GET.hs @@ -37,7 +37,7 @@ list_GET appContext = -- ---------------------------------------------------- reqMethod = methodGet -reqUrl = "/wizard-api/document-template-drafts/global:questionnaire-report:1.0.0/assets" +reqUrl = "/wizard-api/document-template-drafts/global:project-report:1.0.0/assets" reqHeadersT reqAuthHeader = [reqAuthHeader] diff --git a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Detail_DELETE.hs b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Detail_DELETE.hs index d6932be7a..30abc608b 100644 --- a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Detail_DELETE.hs +++ b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Detail_DELETE.hs @@ -32,7 +32,7 @@ detail_DELETE appContext = -- ---------------------------------------------------- reqMethod = methodDelete -reqUrl = "/wizard-api/document-template-drafts/global:questionnaire-report:2.0.0" +reqUrl = "/wizard-api/document-template-drafts/global:project-report:2.0.0" reqHeadersT reqAuthHeader = [reqAuthHeader] diff --git a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Detail_Documents_Preview_Settings_PUT.hs b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Detail_Documents_Preview_Settings_PUT.hs index 0dcc00e7d..969c830ed 100644 --- a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Detail_Documents_Preview_Settings_PUT.hs +++ b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Detail_Documents_Preview_Settings_PUT.hs @@ -16,10 +16,10 @@ import Wizard.Api.Resource.DocumentTemplate.Draft.DocumentTemplateDraftDataChang import Wizard.Api.Resource.DocumentTemplate.Draft.DocumentTemplateDraftDataDTO import Wizard.Api.Resource.DocumentTemplate.Draft.DocumentTemplateDraftDataJM () import Wizard.Database.DAO.DocumentTemplate.DocumentTemplateDraftDataDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO +import Wizard.Database.DAO.Project.ProjectDAO import Wizard.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplateDrafts import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires +import Wizard.Database.Migration.Development.Project.Data.Projects import Wizard.Model.Context.AppContext import SharedTest.Specs.API.Common @@ -43,7 +43,7 @@ detail_documents_preview_settings_PUT appContext = -- ---------------------------------------------------- reqMethod = methodPut -reqUrl = "/wizard-api/document-template-drafts/global:questionnaire-report:2.0.0/documents/preview/settings" +reqUrl = "/wizard-api/document-template-drafts/global:project-report:2.0.0/documents/preview/settings" reqHeadersT reqAuthHeader = [reqCtHeader, reqAuthHeader] @@ -69,8 +69,8 @@ create_test_200 title appContext reqAuthHeader = runInContextIO TML_Migration.runMigration appContext runInContextIO (insertPackage germanyKmPackage) appContext runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - runInContextIO (insertQuestionnaire questionnaire1) appContext - runInContextIO (insertQuestionnaire questionnaire2) appContext + runInContextIO (insertProject project1) appContext + runInContextIO (insertProject project2) appContext runInContextIO (insertDraftData wizardDocumentTemplateDraftData) appContext -- WHEN: Call API response <- request reqMethod reqUrl reqHeaders reqBody diff --git a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Detail_GET.hs b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Detail_GET.hs index 9cf533ba9..878aa70c4 100644 --- a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Detail_GET.hs +++ b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Detail_GET.hs @@ -17,14 +17,14 @@ import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages import Wizard.Database.DAO.DocumentTemplate.DocumentTemplateDraftDataDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO +import Wizard.Database.DAO.Project.ProjectDAO import Wizard.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplateDrafts import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires +import Wizard.Database.Migration.Development.Project.Data.Projects import qualified Wizard.Database.Migration.Development.Registry.RegistryMigration as R_Migration import Wizard.Model.Context.AppContext import Wizard.Service.DocumentTemplate.Draft.DocumentTemplateDraftMapper -import Wizard.Service.Questionnaire.QuestionnaireMapper +import Wizard.Service.Project.ProjectMapper import SharedTest.Specs.API.Common import Wizard.Specs.API.Common @@ -46,7 +46,7 @@ detail_GET appContext = -- ---------------------------------------------------- reqMethod = methodGet -reqUrl = "/wizard-api/document-template-drafts/global:questionnaire-report:2.0.0" +reqUrl = "/wizard-api/document-template-drafts/global:project-report:2.0.0" reqHeaders = [reqAuthHeader] @@ -61,13 +61,13 @@ test_200 appContext = do -- GIVEN: Prepare expectation let expStatus = 200 let expHeaders = resCtHeader : resCorsHeaders - let expDto = toDraftDetail wizardDocumentTemplateDraft wizardDocumentTemplateDraftFormats wizardDocumentTemplateDraftData (Just . toSuggestion $ questionnaire1) Nothing + let expDto = toDraftDetail wizardDocumentTemplateDraft wizardDocumentTemplateDraftFormats wizardDocumentTemplateDraftData (Just . toSuggestion $ project1) Nothing let expBody = encode expDto -- AND: Run migrations runInContextIO TML_Migration.runMigration appContext runInContextIO (insertPackage germanyKmPackage) appContext runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - runInContextIO (insertQuestionnaire questionnaire1) appContext + runInContextIO (insertProject project1) appContext runInContextIO (insertDraftData wizardDocumentTemplateDraftData) appContext runInContextIO R_Migration.runMigration appContext -- WHEN: Call API @@ -93,8 +93,8 @@ test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [reqCtH test_404 appContext = createNotFoundTest' reqMethod - "/wizard-api/document-template-drafts/global:questionnaire-report:9.9.9" + "/wizard-api/document-template-drafts/global:project-report:9.9.9" reqHeaders reqBody "document_template" - [("id", "global:questionnaire-report:9.9.9"), ("phase", "DraftDocumentTemplatePhase")] + [("id", "global:project-report:9.9.9"), ("phase", "DraftDocumentTemplatePhase")] diff --git a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Detail_PUT.hs b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Detail_PUT.hs index 9b5d04de0..3eed98c90 100644 --- a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Detail_PUT.hs +++ b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Detail_PUT.hs @@ -18,10 +18,10 @@ import Wizard.Api.Resource.DocumentTemplate.DocumentTemplateChangeJM () import Wizard.Api.Resource.DocumentTemplate.Draft.DocumentTemplateDraftChangeDTO import Wizard.Api.Resource.DocumentTemplate.Draft.DocumentTemplateDraftDetailJM () import Wizard.Database.DAO.DocumentTemplate.DocumentTemplateDraftDataDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO +import Wizard.Database.DAO.Project.ProjectDAO import Wizard.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplateDrafts import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires +import Wizard.Database.Migration.Development.Project.Data.Projects import Wizard.Model.Context.AppContext import Wizard.Model.DocumentTemplate.DocumentTemplateDraftDetail @@ -46,7 +46,7 @@ detail_PUT appContext = -- ---------------------------------------------------- reqMethod = methodPut -reqUrl = "/wizard-api/document-template-drafts/global:questionnaire-report:2.0.0" +reqUrl = "/wizard-api/document-template-drafts/global:project-report:2.0.0" reqHeaders = [reqCtHeader, reqAuthHeader] @@ -84,7 +84,7 @@ create_test_200 title appContext reqDto expDto = runInContextIO TML_Migration.runMigration appContext runInContextIO (insertPackage germanyKmPackage) appContext runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - runInContextIO (insertQuestionnaire questionnaire1) appContext + runInContextIO (insertProject project1) appContext runInContextIO (insertDraftData wizardDocumentTemplateDraftData) appContext -- WHEN: Call API response <- request reqMethod reqUrl reqHeaders (reqBodyT reqDto) diff --git a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/File/Detail_DELETE.hs b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/File/Detail_DELETE.hs index c807bbc3c..ab31788cf 100644 --- a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/File/Detail_DELETE.hs +++ b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/File/Detail_DELETE.hs @@ -34,7 +34,7 @@ detail_DELETE appContext = -- ---------------------------------------------------- reqMethod = methodDelete -reqUrl = "/wizard-api/document-template-drafts/global:questionnaire-report:1.0.0/files/7f83f7ce-4096-49a5-88d1-bd509bf72a9b" +reqUrl = "/wizard-api/document-template-drafts/global:project-report:1.0.0/files/7f83f7ce-4096-49a5-88d1-bd509bf72a9b" reqHeadersT reqAuthHeader = [reqAuthHeader] @@ -81,7 +81,7 @@ test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [reqCtH test_404 appContext = createNotFoundTest' reqMethod - "/wizard-api/document-template-drafts/global:questionnaire-report:1.0.0/files/7f83f7ce-4096-49a5-88d1-bd509bf72a9b" + "/wizard-api/document-template-drafts/global:project-report:1.0.0/files/7f83f7ce-4096-49a5-88d1-bd509bf72a9b" (reqHeadersT reqAuthHeader) reqBody "document_template_file" diff --git a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/File/Detail_GET.hs b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/File/Detail_GET.hs index 2af011897..f2de53e9c 100644 --- a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/File/Detail_GET.hs +++ b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/File/Detail_GET.hs @@ -34,7 +34,7 @@ detail_GET appContext = -- ---------------------------------------------------- reqMethod = methodGet -reqUrl = "/wizard-api/document-template-drafts/global:questionnaire-report:1.0.0/files/7f83f7ce-4096-49a5-88d1-bd509bf72a9b" +reqUrl = "/wizard-api/document-template-drafts/global:project-report:1.0.0/files/7f83f7ce-4096-49a5-88d1-bd509bf72a9b" reqHeadersT reqAuthHeader = [reqAuthHeader] @@ -80,7 +80,7 @@ test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [reqCtH test_404 appContext = createNotFoundTest' reqMethod - "/wizard-api/document-template-drafts/global:questionnaire-report:1.0.0/files/deab6c38-aeac-4b17-a501-4365a0a70176" + "/wizard-api/document-template-drafts/global:project-report:1.0.0/files/deab6c38-aeac-4b17-a501-4365a0a70176" (reqHeadersT reqAuthHeader) reqBody "document_template_file" diff --git a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/File/Detail_PUT.hs b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/File/Detail_PUT.hs index ed15596ad..3e6b46dcd 100644 --- a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/File/Detail_PUT.hs +++ b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/File/Detail_PUT.hs @@ -38,7 +38,7 @@ detail_PUT appContext = -- ---------------------------------------------------- reqMethod = methodPut -reqUrl = "/wizard-api/document-template-drafts/global:questionnaire-report:1.0.0/files/7f83f7ce-4096-49a5-88d1-bd509bf72a9b" +reqUrl = "/wizard-api/document-template-drafts/global:project-report:1.0.0/files/7f83f7ce-4096-49a5-88d1-bd509bf72a9b" reqHeadersT reqAuthHeader = [reqCtHeader, reqAuthHeader] @@ -88,7 +88,7 @@ test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [reqCtH test_404 appContext = createNotFoundTest' reqMethod - "/wizard-api/document-template-drafts/global:questionnaire-report:1.0.0/files/deab6c38-aeac-4b17-a501-4365a0a70176" + "/wizard-api/document-template-drafts/global:project-report:1.0.0/files/deab6c38-aeac-4b17-a501-4365a0a70176" (reqHeadersT reqAuthHeader) reqBody "document_template_file" diff --git a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/File/List_GET.hs b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/File/List_GET.hs index 3e8db5fda..69da58264 100644 --- a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/File/List_GET.hs +++ b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/File/List_GET.hs @@ -34,7 +34,7 @@ list_GET appContext = -- ---------------------------------------------------- reqMethod = methodGet -reqUrl = "/wizard-api/document-template-drafts/global:questionnaire-report:1.0.0/files" +reqUrl = "/wizard-api/document-template-drafts/global:project-report:1.0.0/files" reqHeadersT reqAuthHeader = [reqAuthHeader] diff --git a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/File/List_POST.hs b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/File/List_POST.hs index 7b2a3386d..09988f39b 100644 --- a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/File/List_POST.hs +++ b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/File/List_POST.hs @@ -37,7 +37,7 @@ list_POST appContext = -- ---------------------------------------------------- reqMethod = methodPost -reqUrl = "/wizard-api/document-template-drafts/global:questionnaire-report:1.0.0/files" +reqUrl = "/wizard-api/document-template-drafts/global:project-report:1.0.0/files" reqHeadersT reqAuthHeader = [reqCtHeader, reqAuthHeader] diff --git a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Folder/List_Delete_POST.hs b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Folder/List_Delete_POST.hs index b700f01e4..0319bbee9 100644 --- a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Folder/List_Delete_POST.hs +++ b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Folder/List_Delete_POST.hs @@ -40,7 +40,7 @@ list_delete_POST appContext = -- ---------------------------------------------------- reqMethod = methodPost -reqUrl = "/wizard-api/document-template-drafts/global:questionnaire-report:1.0.0/folders/delete" +reqUrl = "/wizard-api/document-template-drafts/global:project-report:1.0.0/folders/delete" reqHeadersT reqAuthHeader = [reqCtHeader, reqAuthHeader] diff --git a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Folder/List_Move_POST.hs b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Folder/List_Move_POST.hs index 4c37b4d69..8efc09ff1 100644 --- a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Folder/List_Move_POST.hs +++ b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Folder/List_Move_POST.hs @@ -38,7 +38,7 @@ list_move_POST appContext = -- ---------------------------------------------------- reqMethod = methodPost -reqUrl = "/wizard-api/document-template-drafts/global:questionnaire-report:1.0.0/folders/move" +reqUrl = "/wizard-api/document-template-drafts/global:project-report:1.0.0/folders/move" reqHeadersT reqAuthHeader = [reqCtHeader, reqAuthHeader] diff --git a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/List_GET.hs b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/List_GET.hs index d39028c4b..bbe049f9b 100644 --- a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/List_GET.hs +++ b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/List_GET.hs @@ -57,13 +57,13 @@ test_200 appContext = do create_test_200 "HTTP 200 OK (query 'q')" appContext - "/wizard-api/document-template-drafts?q=Questionnaire Report" + "/wizard-api/document-template-drafts?q=Project Report" reqAuthHeader (Page "documentTemplateDrafts" (PageMetadata 20 1 1 0) [toDraftList wizardDocumentTemplateDraft]) create_test_200 "HTTP 200 OK (query 'q' for non-existing)" appContext - "/wizard-api/document-template-drafts?q=Non-existing Questionnaire Report" + "/wizard-api/document-template-drafts?q=Non-existing Project Report" reqAuthHeader (Page "documentTemplateDrafts" (PageMetadata 20 0 0 0) ([] :: [DocumentTemplateDraftList])) diff --git a/wizard-server/test/Wizard/Specs/API/Feedback/Common.hs b/wizard-server/test/Wizard/Specs/API/Feedback/Common.hs index 2bf6c5e38..e614fb758 100644 --- a/wizard-server/test/Wizard/Specs/API/Feedback/Common.hs +++ b/wizard-server/test/Wizard/Specs/API/Feedback/Common.hs @@ -34,11 +34,11 @@ compareFeedbackDtos resDto expDto = do -- HELPER -- -------------------------------- loadFeedbackTokenFromEnv = do - tcQuestionnaire <- getCurrentTenantConfigQuestionnaire - updatedTcQuestionnaire <- applyEnvVariable "FEEDBACK_TOKEN" tcQuestionnaire.feedback.token (\t -> tcQuestionnaire {feedback = tcQuestionnaire.feedback {token = t}}) - modifyTenantConfigQuestionnaire updatedTcQuestionnaire + tcProject <- getCurrentTenantConfigProject + updatedTcProject <- applyEnvVariable "FEEDBACK_TOKEN" tcProject.feedback.token (\t -> tcProject {feedback = tcProject.feedback {token = t}}) + modifyTenantConfigProject updatedTcProject -applyEnvVariable :: String -> String -> (String -> TenantConfigQuestionnaire) -> AppContextM TenantConfigQuestionnaire +applyEnvVariable :: String -> String -> (String -> TenantConfigProject) -> AppContextM TenantConfigProject applyEnvVariable envVariableName oldValue updateFn = do envVariable <- liftIO $ lookupEnv envVariableName let newValue = fromMaybe oldValue envVariable diff --git a/wizard-server/test/Wizard/Specs/API/Feedback/Detail_GET.hs b/wizard-server/test/Wizard/Specs/API/Feedback/Detail_GET.hs index 230437031..2cedee3ee 100644 --- a/wizard-server/test/Wizard/Specs/API/Feedback/Detail_GET.hs +++ b/wizard-server/test/Wizard/Specs/API/Feedback/Detail_GET.hs @@ -52,7 +52,7 @@ test_200 appContext = do let expStatus = 200 let expHeaders = resCtHeader : resCorsHeaders - let expDto = toDTO appContext.serverConfig defaultQuestionnaire feedback1 + let expDto = toDTO appContext.serverConfig defaultProject feedback1 let expBody = encode expDto -- AND: Run migrations runInContextIO loadFeedbackTokenFromEnv appContext diff --git a/wizard-server/test/Wizard/Specs/API/Feedback/List_GET.hs b/wizard-server/test/Wizard/Specs/API/Feedback/List_GET.hs index 6f90f03f9..2f4740b24 100644 --- a/wizard-server/test/Wizard/Specs/API/Feedback/List_GET.hs +++ b/wizard-server/test/Wizard/Specs/API/Feedback/List_GET.hs @@ -50,8 +50,8 @@ test_200 appContext = let expStatus = 200 let expHeaders = resCtHeader : resCorsHeaders let expDto = - [ toDTO appContext.serverConfig defaultQuestionnaire feedback1 - , toDTO appContext.serverConfig defaultQuestionnaire feedback2 + [ toDTO appContext.serverConfig defaultProject feedback1 + , toDTO appContext.serverConfig defaultProject feedback2 ] let expBody = encode expDto -- AND: Run migrations diff --git a/wizard-server/test/Wizard/Specs/API/KnowledgeModel/Preview_POST.hs b/wizard-server/test/Wizard/Specs/API/KnowledgeModel/Preview_POST.hs index 6b39e2b49..3ea171c14 100644 --- a/wizard-server/test/Wizard/Specs/API/KnowledgeModel/Preview_POST.hs +++ b/wizard-server/test/Wizard/Specs/API/KnowledgeModel/Preview_POST.hs @@ -98,4 +98,4 @@ create_test_200 title appContext authHeader pkg pkgId expDto = -- ---------------------------------------------------- -- ---------------------------------------------------- test_403 appContext = - createNoPermissionTest appContext reqMethod reqUrl [reqCtHeader] (reqBodyT germanyKmPackage.pId) "QTN_PERM" + createNoPermissionTest appContext reqMethod reqUrl [reqCtHeader] (reqBodyT germanyKmPackage.pId) "PRJ_PERM" diff --git a/wizard-server/test/Wizard/Specs/API/KnowledgeModelEditor/APISpec.hs b/wizard-server/test/Wizard/Specs/API/KnowledgeModelEditor/APISpec.hs index 949e1ef7a..6cc357205 100644 --- a/wizard-server/test/Wizard/Specs/API/KnowledgeModelEditor/APISpec.hs +++ b/wizard-server/test/Wizard/Specs/API/KnowledgeModelEditor/APISpec.hs @@ -9,6 +9,7 @@ import Wizard.Specs.API.KnowledgeModelEditor.Detail_GET import Wizard.Specs.API.KnowledgeModelEditor.Detail_PUT import Wizard.Specs.API.KnowledgeModelEditor.List_GET import Wizard.Specs.API.KnowledgeModelEditor.List_POST +import Wizard.Specs.API.KnowledgeModelEditor.Migration.APISpec knowledgeModelEditorAPI baseContext appContext = with (startWebApp baseContext appContext) $ @@ -18,3 +19,4 @@ knowledgeModelEditorAPI baseContext appContext = detail_GET appContext detail_PUT appContext detail_DELETE appContext + knowledgeModelEditorMigrationAPI appContext diff --git a/wizard-server/test/Wizard/Specs/API/KnowledgeModelEditor/Migration/APISpec.hs b/wizard-server/test/Wizard/Specs/API/KnowledgeModelEditor/Migration/APISpec.hs new file mode 100644 index 000000000..116c1c98e --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/KnowledgeModelEditor/Migration/APISpec.hs @@ -0,0 +1,17 @@ +module Wizard.Specs.API.KnowledgeModelEditor.Migration.APISpec where + +import Test.Hspec + +import Wizard.Specs.API.KnowledgeModelEditor.Migration.List_Current_Conflict_All_POST +import Wizard.Specs.API.KnowledgeModelEditor.Migration.List_Current_Conflict_POST +import Wizard.Specs.API.KnowledgeModelEditor.Migration.List_Current_DELETE +import Wizard.Specs.API.KnowledgeModelEditor.Migration.List_Current_GET +import Wizard.Specs.API.KnowledgeModelEditor.Migration.List_Current_POST + +knowledgeModelEditorMigrationAPI appContext = + describe "KNOWLEDGE MODEL EDITOR MIGRATION API Spec" $ do + list_current_GET appContext + list_current_POST appContext + list_current_DELETE appContext + list_current_conflict_POST appContext + list_Current_Conflict_All_POST appContext diff --git a/wizard-server/test/Wizard/Specs/API/KnowledgeModelEditor/Migration/Common.hs b/wizard-server/test/Wizard/Specs/API/KnowledgeModelEditor/Migration/Common.hs new file mode 100644 index 000000000..cddc9a20b --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/KnowledgeModelEditor/Migration/Common.hs @@ -0,0 +1,38 @@ +module Wizard.Specs.API.KnowledgeModelEditor.Migration.Common where + +import Data.Either (isRight) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) + +import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelEditorEventDAO +import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelMigrationDAO +import Wizard.Database.Migration.Development.KnowledgeModel.Data.Editor.KnowledgeModelEditors +import Wizard.Database.Migration.Development.KnowledgeModel.Data.Migration.KnowledgeModelMigrations +import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeModelEditorMigration as KnowledgeModelEditor +import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeModelMigrationMigration as KM_MIG +import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditorList +import Wizard.Model.KnowledgeModel.Migration.KnowledgeModelMigration +import Wizard.Service.KnowledgeModel.Migration.KnowledgeModelMigrationService + +import Wizard.Specs.Common + +-- -------------------------------- +-- MIGRATION +-- -------------------------------- +runMigrationWithEmptyDB appContext = do + runInContextIO KnowledgeModelEditor.runMigration appContext + runInContextIO (deleteKnowledgeModelEventsByEditorUuid amsterdamKnowledgeModelEditorList.uuid) appContext + runInContextIO KM_MIG.runMigration appContext + +runMigrationWithFullDB appContext = do + runMigrationWithEmptyDB appContext + runInContextIO (createMigration amsterdamKnowledgeModelEditorList.uuid knowledgeModelMigrationCreateDTO) appContext + +-- -------------------------------- +-- ASSERTS +-- -------------------------------- +assertStateOfMigrationInDB appContext kmMigration expState = do + eKmMigration <- runInContextIO (findKnowledgeModelMigrationByEditorUuid kmMigration.editorUuid) appContext + liftIO $ isRight eKmMigration `shouldBe` True + let (Right kmMigrationFromDB) = eKmMigration + liftIO $ kmMigrationFromDB.state `shouldBe` expState diff --git a/wizard-server/test/Wizard/Specs/API/KnowledgeModelEditor/Migration/List_Current_Conflict_All_POST.hs b/wizard-server/test/Wizard/Specs/API/KnowledgeModelEditor/Migration/List_Current_Conflict_All_POST.hs new file mode 100644 index 000000000..4856cbeb6 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/KnowledgeModelEditor/Migration/List_Current_Conflict_All_POST.hs @@ -0,0 +1,83 @@ +module Wizard.Specs.API.KnowledgeModelEditor.Migration.List_Current_Conflict_All_POST ( + list_Current_Conflict_All_POST, +) where + +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationDTO +import Wizard.Database.Migration.Development.KnowledgeModel.Data.Migration.KnowledgeModelMigrations +import Wizard.Model.Context.AppContext +import Wizard.Model.KnowledgeModel.Migration.KnowledgeModelMigration + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.API.KnowledgeModelEditor.Migration.Common + +-- ------------------------------------------------------------------------ +-- POST /wizard-api/knowledge-model-editors/uuid/migrations/current/conflict/all +-- ------------------------------------------------------------------------ +list_Current_Conflict_All_POST :: AppContext -> SpecWith ((), Application) +list_Current_Conflict_All_POST appContext = + describe "POST /wizard-api/knowledge-model-editors/uuid/migrations/current/conflict/all" $ do + test_204 appContext + test_401 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodPost + +reqUrl = "/wizard-api/knowledge-model-editors/6474b24b-262b-42b1-9451-008e8363f2b6/migrations/current/conflict/all" + +reqHeaders = [reqAuthHeader, reqCtHeader] + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_204 appContext = + it "HTTP 204 NO CONTENT" $ + -- GIVEN: Prepare expectation + do + let expStatus = 204 + let expHeaders = resCtHeader : resCorsHeaders + let expBody = "" + -- AND: Prepare database + runMigrationWithFullDB appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + -- AND: Find result in DB and compare with expectation state + assertStateOfMigrationInDB appContext knowledgeModelMigrationDTO CompletedKnowledgeModelMigrationState + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod reqUrl [reqCtHeader] reqBody + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [reqCtHeader] reqBody "KM_UPGRADE_PERM" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + reqUrl + reqHeaders + reqBody + "knowledge_model_migration" + [("editor_uuid", "6474b24b-262b-42b1-9451-008e8363f2b6")] diff --git a/wizard-server/test/Wizard/Specs/API/KnowledgeModelEditor/Migration/List_Current_Conflict_POST.hs b/wizard-server/test/Wizard/Specs/API/KnowledgeModelEditor/Migration/List_Current_Conflict_POST.hs new file mode 100644 index 000000000..e29dc7168 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/KnowledgeModelEditor/Migration/List_Current_Conflict_POST.hs @@ -0,0 +1,136 @@ +module Wizard.Specs.API.KnowledgeModelEditor.Migration.List_Current_Conflict_POST ( + list_current_conflict_POST, +) where + +import Data.Aeson (encode) +import Data.Maybe (fromJust) +import qualified Data.UUID as U +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Model.Error.Error +import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationDTO +import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationResolutionDTO +import Wizard.Database.Migration.Development.KnowledgeModel.Data.Editor.KnowledgeModelEditors +import Wizard.Database.Migration.Development.KnowledgeModel.Data.Migration.KnowledgeModelMigrations +import Wizard.Localization.Messages.Public +import Wizard.Model.Context.AppContext +import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditorList +import Wizard.Model.KnowledgeModel.Migration.KnowledgeModelMigration +import Wizard.Service.KnowledgeModel.Migration.KnowledgeModelMigrationService + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.API.KnowledgeModelEditor.Migration.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- POST /wizard-api/knowledge-model-editors/uuid/migrations/current/conflict +-- ------------------------------------------------------------------------ +list_current_conflict_POST :: AppContext -> SpecWith ((), Application) +list_current_conflict_POST appContext = + describe "POST /wizard-api/knowledge-model-editors/{uuid}/migrations/current/conflict" $ do + test_204 appContext + test_400 appContext + test_401 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodPost + +reqUrl = "/wizard-api/knowledge-model-editors/6474b24b-262b-42b1-9451-008e8363f2b6/migrations/current/conflict" + +reqHeaders = [reqAuthHeader, reqCtHeader] + +reqDto = knowledgeModelMigrationResolutionDTO + +reqBody = encode reqDto + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_204 appContext = + it "HTTP 204 NO CONTENT" $ + -- GIVEN: Prepare expectation + do + let expStatus = 204 + let expHeaders = resCtHeader : resCorsHeaders + let expBody = "" + -- AND: Prepare database + runMigrationWithFullDB appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + -- AND: Find result in DB and compare with expectation state + assertStateOfMigrationInDB appContext knowledgeModelMigrationDTO CompletedKnowledgeModelMigrationState + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_400 appContext = do + createInvalidJsonTest reqMethod reqUrl "targetPackageId" + it "HTTP 400 BAD REQUEST when originalEventUuid doesn't match with current target event" $ + -- GIVEN: Prepare request + do + let reqDtoEdited = reqDto {originalEventUuid = fromJust . U.fromString $ "30ac5193-5685-41b1-86d7-ab0b356c516a"} + let reqBody = encode reqDtoEdited + -- AND: Prepare expectation + let expStatus = 400 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = UserError _ERROR_SERVICE_MIGRATION_KM__EVENT_UUIDS_MISMATCH + let expBody = encode expDto + -- AND: Prepare database + runMigrationWithFullDB appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- AND: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + it "HTTP 400 BAD REQUEST when you can't solve conflicts because Migration state isn't in conflict state" $ + -- GIVEN: Prepare expectation + do + let expStatus = 400 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = UserError _ERROR_SERVICE_MIGRATION_KM__NO_CONFLICTS_TO_SOLVE + let expBody = encode expDto + -- AND: Prepare database + runMigrationWithFullDB appContext + runInContextIO (solveConflictAndMigrate amsterdamKnowledgeModelEditorList.uuid reqDto) appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- AND: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod reqUrl [reqCtHeader] reqBody + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [reqCtHeader] reqBody "KM_UPGRADE_PERM" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + reqUrl + reqHeaders + reqBody + "knowledge_model_migration" + [("editor_uuid", "6474b24b-262b-42b1-9451-008e8363f2b6")] diff --git a/wizard-server/test/Wizard/Specs/API/KnowledgeModelEditor/Migration/List_Current_DELETE.hs b/wizard-server/test/Wizard/Specs/API/KnowledgeModelEditor/Migration/List_Current_DELETE.hs new file mode 100644 index 000000000..4dca76063 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/KnowledgeModelEditor/Migration/List_Current_DELETE.hs @@ -0,0 +1,82 @@ +module Wizard.Specs.API.KnowledgeModelEditor.Migration.List_Current_DELETE ( + list_current_DELETE, +) where + +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelMigrationDAO +import Wizard.Model.Context.AppContext + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.API.KnowledgeModelEditor.Migration.Common + +-- ------------------------------------------------------------------------ +-- DELETE /wizard-api/knowledge-model-editors/{uuid}/migrations/current +-- ------------------------------------------------------------------------ +list_current_DELETE :: AppContext -> SpecWith ((), Application) +list_current_DELETE appContext = + describe "DELETE /wizard-api/knowledge-model-editors/{uuid}/migrations/current" $ do + test_204 appContext + test_401 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodDelete + +reqUrl = "/wizard-api/knowledge-model-editors/6474b24b-262b-42b1-9451-008e8363f2b6/migrations/current" + +reqHeaders = [reqAuthHeader, reqCtHeader] + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_204 appContext = + it "HTTP 204 NO CONTENT" $ + -- GIVEN: Prepare expectation + do + let expStatus = 204 + let expBody = "" + let expHeaders = resCorsHeaders + -- AND: Prepare database + runMigrationWithFullDB appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + -- AND: Find result in DB and compare with expectation state + assertCountInDB findKnowledgeModelMigrations appContext 0 + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod reqUrl [] "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [] "" "KM_UPGRADE_PERM" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + reqUrl + reqHeaders + reqBody + "knowledge_model_migration" + [("editor_uuid", "6474b24b-262b-42b1-9451-008e8363f2b6")] diff --git a/wizard-server/test/Wizard/Specs/API/KnowledgeModelEditor/Migration/List_Current_GET.hs b/wizard-server/test/Wizard/Specs/API/KnowledgeModelEditor/Migration/List_Current_GET.hs new file mode 100644 index 000000000..9455a1f82 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/KnowledgeModelEditor/Migration/List_Current_GET.hs @@ -0,0 +1,81 @@ +module Wizard.Specs.API.KnowledgeModelEditor.Migration.List_Current_GET ( + list_current_GET, +) where + +import Data.Aeson (encode) +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Wizard.Database.Migration.Development.KnowledgeModel.Data.Migration.KnowledgeModelMigrations +import Wizard.Model.Context.AppContext + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.API.KnowledgeModelEditor.Migration.Common + +-- ------------------------------------------------------------------------ +-- GET /wizard-api/knowledge-model-editors/{uuid}/migrations/current +-- ------------------------------------------------------------------------ +list_current_GET :: AppContext -> SpecWith ((), Application) +list_current_GET appContext = + describe "GET /wizard-api/knowledge-model-editors/{uuid}/migrations/current" $ do + test_200 appContext + test_401 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodGet + +reqUrl = "/wizard-api/knowledge-model-editors/6474b24b-262b-42b1-9451-008e8363f2b6/migrations/current" + +reqHeaders = [reqAuthHeader, reqCtHeader] + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = + it "HTTP 200 OK" $ + -- GIVEN: Prepare expectation + do + let expStatus = 200 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = knowledgeModelMigrationDTO + let expBody = encode expDto + -- AND: Prepare database + runMigrationWithFullDB appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod reqUrl [] reqBody + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [] "" "KM_UPGRADE_PERM" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + reqUrl + reqHeaders + reqBody + "knowledge_model_migration" + [("editor_uuid", "6474b24b-262b-42b1-9451-008e8363f2b6")] diff --git a/wizard-server/test/Wizard/Specs/API/KnowledgeModelEditor/Migration/List_Current_POST.hs b/wizard-server/test/Wizard/Specs/API/KnowledgeModelEditor/Migration/List_Current_POST.hs new file mode 100644 index 000000000..33c152d03 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/KnowledgeModelEditor/Migration/List_Current_POST.hs @@ -0,0 +1,177 @@ +module Wizard.Specs.API.KnowledgeModelEditor.Migration.List_Current_POST ( + list_current_POST, +) where + +import Data.Aeson (encode) +import qualified Data.UUID as U +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackage +import Wizard.Api.Resource.KnowledgeModel.Editor.KnowledgeModelEditorCreateDTO +import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationCreateDTO +import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelMigrationDAO +import Wizard.Database.Migration.Development.KnowledgeModel.Data.Editor.KnowledgeModelEditors +import Wizard.Database.Migration.Development.KnowledgeModel.Data.Migration.KnowledgeModelMigrations +import Wizard.Database.Migration.Development.Tenant.Data.Tenants +import Wizard.Database.Migration.Development.User.Data.Users +import Wizard.Localization.Messages.Public +import Wizard.Model.Context.AppContext +import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditorList +import Wizard.Model.Tenant.Tenant +import Wizard.Service.KnowledgeModel.Editor.EditorService +import qualified Wizard.Service.User.UserMapper as U_Mapper + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.API.KnowledgeModelEditor.Migration.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- POST /wizard-api/knowledge-model-editors/{uuid}/migrations/current +-- ------------------------------------------------------------------------ +list_current_POST :: AppContext -> SpecWith ((), Application) +list_current_POST appContext = + describe "POST /wizard-api/knowledge-model-editors/{uuid}/migrations/current" $ do + test_201 appContext + test_400 appContext + test_401 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodPost + +reqUrl = "/wizard-api/knowledge-model-editors/6474b24b-262b-42b1-9451-008e8363f2b6/migrations/current" + +reqHeaders = [reqAuthHeader, reqCtHeader] + +reqDto = knowledgeModelMigrationCreateDTO + +reqBody = encode reqDto + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_201 appContext = + it "HTTP 201 CREATED" $ + -- GIVEN: Prepare expectation + do + let expStatus = 201 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = knowledgeModelMigrationDTO + let expBody = encode expDto + -- AND: Prepare database + runMigrationWithEmptyDB appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + -- AND: Find result in DB and compare with expectation state + assertCountInDB findKnowledgeModelMigrations appContext 1 + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_400 appContext = do + createInvalidJsonTest reqMethod reqUrl "targetPackageId" + it "HTTP 400 BAD REQUEST when migration is already created" $ + -- GIVEN: Prepare expectation + do + let expStatus = 400 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = UserError _ERROR_VALIDATION__KM_MIGRATION_UNIQUENESS + let expBody = encode expDto + -- AND: Prepare database + runMigrationWithFullDB appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- AND: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + it "HTTP 400 BAD REQUEST when target Package is not higher than current one" $ + -- GIVEN: Prepare request + do + let reqDto = KnowledgeModelMigrationCreateDTO {targetPackageId = "org.nl:core-nl:0.9.0"} + let reqBody = encode reqDto + -- AND: Prepare expectation + let expStatus = 400 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = UserError _ERROR_SERVICE_MIGRATION_KM__TARGET_PKG_IS_NOT_HIGHER + let expBody = encode expDto + -- AND: Prepare database + runMigrationWithEmptyDB appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- AND: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + it "HTTP 400 BAD REQUEST when KM editor has to have a previous package" $ + -- AND: Prepare expectation + do + let expStatus = 400 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = UserError _ERROR_VALIDATION__KM_EDITOR_PREVIOUS_PKG_ABSENCE + let expBody = encode expDto + -- AND: Prepare database + let editor = amsterdamKnowledgeModelEditorCreate {previousPackageId = Nothing} :: KnowledgeModelEditorCreateDTO + let editorUuid = amsterdamKnowledgeModelEditorList.uuid + let timestamp = amsterdamKnowledgeModelEditorList.createdAt + let user = U_Mapper.toDTO userAlbert + runInContextIO (createEditorWithParams editorUuid timestamp user editor) appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- AND: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod reqUrl [reqCtHeader] reqBody + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [reqCtHeader] reqBody "KM_UPGRADE_PERM" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = do + createNotFoundTest' reqMethod reqUrl reqHeaders reqBody "knowledge_model_editor" [("uuid", "6474b24b-262b-42b1-9451-008e8363f2b6")] + it "HTTP 404 NOT FOUND when target previous package doesn’t exist" $ + -- GIVEN: Prepare expectation + do + let expStatus = 404 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = + NotExistsError + ( _ERROR_DATABASE__ENTITY_NOT_FOUND + "knowledge_model_package" + [("tenant_uuid", U.toString defaultTenant.uuid), ("id", "org.nl:core-nl:2.0.0")] + ) + let expBody = encode expDto + -- AND: Prepare database + runMigrationWithEmptyDB appContext + runInContextIO (deletePackageById netherlandsKmPackageV2.pId) appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- AND: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher diff --git a/wizard-server/test/Wizard/Specs/API/KnowledgeModelPackage/List_GET.hs b/wizard-server/test/Wizard/Specs/API/KnowledgeModelPackage/List_GET.hs index 1d53c3ce7..d041c423a 100644 --- a/wizard-server/test/Wizard/Specs/API/KnowledgeModelPackage/List_GET.hs +++ b/wizard-server/test/Wizard/Specs/API/KnowledgeModelPackage/List_GET.hs @@ -16,7 +16,7 @@ import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data. import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSimpleDTO import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeModelPackageMigration as KnowledgeModelPackage -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ import Wizard.Database.Migration.Development.Registry.Data.RegistryOrganizations import Wizard.Database.Migration.Development.Registry.Data.RegistryPackages import qualified Wizard.Database.Migration.Development.Registry.RegistryMigration as R_Migration @@ -113,7 +113,7 @@ create_test_200 title appContext reqUrl expDto = runInContextIO R_Migration.runMigration appContext runInContextIO KnowledgeModelPackage.runMigration appContext runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext + runInContextIO PRJ.runMigration appContext -- WHEN: Call API response <- request reqMethod reqUrl reqHeaders reqBody -- THEN: Compare response with expectation diff --git a/wizard-server/test/Wizard/Specs/API/KnowledgeModelPackage/List_Suggestions_GET.hs b/wizard-server/test/Wizard/Specs/API/KnowledgeModelPackage/List_Suggestions_GET.hs index 3f28403b7..e3ffd1f1a 100644 --- a/wizard-server/test/Wizard/Specs/API/KnowledgeModelPackage/List_Suggestions_GET.hs +++ b/wizard-server/test/Wizard/Specs/API/KnowledgeModelPackage/List_Suggestions_GET.hs @@ -16,7 +16,7 @@ import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data. import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSuggestionJM () import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeModelPackageMigration as KnowledgeModelPackage -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ import qualified Wizard.Database.Migration.Development.User.UserMigration as U import Wizard.Model.Context.AppContext import Wizard.Model.KnowledgeModel.Package.KnowledgeModelPackageSuggestion @@ -113,7 +113,7 @@ create_test_200 title appContext reqUrl expDto = runInContextIO U.runMigration appContext runInContextIO KnowledgeModelPackage.runMigration appContext runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext + runInContextIO PRJ.runMigration appContext -- WHEN: Call API response <- request reqMethod reqUrl reqHeaders reqBody -- THEN: Compare response with expectation diff --git a/wizard-server/test/Wizard/Specs/API/Migration/KnowledgeModel/APISpec.hs b/wizard-server/test/Wizard/Specs/API/Migration/KnowledgeModel/APISpec.hs deleted file mode 100644 index e8b0c2ed7..000000000 --- a/wizard-server/test/Wizard/Specs/API/Migration/KnowledgeModel/APISpec.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Wizard.Specs.API.Migration.KnowledgeModel.APISpec where - -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) - -import Wizard.Specs.API.Common -import Wizard.Specs.API.Migration.KnowledgeModel.List_Current_Conflict_All_POST -import Wizard.Specs.API.Migration.KnowledgeModel.List_Current_Conflict_POST -import Wizard.Specs.API.Migration.KnowledgeModel.List_Current_DELETE -import Wizard.Specs.API.Migration.KnowledgeModel.List_Current_GET -import Wizard.Specs.API.Migration.KnowledgeModel.List_Current_POST - -migrationAPI baseContext appContext = - with (startWebApp baseContext appContext) $ - describe "MIGRATION KNOWLEDGE MODEL API Spec" $ do - list_current_GET appContext - list_current_POST appContext - list_current_DELETE appContext - list_current_conflict_POST appContext - list_Current_Conflict_All_POST appContext diff --git a/wizard-server/test/Wizard/Specs/API/Migration/KnowledgeModel/Common.hs b/wizard-server/test/Wizard/Specs/API/Migration/KnowledgeModel/Common.hs deleted file mode 100644 index aa85b1b09..000000000 --- a/wizard-server/test/Wizard/Specs/API/Migration/KnowledgeModel/Common.hs +++ /dev/null @@ -1,38 +0,0 @@ -module Wizard.Specs.API.Migration.KnowledgeModel.Common where - -import Data.Either (isRight) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) - -import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelEditorEventDAO -import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelMigrationDAO -import Wizard.Database.Migration.Development.KnowledgeModel.Data.Editor.KnowledgeModelEditors -import Wizard.Database.Migration.Development.KnowledgeModel.Data.Migration.KnowledgeModelMigrations -import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeModelEditorMigration as KnowledgeModelEditor -import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeModelMigrationMigration as KM_MIG -import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditorList -import Wizard.Model.KnowledgeModel.Migration.KnowledgeModelMigration -import Wizard.Service.KnowledgeModel.Migration.MigrationService - -import Wizard.Specs.Common - --- -------------------------------- --- MIGRATION --- -------------------------------- -runMigrationWithEmptyDB appContext = do - runInContextIO KnowledgeModelEditor.runMigration appContext - runInContextIO (deleteKnowledgeModelEventsByEditorUuid amsterdamKnowledgeModelEditorList.uuid) appContext - runInContextIO KM_MIG.runMigration appContext - -runMigrationWithFullDB appContext = do - runMigrationWithEmptyDB appContext - runInContextIO (createMigration amsterdamKnowledgeModelEditorList.uuid migratorStateCreate) appContext - --- -------------------------------- --- ASSERTS --- -------------------------------- -assertStateOfMigrationInDB appContext ms expState = do - eMs <- runInContextIO (findMigratorStateByEditorUuid ms.editorUuid) appContext - liftIO $ isRight eMs `shouldBe` True - let (Right msFromDB) = eMs - liftIO $ msFromDB.state `shouldBe` expState diff --git a/wizard-server/test/Wizard/Specs/API/Migration/KnowledgeModel/List_Current_Conflict_All_POST.hs b/wizard-server/test/Wizard/Specs/API/Migration/KnowledgeModel/List_Current_Conflict_All_POST.hs deleted file mode 100644 index db4cb5f57..000000000 --- a/wizard-server/test/Wizard/Specs/API/Migration/KnowledgeModel/List_Current_Conflict_All_POST.hs +++ /dev/null @@ -1,83 +0,0 @@ -module Wizard.Specs.API.Migration.KnowledgeModel.List_Current_Conflict_All_POST ( - list_Current_Conflict_All_POST, -) where - -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationDTO -import Wizard.Database.Migration.Development.KnowledgeModel.Data.Migration.KnowledgeModelMigrations -import Wizard.Model.Context.AppContext -import Wizard.Model.KnowledgeModel.Migration.KnowledgeModelMigration - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.API.Migration.KnowledgeModel.Common - --- ------------------------------------------------------------------------ --- POST /wizard-api/knowledge-model-editors/uuid/migrations/current/conflict/all --- ------------------------------------------------------------------------ -list_Current_Conflict_All_POST :: AppContext -> SpecWith ((), Application) -list_Current_Conflict_All_POST appContext = - describe "POST /wizard-api/knowledge-model-editors/uuid/migrations/current/conflict/all" $ do - test_204 appContext - test_401 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodPost - -reqUrl = "/wizard-api/knowledge-model-editors/6474b24b-262b-42b1-9451-008e8363f2b6/migrations/current/conflict/all" - -reqHeaders = [reqAuthHeader, reqCtHeader] - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_204 appContext = - it "HTTP 204 NO CONTENT" $ - -- GIVEN: Prepare expectation - do - let expStatus = 204 - let expHeaders = resCtHeader : resCorsHeaders - let expBody = "" - -- AND: Prepare database - runMigrationWithFullDB appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - -- AND: Find result in DB and compare with expectation state - assertStateOfMigrationInDB appContext migratorState CompletedKnowledgeModelMigrationState - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod reqUrl [reqCtHeader] reqBody - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [reqCtHeader] reqBody "KM_UPGRADE_PERM" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - reqUrl - reqHeaders - reqBody - "knowledge_model_migration" - [("editor_uuid", "6474b24b-262b-42b1-9451-008e8363f2b6")] diff --git a/wizard-server/test/Wizard/Specs/API/Migration/KnowledgeModel/List_Current_Conflict_POST.hs b/wizard-server/test/Wizard/Specs/API/Migration/KnowledgeModel/List_Current_Conflict_POST.hs deleted file mode 100644 index 982f2946f..000000000 --- a/wizard-server/test/Wizard/Specs/API/Migration/KnowledgeModel/List_Current_Conflict_POST.hs +++ /dev/null @@ -1,136 +0,0 @@ -module Wizard.Specs.API.Migration.KnowledgeModel.List_Current_Conflict_POST ( - list_current_conflict_POST, -) where - -import Data.Aeson (encode) -import Data.Maybe (fromJust) -import qualified Data.UUID as U -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Model.Error.Error -import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationDTO -import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationResolutionDTO -import Wizard.Database.Migration.Development.KnowledgeModel.Data.Editor.KnowledgeModelEditors -import Wizard.Database.Migration.Development.KnowledgeModel.Data.Migration.KnowledgeModelMigrations -import Wizard.Localization.Messages.Public -import Wizard.Model.Context.AppContext -import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditorList -import Wizard.Model.KnowledgeModel.Migration.KnowledgeModelMigration -import Wizard.Service.KnowledgeModel.Migration.MigrationService - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.API.Migration.KnowledgeModel.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- POST /wizard-api/knowledge-model-editors/uuid/migrations/current/conflict --- ------------------------------------------------------------------------ -list_current_conflict_POST :: AppContext -> SpecWith ((), Application) -list_current_conflict_POST appContext = - describe "POST /wizard-api/knowledge-model-editors/{uuid}/migrations/current/conflict" $ do - test_204 appContext - test_400 appContext - test_401 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodPost - -reqUrl = "/wizard-api/knowledge-model-editors/6474b24b-262b-42b1-9451-008e8363f2b6/migrations/current/conflict" - -reqHeaders = [reqAuthHeader, reqCtHeader] - -reqDto = migratorConflict - -reqBody = encode reqDto - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_204 appContext = - it "HTTP 204 NO CONTENT" $ - -- GIVEN: Prepare expectation - do - let expStatus = 204 - let expHeaders = resCtHeader : resCorsHeaders - let expBody = "" - -- AND: Prepare database - runMigrationWithFullDB appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - -- AND: Find result in DB and compare with expectation state - assertStateOfMigrationInDB appContext migratorState CompletedKnowledgeModelMigrationState - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_400 appContext = do - createInvalidJsonTest reqMethod reqUrl "targetPackageId" - it "HTTP 400 BAD REQUEST when originalEventUuid doesn't match with current target event" $ - -- GIVEN: Prepare request - do - let reqDtoEdited = reqDto {originalEventUuid = fromJust . U.fromString $ "30ac5193-5685-41b1-86d7-ab0b356c516a"} - let reqBody = encode reqDtoEdited - -- AND: Prepare expectation - let expStatus = 400 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = UserError _ERROR_SERVICE_MIGRATION_KM__EVENT_UUIDS_MISMATCH - let expBody = encode expDto - -- AND: Prepare database - runMigrationWithFullDB appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- AND: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - it "HTTP 400 BAD REQUEST when you can't solve conflicts because Migration state isn't in conflict state" $ - -- GIVEN: Prepare expectation - do - let expStatus = 400 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = UserError _ERROR_SERVICE_MIGRATION_KM__NO_CONFLICTS_TO_SOLVE - let expBody = encode expDto - -- AND: Prepare database - runMigrationWithFullDB appContext - runInContextIO (solveConflictAndMigrate amsterdamKnowledgeModelEditorList.uuid reqDto) appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- AND: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod reqUrl [reqCtHeader] reqBody - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [reqCtHeader] reqBody "KM_UPGRADE_PERM" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - reqUrl - reqHeaders - reqBody - "knowledge_model_migration" - [("editor_uuid", "6474b24b-262b-42b1-9451-008e8363f2b6")] diff --git a/wizard-server/test/Wizard/Specs/API/Migration/KnowledgeModel/List_Current_DELETE.hs b/wizard-server/test/Wizard/Specs/API/Migration/KnowledgeModel/List_Current_DELETE.hs deleted file mode 100644 index aaefe72e9..000000000 --- a/wizard-server/test/Wizard/Specs/API/Migration/KnowledgeModel/List_Current_DELETE.hs +++ /dev/null @@ -1,82 +0,0 @@ -module Wizard.Specs.API.Migration.KnowledgeModel.List_Current_DELETE ( - list_current_DELETE, -) where - -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelMigrationDAO -import Wizard.Model.Context.AppContext - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.API.Migration.KnowledgeModel.Common - --- ------------------------------------------------------------------------ --- DELETE /wizard-api/knowledge-model-editors/{uuid}/migrations/current --- ------------------------------------------------------------------------ -list_current_DELETE :: AppContext -> SpecWith ((), Application) -list_current_DELETE appContext = - describe "DELETE /wizard-api/knowledge-model-editors/{uuid}/migrations/current" $ do - test_204 appContext - test_401 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodDelete - -reqUrl = "/wizard-api/knowledge-model-editors/6474b24b-262b-42b1-9451-008e8363f2b6/migrations/current" - -reqHeaders = [reqAuthHeader, reqCtHeader] - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_204 appContext = - it "HTTP 204 NO CONTENT" $ - -- GIVEN: Prepare expectation - do - let expStatus = 204 - let expBody = "" - let expHeaders = resCorsHeaders - -- AND: Prepare database - runMigrationWithFullDB appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - -- AND: Find result in DB and compare with expectation state - assertCountInDB findMigratorStates appContext 0 - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod reqUrl [] "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [] "" "KM_UPGRADE_PERM" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - reqUrl - reqHeaders - reqBody - "knowledge_model_migration" - [("editor_uuid", "6474b24b-262b-42b1-9451-008e8363f2b6")] diff --git a/wizard-server/test/Wizard/Specs/API/Migration/KnowledgeModel/List_Current_GET.hs b/wizard-server/test/Wizard/Specs/API/Migration/KnowledgeModel/List_Current_GET.hs deleted file mode 100644 index f936d8727..000000000 --- a/wizard-server/test/Wizard/Specs/API/Migration/KnowledgeModel/List_Current_GET.hs +++ /dev/null @@ -1,81 +0,0 @@ -module Wizard.Specs.API.Migration.KnowledgeModel.List_Current_GET ( - list_current_GET, -) where - -import Data.Aeson (encode) -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Wizard.Database.Migration.Development.KnowledgeModel.Data.Migration.KnowledgeModelMigrations -import Wizard.Model.Context.AppContext - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.API.Migration.KnowledgeModel.Common - --- ------------------------------------------------------------------------ --- GET /wizard-api/knowledge-model-editors/{uuid}/migrations/current --- ------------------------------------------------------------------------ -list_current_GET :: AppContext -> SpecWith ((), Application) -list_current_GET appContext = - describe "GET /wizard-api/knowledge-model-editors/{uuid}/migrations/current" $ do - test_200 appContext - test_401 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodGet - -reqUrl = "/wizard-api/knowledge-model-editors/6474b24b-262b-42b1-9451-008e8363f2b6/migrations/current" - -reqHeaders = [reqAuthHeader, reqCtHeader] - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = - it "HTTP 200 OK" $ - -- GIVEN: Prepare expectation - do - let expStatus = 200 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = migratorState - let expBody = encode expDto - -- AND: Prepare database - runMigrationWithFullDB appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod reqUrl [] reqBody - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [] "" "KM_UPGRADE_PERM" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - reqUrl - reqHeaders - reqBody - "knowledge_model_migration" - [("editor_uuid", "6474b24b-262b-42b1-9451-008e8363f2b6")] diff --git a/wizard-server/test/Wizard/Specs/API/Migration/KnowledgeModel/List_Current_POST.hs b/wizard-server/test/Wizard/Specs/API/Migration/KnowledgeModel/List_Current_POST.hs deleted file mode 100644 index 1face7a93..000000000 --- a/wizard-server/test/Wizard/Specs/API/Migration/KnowledgeModel/List_Current_POST.hs +++ /dev/null @@ -1,177 +0,0 @@ -module Wizard.Specs.API.Migration.KnowledgeModel.List_Current_POST ( - list_current_POST, -) where - -import Data.Aeson (encode) -import qualified Data.UUID as U -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackage -import Wizard.Api.Resource.KnowledgeModel.Editor.KnowledgeModelEditorCreateDTO -import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationCreateDTO -import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelMigrationDAO -import Wizard.Database.Migration.Development.KnowledgeModel.Data.Editor.KnowledgeModelEditors -import Wizard.Database.Migration.Development.KnowledgeModel.Data.Migration.KnowledgeModelMigrations -import Wizard.Database.Migration.Development.Tenant.Data.Tenants -import Wizard.Database.Migration.Development.User.Data.Users -import Wizard.Localization.Messages.Public -import Wizard.Model.Context.AppContext -import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditorList -import Wizard.Model.Tenant.Tenant -import Wizard.Service.KnowledgeModel.Editor.EditorService -import qualified Wizard.Service.User.UserMapper as U_Mapper - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.API.Migration.KnowledgeModel.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- POST /wizard-api/knowledge-model-editors/{uuid}/migrations/current --- ------------------------------------------------------------------------ -list_current_POST :: AppContext -> SpecWith ((), Application) -list_current_POST appContext = - describe "POST /wizard-api/knowledge-model-editors/{uuid}/migrations/current" $ do - test_201 appContext - test_400 appContext - test_401 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodPost - -reqUrl = "/wizard-api/knowledge-model-editors/6474b24b-262b-42b1-9451-008e8363f2b6/migrations/current" - -reqHeaders = [reqAuthHeader, reqCtHeader] - -reqDto = migratorStateCreate - -reqBody = encode reqDto - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_201 appContext = - it "HTTP 201 CREATED" $ - -- GIVEN: Prepare expectation - do - let expStatus = 201 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = migratorState - let expBody = encode expDto - -- AND: Prepare database - runMigrationWithEmptyDB appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - -- AND: Find result in DB and compare with expectation state - assertCountInDB findMigratorStates appContext 1 - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_400 appContext = do - createInvalidJsonTest reqMethod reqUrl "targetPackageId" - it "HTTP 400 BAD REQUEST when migration is already created" $ - -- GIVEN: Prepare expectation - do - let expStatus = 400 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = UserError _ERROR_VALIDATION__KM_MIGRATION_UNIQUENESS - let expBody = encode expDto - -- AND: Prepare database - runMigrationWithFullDB appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- AND: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - it "HTTP 400 BAD REQUEST when target Package is not higher than current one" $ - -- GIVEN: Prepare request - do - let reqDto = KnowledgeModelMigrationCreateDTO {targetPackageId = "org.nl:core-nl:0.9.0"} - let reqBody = encode reqDto - -- AND: Prepare expectation - let expStatus = 400 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = UserError _ERROR_SERVICE_MIGRATION_KM__TARGET_PKG_IS_NOT_HIGHER - let expBody = encode expDto - -- AND: Prepare database - runMigrationWithEmptyDB appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- AND: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - it "HTTP 400 BAD REQUEST when KM editor has to have a previous package" $ - -- AND: Prepare expectation - do - let expStatus = 400 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = UserError _ERROR_VALIDATION__KM_EDITOR_PREVIOUS_PKG_ABSENCE - let expBody = encode expDto - -- AND: Prepare database - let editor = amsterdamKnowledgeModelEditorCreate {previousPackageId = Nothing} :: KnowledgeModelEditorCreateDTO - let editorUuid = amsterdamKnowledgeModelEditorList.uuid - let timestamp = amsterdamKnowledgeModelEditorList.createdAt - let user = U_Mapper.toDTO userAlbert - runInContextIO (createEditorWithParams editorUuid timestamp user editor) appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- AND: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod reqUrl [reqCtHeader] reqBody - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [reqCtHeader] reqBody "KM_UPGRADE_PERM" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = do - createNotFoundTest' reqMethod reqUrl reqHeaders reqBody "knowledge_model_editor" [("uuid", "6474b24b-262b-42b1-9451-008e8363f2b6")] - it "HTTP 404 NOT FOUND when target previous package doesn’t exist" $ - -- GIVEN: Prepare expectation - do - let expStatus = 404 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = - NotExistsError - ( _ERROR_DATABASE__ENTITY_NOT_FOUND - "knowledge_model_package" - [("tenant_uuid", U.toString defaultTenant.uuid), ("id", "org.nl:core-nl:2.0.0")] - ) - let expBody = encode expDto - -- AND: Prepare database - runMigrationWithEmptyDB appContext - runInContextIO (deletePackageById netherlandsKmPackageV2.pId) appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- AND: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher diff --git a/wizard-server/test/Wizard/Specs/API/Migration/Questionnaire/APISpec.hs b/wizard-server/test/Wizard/Specs/API/Migration/Questionnaire/APISpec.hs deleted file mode 100644 index aac8cf1f3..000000000 --- a/wizard-server/test/Wizard/Specs/API/Migration/Questionnaire/APISpec.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Wizard.Specs.API.Migration.Questionnaire.APISpec where - -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) - -import Wizard.Specs.API.Common -import Wizard.Specs.API.Migration.Questionnaire.List_Current_Completion_POST -import Wizard.Specs.API.Migration.Questionnaire.List_Current_DELETE -import Wizard.Specs.API.Migration.Questionnaire.List_Current_GET -import Wizard.Specs.API.Migration.Questionnaire.List_Current_PUT -import Wizard.Specs.API.Migration.Questionnaire.List_POST - -migrationAPI baseContext appContext = - with (startWebApp baseContext appContext) $ - describe "MIGRATION QUESTIONNAIRE API Spec" $ do - list_POST appContext - list_current_GET appContext - list_current_PUT appContext - list_current_DELETE appContext - list_current_completion_POST appContext diff --git a/wizard-server/test/Wizard/Specs/API/Migration/Questionnaire/Common.hs b/wizard-server/test/Wizard/Specs/API/Migration/Questionnaire/Common.hs deleted file mode 100644 index 41445ff6c..000000000 --- a/wizard-server/test/Wizard/Specs/API/Migration/Questionnaire/Common.hs +++ /dev/null @@ -1,37 +0,0 @@ -module Wizard.Specs.API.Migration.Questionnaire.Common where - -import Data.Either (isRight) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Wizard.Database.DAO.Questionnaire.MigratorDAO -import Wizard.Model.Questionnaire.MigratorState - -import Wizard.Specs.API.Questionnaire.Common -import Wizard.Specs.Common - --- -------------------------------- --- ASSERTS --- -------------------------------- -assertExistenceOfMigrationStateInDB appContext entity = do - eEntitiesFromDb <- - runInContextIO (findMigratorStatesByOldQuestionnaireUuid entity.oldQuestionnaireUuid) appContext - liftIO $ isRight eEntitiesFromDb `shouldBe` True - let (Right entitiesFromDb) = eEntitiesFromDb - liftIO $ length entitiesFromDb `shouldBe` 1 - let entityFromDb = head entitiesFromDb - compareQtnMigrators entityFromDb entity - --- -------------------------------- --- COMPARATORS --- -------------------------------- -compareQtnMigrators resDto expDto = do - liftIO $ resDto.oldQuestionnaireUuid `shouldBe` expDto.oldQuestionnaireUuid - liftIO $ resDto.newQuestionnaireUuid `shouldBe` expDto.newQuestionnaireUuid - liftIO $ resDto.resolvedQuestionUuids `shouldBe` expDto.resolvedQuestionUuids - -compareQtnMigratorDtos resDto expDto = do - compareQuestionnaireCreateDtos'' resDto.oldQuestionnaire expDto.oldQuestionnaire - compareQuestionnaireCreateDtos'' resDto.newQuestionnaire expDto.newQuestionnaire - liftIO $ resDto.resolvedQuestionUuids `shouldBe` expDto.resolvedQuestionUuids diff --git a/wizard-server/test/Wizard/Specs/API/Migration/Questionnaire/List_Current_Completion_POST.hs b/wizard-server/test/Wizard/Specs/API/Migration/Questionnaire/List_Current_Completion_POST.hs deleted file mode 100644 index f2072940e..000000000 --- a/wizard-server/test/Wizard/Specs/API/Migration/Questionnaire/List_Current_Completion_POST.hs +++ /dev/null @@ -1,135 +0,0 @@ -module Wizard.Specs.API.Migration.Questionnaire.List_Current_Completion_POST ( - list_current_completion_POST, -) where - -import Data.Aeson (encode) -import qualified Data.ByteString.Char8 as BS -import qualified Data.UUID as U -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Wizard.Database.DAO.Questionnaire.MigratorDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.MigratorStates -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.MigratorMigration as QTN_MIG -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.MigratorState -import Wizard.Model.Questionnaire.Questionnaire - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- POST /wizard-api/questionnaires/{qtnUuid}/migrations/current/completion --- ------------------------------------------------------------------------ -list_current_completion_POST :: AppContext -> SpecWith ((), Application) -list_current_completion_POST appContext = - describe "POST /wizard-api/questionnaires/{qtnUuid}/migrations/current/completion" $ do - test_204 appContext - test_401 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodPost - -reqUrlT qtnUuid = BS.pack $ "/wizard-api/questionnaires/" ++ U.toString qtnUuid ++ "/migrations/current/completion" - -reqHeadersT authHeader = [authHeader] - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_204 appContext = - it "HTTP 204 NO CONTENT" $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT $ questionnaire4Upgraded.uuid - let reqHeaders = reqHeadersT reqAuthHeader - -- AND: Prepare expectation - let expStatus = 204 - let expBody = "" - let expHeaders = resCorsHeaders - -- AND: Prepare database - runInContextIO TML.runMigration appContext - runInContextIO (insertQuestionnaire questionnaire4) appContext - runInContextIO (insertQuestionnaire questionnaire4Upgraded) appContext - runInContextIO (insertQuestionnaire differentQuestionnaire) appContext - runInContextIO QTN_MIG.runMigration appContext - runInContextIO (insertMigratorState nlQtnMigrationState) appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - -- AND: Find result in DB and compare with expectation state - assertCountInDB findQuestionnaires appContext 1 - assertCountInDB findMigratorStates appContext 0 - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod (reqUrlT questionnaire3.uuid) [] reqBody - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = do - createNoPermissionTest appContext reqMethod (reqUrlT questionnaire3.uuid) [] "" "QTN_PERM" - create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, Private)" appContext questionnaire1 "View Questionnaire" - create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, VisibleView)" appContext questionnaire2 "Migrate Questionnaire" - -create_test_403 title appContext qtn reason = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT $ qtn.uuid - let reqHeaders = reqHeadersT reqNonAdminAuthHeader - -- AND: Prepare expectation - let expStatus = 403 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN reason - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - let ms = nlQtnMigrationState {oldQuestionnaireUuid = qtn.uuid, newQuestionnaireUuid = qtn.uuid} - runInContextIO (insertMigratorState ms) appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - -- AND: Find result in DB and compare with expectation state - assertCountInDB findQuestionnaires appContext 3 - assertCountInDB findMigratorStates appContext 1 - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - (reqUrlT questionnaire4.uuid) - (reqHeadersT reqAuthHeader) - reqBody - "questionnaire_migration" - [("new_questionnaire_uuid", "57250a07-a663-4ff3-ac1f-16530f2c1bfe")] diff --git a/wizard-server/test/Wizard/Specs/API/Migration/Questionnaire/List_Current_DELETE.hs b/wizard-server/test/Wizard/Specs/API/Migration/Questionnaire/List_Current_DELETE.hs deleted file mode 100644 index a501eaa9b..000000000 --- a/wizard-server/test/Wizard/Specs/API/Migration/Questionnaire/List_Current_DELETE.hs +++ /dev/null @@ -1,135 +0,0 @@ -module Wizard.Specs.API.Migration.Questionnaire.List_Current_DELETE ( - list_current_DELETE, -) where - -import Data.Aeson (encode) -import qualified Data.ByteString.Char8 as BS -import qualified Data.UUID as U -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Wizard.Database.DAO.Questionnaire.MigratorDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.MigratorStates -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.MigratorMigration as QTN_MIG -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.MigratorState -import Wizard.Model.Questionnaire.Questionnaire - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- DELETE /wizard-api/questionnaires/{qtnUuid}/migrations/current --- ------------------------------------------------------------------------ -list_current_DELETE :: AppContext -> SpecWith ((), Application) -list_current_DELETE appContext = - describe "DELETE /wizard-api/questionnaires/{qtnUuid}/migrations/current" $ do - test_204 appContext - test_401 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodDelete - -reqUrlT qtnUuid = BS.pack $ "/wizard-api/questionnaires/" ++ U.toString qtnUuid ++ "/migrations/current" - -reqHeadersT authHeader = [authHeader] - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_204 appContext = - it "HTTP 204 NO CONTENT" $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT $ questionnaire4Upgraded.uuid - let reqHeaders = reqHeadersT reqAuthHeader - -- AND: Prepare expectation - let expStatus = 204 - let expBody = "" - let expHeaders = resCorsHeaders - -- AND: Prepare database - runInContextIO TML.runMigration appContext - runInContextIO (insertQuestionnaire questionnaire4) appContext - runInContextIO (insertQuestionnaire questionnaire4Upgraded) appContext - runInContextIO (insertQuestionnaire differentQuestionnaire) appContext - runInContextIO QTN_MIG.runMigration appContext - runInContextIO (insertMigratorState nlQtnMigrationState) appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - -- AND: Find result in DB and compare with expectation state - assertCountInDB findQuestionnaires appContext 1 - assertCountInDB findMigratorStates appContext 0 - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod (reqUrlT questionnaire3.uuid) [] reqBody - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = do - createNoPermissionTest appContext reqMethod (reqUrlT questionnaire3.uuid) [] "" "QTN_PERM" - create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, Private)" appContext questionnaire1 "View Questionnaire" - create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, VisibleView)" appContext questionnaire2 "Migrate Questionnaire" - -create_test_403 title appContext qtn reason = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT $ qtn.uuid - let reqHeaders = reqHeadersT reqNonAdminAuthHeader - -- AND: Prepare expectation - let expStatus = 403 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN reason - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - let ms = nlQtnMigrationState {oldQuestionnaireUuid = qtn.uuid, newQuestionnaireUuid = qtn.uuid} - runInContextIO (insertMigratorState ms) appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - -- AND: Find result in DB and compare with expectation state - assertCountInDB findQuestionnaires appContext 3 - assertCountInDB findMigratorStates appContext 1 - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - (reqUrlT questionnaire4.uuid) - (reqHeadersT reqAuthHeader) - reqBody - "questionnaire_migration" - [("new_questionnaire_uuid", "57250a07-a663-4ff3-ac1f-16530f2c1bfe")] diff --git a/wizard-server/test/Wizard/Specs/API/Migration/Questionnaire/List_Current_GET.hs b/wizard-server/test/Wizard/Specs/API/Migration/Questionnaire/List_Current_GET.hs deleted file mode 100644 index 1ee128755..000000000 --- a/wizard-server/test/Wizard/Specs/API/Migration/Questionnaire/List_Current_GET.hs +++ /dev/null @@ -1,165 +0,0 @@ -module Wizard.Specs.API.Migration.Questionnaire.List_Current_GET ( - list_current_GET, -) where - -import Data.Aeson (encode) -import qualified Data.ByteString.Char8 as BS -import qualified Data.UUID as U -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Wizard.Database.DAO.Questionnaire.MigratorDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireEventDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.MigratorStates -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.MigratorMigration as QTN_MIG -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.MigratorState -import Wizard.Model.Questionnaire.Questionnaire - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- GET /wizard-api/questionnaires/{qtnUuid}/migrations/current --- ------------------------------------------------------------------------ -list_current_GET :: AppContext -> SpecWith ((), Application) -list_current_GET appContext = - describe "GET /wizard-api/questionnaires/{qtnUuid}/migrations/current" $ do - test_200 appContext - test_401 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodGet - -reqUrlT qtnUuid = BS.pack $ "/wizard-api/questionnaires/" ++ U.toString qtnUuid ++ "/migrations/current" - -reqHeadersT authHeader = [authHeader, reqCtHeader] - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = do - create_test_200 - "HTTP 200 OK (Owner, Private)" - appContext - questionnaire4 - questionnaire4Events - questionnaire4Upgraded - questionnaire4UpgradedEvents - nlQtnMigrationState - nlQtnMigrationStateDto - reqNonAdminAuthHeader - create_test_200 - "HTTP 200 OK (Non-Owner, VisibleView)" - appContext - questionnaire4VisibleView - questionnaire4VisibleViewEvents - questionnaire4VisibleViewUpgraded - questionnaire4VisibleViewUpgradedEvents - nlQtnMigrationState - nlQtnMigrationStateVisibleViewDto - reqNonAdminAuthHeader - create_test_200 - "HTTP 200 OK (Non-Owner, Public)" - appContext - questionnaire4VisibleEdit - questionnaire4VisibleEditEvents - questionnaire4VisibleEditUpgraded - questionnaire4VisibleEditUpgradedEvents - nlQtnMigrationState - nlQtnMigrationStateVisibleEditDto - reqNonAdminAuthHeader - -create_test_200 title appContext oldQtn oldQtnEvents newQtn newQtnEvents state stateDto authHeader = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT $ questionnaire4Upgraded.uuid - let reqHeaders = reqHeadersT reqAuthHeader - -- AND: Prepare expectation - let expStatus = 200 - let expDto = stateDto - let expBody = encode expDto - let expHeaders = resCtHeader : resCorsHeaders - -- AND: Prepare database - runInContextIO TML.runMigration appContext - runInContextIO (insertQuestionnaire oldQtn) appContext - runInContextIO (insertQuestionnaireEvents oldQtnEvents) appContext - runInContextIO (insertQuestionnaire newQtn) appContext - runInContextIO (insertQuestionnaireEvents newQtnEvents) appContext - runInContextIO (insertQuestionnaire differentQuestionnaire) appContext - runInContextIO (insertQuestionnaireEvents differentQuestionnaireEvents) appContext - runInContextIO QTN_MIG.runMigration appContext - runInContextIO (insertMigratorState state) appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod (reqUrlT questionnaire4.uuid) [] reqBody - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = do - createNoPermissionTest appContext reqMethod (reqUrlT questionnaire3.uuid) [] "" "QTN_PERM" - create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, Private)" appContext questionnaire1 "View Questionnaire" - create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, VisibleView)" appContext questionnaire2 "Migrate Questionnaire" - -create_test_403 title appContext qtn reason = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT $ qtn.uuid - let reqHeaders = reqHeadersT reqNonAdminAuthHeader - -- AND: Prepare expectation - let expStatus = 403 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN reason - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - let ms = nlQtnMigrationState {oldQuestionnaireUuid = qtn.uuid, newQuestionnaireUuid = qtn.uuid} - runInContextIO (insertMigratorState ms) appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - (reqUrlT questionnaire4.uuid) - (reqHeadersT reqAuthHeader) - reqBody - "questionnaire_migration" - [("new_questionnaire_uuid", "57250a07-a663-4ff3-ac1f-16530f2c1bfe")] diff --git a/wizard-server/test/Wizard/Specs/API/Migration/Questionnaire/List_Current_PUT.hs b/wizard-server/test/Wizard/Specs/API/Migration/Questionnaire/List_Current_PUT.hs deleted file mode 100644 index 452e74738..000000000 --- a/wizard-server/test/Wizard/Specs/API/Migration/Questionnaire/List_Current_PUT.hs +++ /dev/null @@ -1,141 +0,0 @@ -module Wizard.Specs.API.Migration.Questionnaire.List_Current_PUT ( - list_current_PUT, -) where - -import Data.Aeson (encode) -import qualified Data.ByteString.Char8 as BS -import qualified Data.UUID as U -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Wizard.Database.DAO.Questionnaire.MigratorDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireEventDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.MigratorStates -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.MigratorMigration as QTN_MIG -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.MigratorState -import Wizard.Model.Questionnaire.Questionnaire - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- PUT /wizard-api/questionnaires/{qtnUuid}/migrations/current --- ------------------------------------------------------------------------ -list_current_PUT :: AppContext -> SpecWith ((), Application) -list_current_PUT appContext = - describe "PUT /wizard-api/questionnaires/{qtnUuid}/migrations/current" $ do - test_204 appContext - test_400 appContext - test_401 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodPut - -reqUrlT qtnUuid = BS.pack $ "/wizard-api/questionnaires/" ++ U.toString qtnUuid ++ "/migrations/current" - -reqHeadersT authHeader = [authHeader, reqCtHeader] - -reqDto = migratorStateChange - -reqBody = encode reqDto - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_204 appContext = - it "HTTP 204 NO CONTENT" $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT $ questionnaire4Upgraded.uuid - let reqHeaders = reqHeadersT reqAuthHeader - -- AND: Prepare expectation - let expStatus = 200 - let expDto = nlQtnMigrationStateDtoEdited - let expBody = encode expDto - let expHeaders = resCtHeader : resCorsHeaders - -- AND: Prepare database - runInContextIO TML.runMigration appContext - runInContextIO (insertQuestionnaire questionnaire4) appContext - runInContextIO (insertQuestionnaireEvents questionnaire4Events) appContext - runInContextIO (insertQuestionnaire questionnaire4Upgraded) appContext - runInContextIO (insertQuestionnaireEvents questionnaire4UpgradedEvents) appContext - runInContextIO (insertQuestionnaire differentQuestionnaire) appContext - runInContextIO (insertQuestionnaireEvents differentQuestionnaireEvents) appContext - runInContextIO QTN_MIG.runMigration appContext - runInContextIO (insertMigratorState nlQtnMigrationState) appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_400 appContext = createInvalidJsonTest reqMethod (reqUrlT questionnaire4.uuid) "resolvedQuestionUuids" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod (reqUrlT questionnaire4.uuid) [reqCtHeader] reqBody - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = do - createNoPermissionTest appContext reqMethod (reqUrlT questionnaire3.uuid) [reqCtHeader] reqBody "QTN_PERM" - create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, Private)" appContext questionnaire1 "View Questionnaire" - create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, VisibleView)" appContext questionnaire2 "Migrate Questionnaire" - -create_test_403 title appContext qtn reason = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT $ qtn.uuid - let reqHeaders = reqHeadersT reqNonAdminAuthHeader - -- AND: Prepare expectation - let expStatus = 403 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN reason - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - let ms = nlQtnMigrationState {oldQuestionnaireUuid = qtn.uuid, newQuestionnaireUuid = qtn.uuid} - runInContextIO (insertMigratorState ms) appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - (reqUrlT questionnaire4.uuid) - (reqHeadersT reqAuthHeader) - reqBody - "questionnaire_migration" - [("new_questionnaire_uuid", "57250a07-a663-4ff3-ac1f-16530f2c1bfe")] diff --git a/wizard-server/test/Wizard/Specs/API/Migration/Questionnaire/List_POST.hs b/wizard-server/test/Wizard/Specs/API/Migration/Questionnaire/List_POST.hs deleted file mode 100644 index 1659cc406..000000000 --- a/wizard-server/test/Wizard/Specs/API/Migration/Questionnaire/List_POST.hs +++ /dev/null @@ -1,183 +0,0 @@ -module Wizard.Specs.API.Migration.Questionnaire.List_POST ( - list_POST, -) where - -import Data.Aeson (encode) -import qualified Data.ByteString.Char8 as BS -import qualified Data.UUID as U -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateDTO -import Wizard.Api.Resource.Questionnaire.Migration.MigratorStateJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailQuestionnaireDTO -import Wizard.Database.DAO.Questionnaire.MigratorDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireEventDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.MigratorStates -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.MigratorMigration as QTN_MIG -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.MigratorState -import Wizard.Model.Questionnaire.Questionnaire - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.API.Migration.Questionnaire.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- POST /wizard-api/questionnaires/{qtnUuid}/migrations --- ------------------------------------------------------------------------ -list_POST :: AppContext -> SpecWith ((), Application) -list_POST appContext = - describe "POST /wizard-api/questionnaires/{qtnUuid}/migrations" $ do - test_201 appContext - test_400 appContext - test_401 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodPost - -reqUrlT qtnUuid = BS.pack $ "/wizard-api/questionnaires/" ++ U.toString qtnUuid ++ "/migrations" - -reqHeadersT authHeader = [authHeader, reqCtHeader] - -reqDto = migratorStateCreate - -reqBody = encode reqDto - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_201 appContext = do - create_test_201 - "HTTP 201 CREATED (Owner, Private)" - appContext - questionnaire4 - questionnaire4Events - questionnaire4Upgraded - questionnaire4UpgradedEvents - nlQtnMigrationState - nlQtnMigrationStateDto - reqNonAdminAuthHeader - create_test_201 - "HTTP 201 CREATED (Non-Owner, VisibleView)" - appContext - questionnaire4VisibleView - questionnaire4VisibleViewEvents - questionnaire4VisibleViewUpgraded - questionnaire4VisibleViewUpgradedEvents - nlQtnMigrationState - nlQtnMigrationStateVisibleViewDto - reqNonAdminAuthHeader - create_test_201 - "HTTP 201 CREATED (Non-Owner, Public)" - appContext - questionnaire4VisibleEdit - questionnaire4VisibleEditEvents - questionnaire4VisibleEditUpgraded - questionnaire4VisibleEditUpgradedEvents - nlQtnMigrationState - nlQtnMigrationStateVisibleEditDto - reqNonAdminAuthHeader - -create_test_201 title appContext oldQtn oldQtnEvents newQtn newQtnEvents state stateDto authHeader = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT $ oldQtn.uuid - let reqHeaders = reqHeadersT reqAuthHeader - -- AND: Prepare expectation - let expStatus = 201 - let expHeaders = resCorsHeadersPlain - let expDto = stateDto {resolvedQuestionUuids = []} :: MigratorStateDTO - let expBody = encode expDto - -- AND: Prepare database - runInContextIO TML.runMigration appContext - runInContextIO (insertQuestionnaire oldQtn) appContext - runInContextIO (insertQuestionnaireEvents oldQtnEvents) appContext - runInContextIO (insertQuestionnaire newQtn) appContext - runInContextIO (insertQuestionnaireEvents newQtnEvents) appContext - runInContextIO (insertQuestionnaire differentQuestionnaire) appContext - runInContextIO (insertQuestionnaireEvents differentQuestionnaireEvents) appContext - runInContextIO QTN_MIG.runMigration appContext - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let (status, headers, resBody) = destructResponse response :: (Int, ResponseHeaders, MigratorStateDTO) - assertResStatus status expStatus - assertResHeaders headers expHeaders - compareQtnMigratorDtos resBody expDto - -- AND: Find a result in DB - let entityInDB = - state - { newQuestionnaireUuid = resBody.newQuestionnaire.uuid - , resolvedQuestionUuids = [] - } - assertExistenceOfMigrationStateInDB appContext entityInDB - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_400 appContext = createInvalidJsonTest reqMethod (reqUrlT questionnaire4.uuid) "targetKnowledgeModelPackageId" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod (reqUrlT questionnaire4.uuid) [reqCtHeader] reqBody - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = do - createNoPermissionTest appContext reqMethod (reqUrlT questionnaire3.uuid) [reqCtHeader] reqBody "QTN_PERM" - create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, Private)" appContext questionnaire1 "Migrate Questionnaire" - create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, VisibleView)" appContext questionnaire2 "Migrate Questionnaire" - -create_test_403 title appContext qtn reason = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT $ qtn.uuid - let reqHeaders = reqHeadersT reqNonAdminAuthHeader - -- AND: Prepare expectation - let expStatus = 403 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN reason - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - -- AND: Find result in DB and compare with expectation state - assertCountInDB findMigratorStates appContext 0 - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - (reqUrlT questionnaire4.uuid) - (reqHeadersT reqAuthHeader) - reqBody - "questionnaire" - [("uuid", "57250a07-a663-4ff3-ac1f-16530f2c1bfe")] diff --git a/wizard-server/test/Wizard/Specs/API/Project/APISpec.hs b/wizard-server/test/Wizard/Specs/API/Project/APISpec.hs new file mode 100644 index 000000000..9ae37a080 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/APISpec.hs @@ -0,0 +1,54 @@ +module Wizard.Specs.API.Project.APISpec where + +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) + +import Wizard.Specs.API.Common +import Wizard.Specs.API.Project.Comment.APISpec +import Wizard.Specs.API.Project.Detail_Content_PUT +import Wizard.Specs.API.Project.Detail_DELETE +import Wizard.Specs.API.Project.Detail_Documents_GET +import Wizard.Specs.API.Project.Detail_GET +import Wizard.Specs.API.Project.Detail_Preview_GET +import Wizard.Specs.API.Project.Detail_Questionnaire_GET +import Wizard.Specs.API.Project.Detail_Report_GET +import Wizard.Specs.API.Project.Detail_Revert_POST +import Wizard.Specs.API.Project.Detail_Revert_Preview_POST +import Wizard.Specs.API.Project.Detail_Settings_GET +import Wizard.Specs.API.Project.Detail_Settings_PUT +import Wizard.Specs.API.Project.Detail_Share_PUT +import Wizard.Specs.API.Project.Event.APISpec +import Wizard.Specs.API.Project.List_GET +import Wizard.Specs.API.Project.List_POST +import Wizard.Specs.API.Project.List_POST_CloneUuid +import Wizard.Specs.API.Project.List_POST_FromTemplate +import Wizard.Specs.API.Project.Migration.APISpec +import Wizard.Specs.API.Project.ProjectTag.APISpec +import Wizard.Specs.API.Project.User.APISpec +import Wizard.Specs.API.Project.Version.APISpec + +projectAPI baseContext appContext = + with (startWebApp baseContext appContext) $ + describe "PROJECT API Spec" $ do + list_GET appContext + list_POST appContext + list_POST_fromTemplate appContext + list_POST_cloneUuid appContext + detail_GET appContext + detail_questionnaire_GET appContext + detail_share_PUT appContext + detail_preview_GET appContext + detail_settings_GET appContext + detail_settings_PUT appContext + detail_DELETE appContext + detail_content_PUT appContext + detail_report_GET appContext + detail_documents_GET appContext + detail_revert_POST appContext + detail_revert_preview_POST appContext + projectCommentAPI appContext + projectEventAPI appContext + projectMigrationAPI appContext + projectTagAPI appContext + projectUserAPI appContext + projectVersionAPI appContext diff --git a/wizard-server/test/Wizard/Specs/API/Project/Comment/APISpec.hs b/wizard-server/test/Wizard/Specs/API/Project/Comment/APISpec.hs new file mode 100644 index 000000000..220f16d55 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Comment/APISpec.hs @@ -0,0 +1,9 @@ +module Wizard.Specs.API.Project.Comment.APISpec where + +import Test.Hspec + +import Wizard.Specs.API.Project.Comment.List_GET + +projectCommentAPI appContext = + describe "PROJECT COMMENT API Spec" $ + list_GET appContext diff --git a/wizard-server/test/Wizard/Specs/API/Project/Comment/List_GET.hs b/wizard-server/test/Wizard/Specs/API/Project/Comment/List_GET.hs new file mode 100644 index 000000000..44782a1f3 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Comment/List_GET.hs @@ -0,0 +1,202 @@ +module Wizard.Specs.API.Project.Comment.List_GET ( + list_GET, +) where + +import Data.Aeson (encode) +import qualified Data.ByteString.Char8 as BS +import Data.Foldable (traverse_) +import qualified Data.List as L +import qualified Data.Map.Strict as M +import qualified Data.UUID as U +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Database.DAO.Project.ProjectCommentDAO +import Wizard.Database.DAO.Project.ProjectCommentThreadDAO +import Wizard.Database.DAO.Project.ProjectDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.ProjectComments +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Database.Migration.Development.User.Data.Users +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Comment.ProjectComment +import Wizard.Model.Project.Project +import Wizard.Service.Project.Comment.ProjectCommentMapper +import WizardLib.Public.Localization.Messages.Public + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- GET /wizard-api/projects/{projectUuid}/comments +-- ------------------------------------------------------------------------ +list_GET :: AppContext -> SpecWith ((), Application) +list_GET appContext = + describe "GET /wizard-api/projects/{projectUuid}/comments" $ do + test_200 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodGet + +reqUrlT projectUuid = BS.pack $ "/wizard-api/projects/" ++ U.toString projectUuid ++ "/comments" + +reqHeadersT authHeader = authHeader + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = do + create_test_200 + "HTTP 200 OK (Owner, Private)" + appContext + project1 + [reqAuthHeader] + [project1AlbertEditProjectPermDto] + create_test_200 + "HTTP 200 OK (Commenter)" + appContext + (project13 {visibility = PrivateProjectVisibility}) + [reqNonAdminAuthHeader] + [project13NikolaCommentProjectPermDto] + create_test_200 + "HTTP 200 OK (Non-Commenter, VisibleComment)" + appContext + project13 + [reqIsaacAuthTokenHeader] + [project13NikolaCommentProjectPermDto] + create_test_200 + "HTTP 200 OK (Anonymous, VisibleComment, AnyoneWithLinkComment)" + appContext + (project13 {sharing = AnyoneWithLinkCommentProjectSharing}) + [] + [project13NikolaCommentProjectPermDto] + create_test_200 + "HTTP 200 OK (Non-Owner, VisibleEdit)" + appContext + project3 + [reqNonAdminAuthHeader] + [] + create_test_200 + "HTTP 200 OK (Anonymous, Public, Sharing)" + appContext + project10 + [] + [] + +create_test_200 title appContext project authHeader permissions = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT project.uuid + let reqHeaders = reqHeadersT authHeader + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO (insertPackage germanyKmPackage) appContext + runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext + thread1 <- liftIO . create_cmtQ1_t1 $ project.uuid + comment1 <- liftIO . create_cmtQ1_t1_1 $ thread1.uuid + comment2 <- liftIO . create_cmtQ1_t1_2 $ thread1.uuid + runInContextIO (insertProject project) appContext + runInContextIO (insertProjectCommentThread thread1) appContext + runInContextIO (insertProjectComment comment1) appContext + runInContextIO (insertProjectComment comment2) appContext + -- AND: Prepare expectation + let expStatus = 200 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = M.fromList [(cmtQ1_path, [toCommentThreadList thread1 Nothing (Just userAlbert) (L.sort [toCommentList comment1 (Just userAlbert), toCommentList comment2 (Just userAlbert)])])] + let expBody = encode expDto + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = do + create_test_403 + "HTTP 403 FORBIDDEN (Non-Owner, Private)" + appContext + project1 + [reqNonAdminAuthHeader] + (_ERROR_VALIDATION__FORBIDDEN "Comment Project") + create_test_403 + "HTTP 403 FORBIDDEN (Non-Owner, VisibleView)" + appContext + project2 + [reqNonAdminAuthHeader] + (_ERROR_VALIDATION__FORBIDDEN "Comment Project") + create_test_403 + "HTTP 403 FORBIDDEN (Anonymous, VisibleView, Sharing)" + appContext + project7 + [] + _ERROR_SERVICE_USER__MISSING_USER + create_test_403 + "HTTP 403 FORBIDDEN (Anonymous, VisibleView)" + appContext + project2 + [] + _ERROR_SERVICE_USER__MISSING_USER + create_test_403 + "HTTP 403 FORBIDDEN (Anonymous, Public)" + appContext + project3 + [] + _ERROR_SERVICE_USER__MISSING_USER + +create_test_403 title appContext project authHeader errorMessage = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT project.uuid + let reqHeaders = reqHeadersT authHeader + -- AND: Prepare expectation + let expStatus = 403 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = ForbiddenError errorMessage + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO (insertPackage germanyKmPackage) appContext + runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext + runInContextIO (insertProject project) appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + "/wizard-api/projects/f08ead5f-746d-411b-aee6-77ea3d24016a/comments" + [reqHeadersT reqAuthHeader] + reqBody + "project" + [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Project/Common.hs b/wizard-server/test/Wizard/Specs/API/Project/Common.hs new file mode 100644 index 000000000..af1b11ca2 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Common.hs @@ -0,0 +1,112 @@ +module Wizard.Specs.API.Project.Common where + +import Data.Either (isLeft, isRight) +import qualified Data.UUID as U +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectEventDAO +import Wizard.Database.Migration.Development.Tenant.Data.Tenants +import Wizard.Model.Project.Project +import Wizard.Model.Tenant.Config.TenantConfig +import Wizard.Model.Tenant.Tenant +import Wizard.Service.Tenant.Config.ConfigService + +import Wizard.Specs.Common + +-- -------------------------------- +-- ASSERTS +-- -------------------------------- +assertExistenceOfProjectInDB appContext project projectEvents = do + eProject <- runInContextIO (findProjectByUuid project.uuid) appContext + liftIO $ isRight eProject `shouldBe` True + let (Right projectFromDb) = eProject + compareProjectDtos projectFromDb project + eProjectEvents <- runInContextIO (findProjectEventsByProjectUuid project.uuid) appContext + liftIO $ isRight eProjectEvents `shouldBe` True + let (Right projectEventsFromDb) = eProjectEvents + liftIO $ projectEventsFromDb `shouldBe` projectEvents + +assertExistenceOfProjectContentInDB appContext projectUuid content = do + eProjectEvents <- runInContextIO (findProjectEventsByProjectUuid projectUuid) appContext + liftIO $ isRight eProjectEvents `shouldBe` True + let (Right projectEventsFromDb) = eProjectEvents + compareProjectContentDtos projectEventsFromDb content + +assertAbsenceOfProjectInDB appContext project = do + eProject <- runInContextIO (findProjectByUuid project.uuid) appContext + liftIO $ isLeft eProject `shouldBe` True + let (Left error) = eProject + liftIO $ + error + `shouldBe` NotExistsError + ( _ERROR_DATABASE__ENTITY_NOT_FOUND + "project" + [("tenant_uuid", U.toString defaultTenant.uuid), ("uuid", U.toString project.uuid)] + ) + +-- -------------------------------- +-- COMPARATORS +-- -------------------------------- +compareProjectCreateDtos resDto expDto = do + liftIO $ resDto.name `shouldBe` expDto.name + liftIO $ resDto.visibility `shouldBe` expDto.visibility + liftIO $ resDto.sharing `shouldBe` expDto.sharing + liftIO $ resDto.knowledgeModelPackage `shouldBe` expDto.knowledgeModelPackage + +compareProjectCreateFromTemplateDtos resDto expDto = do + liftIO $ resDto.uuid `shouldNotBe` expDto.uuid + liftIO $ resDto.name `shouldBe` expDto.name + liftIO $ resDto.visibility `shouldBe` expDto.visibility + liftIO $ resDto.sharing `shouldBe` expDto.sharing + liftIO $ resDto.state `shouldBe` expDto.state + liftIO $ resDto.knowledgeModelPackage `shouldBe` expDto.knowledgeModelPackage + +compareProjectCloneDtos resDto expDto = do + liftIO $ resDto.uuid `shouldNotBe` expDto.uuid + liftIO $ resDto.name `shouldBe` ("Copy of " ++ expDto.name) + liftIO $ resDto.visibility `shouldBe` expDto.visibility + liftIO $ resDto.sharing `shouldBe` expDto.sharing + liftIO $ resDto.state `shouldBe` expDto.state + liftIO $ resDto.knowledgeModelPackage `shouldBe` expDto.knowledgeModelPackage + +compareProjectCreateDtos' resDto expDto = do + liftIO $ resDto.name `shouldBe` expDto.name + liftIO $ resDto.phaseUuid `shouldBe` expDto.phaseUuid + liftIO $ resDto.visibility `shouldBe` expDto.visibility + liftIO $ resDto.sharing `shouldBe` expDto.sharing + liftIO $ resDto.state `shouldBe` expDto.state + liftIO $ resDto.knowledgeModelPackage `shouldBe` expDto.knowledgeModelPackage + liftIO $ resDto.selectedQuestionTagUuids `shouldBe` expDto.selectedQuestionTagUuids + liftIO $ resDto.knowledgeModel `shouldBe` expDto.knowledgeModel + liftIO $ resDto.replies `shouldBe` expDto.replies + +compareProjectCreateDtos'' resDto expDto = do + liftIO $ resDto.name `shouldBe` expDto.name + liftIO $ resDto.phaseUuid `shouldBe` expDto.phaseUuid + liftIO $ resDto.visibility `shouldBe` expDto.visibility + liftIO $ resDto.sharing `shouldBe` expDto.sharing + liftIO $ resDto.selectedQuestionTagUuids `shouldBe` expDto.selectedQuestionTagUuids + liftIO $ resDto.knowledgeModel `shouldBe` expDto.knowledgeModel + liftIO $ resDto.replies `shouldBe` expDto.replies + +compareProjectDtos resDto expDto = liftIO $ resDto `shouldBe` expDto + +compareProjectContentDtos resDto expDto = + liftIO $ resDto `shouldBe` expDto + +compareReportDtos resDto expDto = do + liftIO $ resDto.totalReport `shouldBe` expDto.totalReport + liftIO $ resDto.chapterReports `shouldBe` expDto.chapterReports + +-- -------------------------------- +-- HELPERS +-- -------------------------------- +updateAnonymousProjectSharing appContext value = do + (Right tcProject) <- runInContextIO getCurrentTenantConfigProject appContext + let tcProjectUpdated = tcProject {projectSharing = tcProject.projectSharing {anonymousEnabled = value}} + runInContextIO (modifyTenantConfigProject tcProjectUpdated) appContext diff --git a/wizard-server/test/Wizard/Specs/API/Project/Detail_Content_PUT.hs b/wizard-server/test/Wizard/Specs/API/Project/Detail_Content_PUT.hs new file mode 100644 index 000000000..f2acab919 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Detail_Content_PUT.hs @@ -0,0 +1,176 @@ +module Wizard.Specs.API.Project.Detail_Content_PUT ( + detail_content_PUT, +) where + +import Data.Aeson (encode) +import qualified Data.ByteString.Char8 as BS +import Data.Foldable (traverse_) +import qualified Data.UUID as U +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Shared.Common.Util.Uuid +import Wizard.Api.Resource.Project.ProjectContentChangeDTO +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectEventDAO +import Wizard.Database.DAO.Project.ProjectVersionDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Project +import WizardLib.Public.Localization.Messages.Public + +import SharedTest.Specs.API.Common +import Wizard.Service.Project.Event.ProjectEventMapper +import Wizard.Specs.API.Common +import Wizard.Specs.API.Project.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- PUT /wizard-api/projects/{projectUuid}/content +-- ------------------------------------------------------------------------ +detail_content_PUT :: AppContext -> SpecWith ((), Application) +detail_content_PUT appContext = + describe "PUT /wizard-api/projects/{projectUuid}/content" $ do + test_200 appContext + test_400 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodPut + +reqUrlT projectUuid = BS.pack $ "/wizard-api/projects/" ++ U.toString projectUuid ++ "/content" + +reqHeadersT authHeader = reqCtHeader : authHeader + +reqDto projectUuid = + ProjectContentChangeDTO + { events = [toEventChangeDTO (slble_rQ2' projectUuid)] + } + +reqBody projectUuid = encode (reqDto projectUuid) + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = do + create_test_200 "HTTP 200 OK (Owner, Private)" appContext project1 project1EventsEdited [reqAuthHeader] + create_test_200 "HTTP 200 OK (Owner, VisibleView)" appContext project2 project2EventsEdited [reqAuthHeader] + create_test_200 "HTTP 200 OK (Non-Owner, Public)" appContext project3 project3EventsEdited [reqAuthHeader] + create_test_200 "HTTP 200 OK (Anonymous, Public, Sharing" appContext project10 project10EventsEdited [] + +create_test_200 title appContext project projectEventsEdited authHeader = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT $ project.uuid + let reqHeaders = reqHeadersT authHeader + -- AND: Prepare expectation + let expStatus = 200 + let expHeaders = resCtHeaderPlain : resCorsHeadersPlain + let expDto = reqDto project.uuid + let expBody = encode expDto + -- AND: Run migrations + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + runInContextIO (insertProject project7) appContext + runInContextIO (insertProjectEvents project7Events) appContext + runInContextIO (traverse_ insertProjectVersion project7Versions) appContext + runInContextIO (insertProject project10) appContext + runInContextIO (insertProjectEvents project10Events) appContext + runInContextIO (traverse_ insertProjectVersion project10Versions) appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders (reqBody project.uuid) + -- THEN: Compare response with expectation + let (status, headers, resBody) = destructResponse response :: (Int, ResponseHeaders, ProjectContentChangeDTO) + assertResStatus status expStatus + assertResHeaders headers expHeaders + compareProjectDtos resBody expDto + -- AND: Find a result in DB + assertExistenceOfProjectContentInDB appContext project.uuid projectEventsEdited + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_400 appContext = createInvalidJsonTest reqMethod (reqUrlT project3.uuid) "visibility" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = do + create_test_403 + "HTTP 403 FORBIDDEN (Non-Owner, Private)" + appContext + project1 + project1EventsEdited + [reqNonAdminAuthHeader] + (_ERROR_VALIDATION__FORBIDDEN "Edit Project") + create_test_403 + "HTTP 403 FORBIDDEN (Non-Owner, VisibleView)" + appContext + project2 + project2EventsEdited + [reqNonAdminAuthHeader] + (_ERROR_VALIDATION__FORBIDDEN "Edit Project") + create_test_403 + "HTTP 403 FORBIDDEN (Anonymous, VisibleView, Sharing)" + appContext + project7 + project7EventsEdited + [] + _ERROR_SERVICE_USER__MISSING_USER + create_test_403 + "HTTP 403 FORBIDDEN (Anonymous, Public)" + appContext + project3 + project3EventsEdited + [] + _ERROR_SERVICE_USER__MISSING_USER + +create_test_403 title appContext project projectEventsEdited authHeader reason = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT $ project.uuid + let reqHeaders = reqHeadersT authHeader + -- AND: Prepare expectation + let expStatus = 403 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = ForbiddenError reason + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + runInContextIO (insertProject project7) appContext + runInContextIO (insertProject project10) appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders (reqBody project.uuid) + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + "/wizard-api/projects/f08ead5f-746d-411b-aee6-77ea3d24016a/content" + (reqHeadersT [reqAuthHeader]) + (reqBody $ u' "f08ead5f-746d-411b-aee6-77ea3d24016a") + "project" + [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Project/Detail_DELETE.hs b/wizard-server/test/Wizard/Specs/API/Project/Detail_DELETE.hs new file mode 100644 index 000000000..71e6e36c6 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Detail_DELETE.hs @@ -0,0 +1,168 @@ +module Wizard.Specs.API.Project.Detail_DELETE ( + detail_DELETE, +) where + +import Data.Aeson (encode) +import qualified Data.ByteString.Char8 as BS +import qualified Data.UUID as U +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Wizard.Database.DAO.Document.DocumentDAO +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectMigrationDAO +import qualified Wizard.Database.Migration.Development.Document.DocumentMigration as DOC +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.ProjectMigrations +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Localization.Messages.Public +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Project + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- DELETE /wizard-api/projects/{projectUuid} +-- ------------------------------------------------------------------------ +detail_DELETE :: AppContext -> SpecWith ((), Application) +detail_DELETE appContext = + describe "DELETE /wizard-api/projects/{projectUuid}" $ do + test_204 appContext + test_400 appContext + test_401 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodDelete + +reqUrlT projectUuid = BS.pack $ "/wizard-api/projects/" ++ U.toString projectUuid + +reqHeadersT authHeader = [authHeader] + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_204 appContext = do + create_test_204 "HTTP 204 NO CONTENT (Owner, Private)" appContext project1 reqAuthHeader 2 + create_test_204 "HTTP 204 NO CONTENT (Owner, VisibleView)" appContext project2 reqAuthHeader 1 + +create_test_204 title appContext project authHeader docCount = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT project.uuid + let reqHeaders = reqHeadersT authHeader + -- AND: Prepare expectation + let expStatus = 204 + let expHeaders = resCorsHeaders + let expBody = "" + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + runInContextIO DOC.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + -- AND: Find result in DB and compare with expectation state + assertCountInDB findProjects appContext 2 + assertCountInDB findDocuments appContext docCount + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_400 appContext = + it "HTTP 400 BAD REQUEST when package can't be deleted" $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT project4.uuid + let reqHeaders = reqHeadersT reqAuthHeader + -- AND: Prepare expectation + let expStatus = 400 + let expHeaders = resCorsHeaders + let expDto = UserError _ERROR_SERVICE_PROJECT__PROJECT_CANT_BE_DELETED_BECAUSE_IT_IS_USED_IN_MIGRATION + let expBody = encode expDto + -- AND: Prepare DB + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + runInContextIO (insertProject project4) appContext + runInContextIO (insertProject project4Upgraded) appContext + runInContextIO (insertProjectMigration projectMigration) appContext + runInContextIO DOC.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + -- AND: Find result in DB and compare with expectation state + assertCountInDB findProjects appContext 5 + assertCountInDB findDocuments appContext 3 + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod (reqUrlT project3.uuid) [] reqBody + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = do + create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, Private)" appContext project1 + create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, VisibleView)" appContext project1 + create_test_403 "HTTP 403 NO CONTENT (Non-Owner, VisibleEdit)" appContext project3 + +create_test_403 title appContext project = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT project1.uuid + let reqHeaders = reqHeadersT reqNonAdminAuthHeader + -- AND: Prepare expectation + let expStatus = 403 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN "Administrate Project" + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + -- AND: Find result in DB and compare with expectation state + assertCountInDB findProjects appContext 3 + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + "/wizard-api/projects/f08ead5f-746d-411b-aee6-77ea3d24016a" + (reqHeadersT reqAuthHeader) + reqBody + "project" + [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Project/Detail_Documents_GET.hs b/wizard-server/test/Wizard/Specs/API/Project/Detail_Documents_GET.hs new file mode 100644 index 000000000..c054ae06c --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Detail_Documents_GET.hs @@ -0,0 +1,170 @@ +module Wizard.Specs.API.Project.Detail_Documents_GET ( + detail_documents_GET, +) where + +import Data.Aeson (encode) +import qualified Data.ByteString.Char8 as BS +import Data.Foldable (traverse_) +import qualified Data.UUID as U +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Common.Lens +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.PageMetadata +import Shared.Common.Model.Error.Error +import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplateFormats +import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplates +import Wizard.Api.Resource.Document.DocumentJM () +import Wizard.Database.DAO.Document.DocumentDAO +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectEventDAO +import Wizard.Database.DAO.Project.ProjectVersionDAO +import Wizard.Database.Migration.Development.Document.Data.Documents +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ_Migration +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ +import Wizard.Database.Migration.Development.User.Data.Users +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import qualified Wizard.Database.Migration.Development.User.UserMigration as U_Migration +import Wizard.Model.Context.AppContext +import Wizard.Model.Document.Document +import Wizard.Model.Project.Project +import Wizard.Model.User.User +import Wizard.S3.Document.DocumentS3 +import Wizard.Service.Document.DocumentMapper +import WizardLib.Public.Localization.Messages.Public + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- GET /wizard-api/projects/{projectUuid}/documents +-- ------------------------------------------------------------------------ +detail_documents_GET :: AppContext -> SpecWith ((), Application) +detail_documents_GET appContext = + describe "GET /wizard-api/projects/{projectUuid}/documents" $ do + test_200 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodGet + +reqUrlT projectUuid = BS.pack $ "/wizard-api/projects/" ++ U.toString projectUuid ++ "/documents?sort=name,asc" + +reqHeadersT authHeader = authHeader + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = do + create_test_200 "HTTP 200 CREATED (Owner)" appContext [reqAuthHeader] + create_test_200 "HTTP 200 CREATED (Non-Owner)" appContext [reqNonAdminAuthHeader] + create_test_200 "HTTP 200 CREATED (Anonymous)" appContext [] + +create_test_200 title appContext authHeader = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT project6.uuid + let reqHeaders = reqHeadersT authHeader + -- AND: Run migrations + let doc1' = doc1 {projectUuid = Just project6.uuid, projectEventUuid = Just . getUuid $ slble_rQ1' project6.uuid} + let doc2' = doc2 {projectUuid = Just project6.uuid, projectEventUuid = Just . getUuid $ slble_rQ1' project6.uuid, createdBy = Just userIsaac.uuid} + runInContextIO U_Migration.runMigration appContext + runInContextIO TML_Migration.runMigration appContext + runInContextIO PRJ_Migration.runMigration appContext + runInContextIO (insertProject project6) appContext + runInContextIO (insertProjectEvents project6Events) appContext + runInContextIO (traverse_ insertProjectVersion project6Versions) appContext + runInContextIO deleteDocuments appContext + runInContextIO removeDocumentContents appContext + runInContextIO (insertDocument doc1') appContext + runInContextIO (insertDocument doc2') appContext + -- AND: Prepare expectation + let expStatus = 200 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = + Page + "documents" + (PageMetadata 20 2 1 0) + [ toDTOWithDocTemplate doc1' project6 (Just "Version 1") [] + , toDTOWithDocTemplate doc2' project6 (Just "Version 1") [] + ] + let expBody = encode (fmap (\x -> x wizardDocumentTemplate formatJsonSimple) expDto) + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = do + create_test_403 + "HTTP 403 FORBIDDEN (Non-Owner, Private)" + appContext + project1 + [reqNonAdminAuthHeader] + (_ERROR_VALIDATION__FORBIDDEN "View Project") + create_test_403 + "HTTP 403 FORBIDDEN (Anonymous, VisibleView)" + appContext + project2 + [] + _ERROR_SERVICE_USER__MISSING_USER + create_test_403 + "HTTP 403 FORBIDDEN (Anonymous, VisibleEdit)" + appContext + project3 + [] + _ERROR_SERVICE_USER__MISSING_USER + +create_test_403 title appContext project authHeader errorMessage = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT project.uuid + let reqHeaders = reqHeadersT authHeader + -- AND: Prepare expectation + let expStatus = 403 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = ForbiddenError errorMessage + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML_Migration.runMigration appContext + runInContextIO PRJ.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + "/wizard-api/projects/f08ead5f-746d-411b-aee6-77ea3d24016a/documents" + (reqHeadersT [reqAuthHeader]) + reqBody + "project" + [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Project/Detail_GET.hs b/wizard-server/test/Wizard/Specs/API/Project/Detail_GET.hs new file mode 100644 index 000000000..fb092fe78 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Detail_GET.hs @@ -0,0 +1,209 @@ +module Wizard.Specs.API.Project.Detail_GET ( + detail_GET, +) where + +import Data.Aeson (encode) +import qualified Data.ByteString.Char8 as BS +import Data.Foldable (traverse_) +import qualified Data.UUID as U +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Api.Resource.Project.Detail.ProjectDetailDTO +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectEventDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Project +import WizardLib.Public.Localization.Messages.Public + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- GET /wizard-api/projects/{projectUuid} +-- ------------------------------------------------------------------------ +detail_GET :: AppContext -> SpecWith ((), Application) +detail_GET appContext = + describe "GET /wizard-api/projects/{projectUuid}" $ do + test_200 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodGet + +reqUrlT projectUuid = BS.pack $ "/wizard-api/projects/" ++ U.toString projectUuid + +reqHeadersT authHeader = authHeader + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = do + create_test_200 + "HTTP 200 OK (Owner, Private)" + appContext + project1 + project1Events + [reqAuthHeader] + [project1AlbertEditProjectPermDto] + create_test_200 + "HTTP 200 OK (Non-Owner, VisibleView)" + appContext + project2 + project2Events + [reqNonAdminAuthHeader] + [project2AlbertEditProjectPermDto] + create_test_200 + "HTTP 200 OK (Commenter)" + appContext + (project13 {visibility = PrivateProjectVisibility}) + project13Events + [reqNonAdminAuthHeader] + [project13NikolaCommentProjectPermDto] + create_test_200 + "HTTP 200 OK (Non-Commenter, VisibleComment)" + appContext + project13 + project13Events + [reqIsaacAuthTokenHeader] + [project13NikolaCommentProjectPermDto] + create_test_200 + "HTTP 200 OK (Anonymous, VisibleComment, AnyoneWithLinkComment)" + appContext + (project13 {sharing = AnyoneWithLinkCommentProjectSharing}) + project13Events + [] + [project13NikolaCommentProjectPermDto] + create_test_200 + "HTTP 200 OK (Anonymous, VisibleView, Sharing)" + appContext + project7 + project7Events + [] + [project7AlbertEditProjectPermDto] + create_test_200 + "HTTP 200 OK (Non-Owner, VisibleEdit)" + appContext + project3 + project3Events + [reqNonAdminAuthHeader] + [] + create_test_200 + "HTTP 200 OK (Anonymous, Public, Sharing)" + appContext + project10 + project10Events + [] + [] + +create_test_200 title appContext project projectEvents authHeader permissions = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT project.uuid + let reqHeaders = reqHeadersT authHeader + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO (insertPackage germanyKmPackage) appContext + runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext + runInContextIO (insertProject project) appContext + runInContextIO (insertProjectEvents projectEvents) appContext + -- AND: Prepare expectation + let expStatus = 200 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = + ProjectDetailDTO + { uuid = project.uuid + , name = project.name + , sharing = project.sharing + , visibility = project.visibility + , knowledgeModelPackageId = project.knowledgeModelPackageId + , isTemplate = project.isTemplate + , migrationUuid = Nothing + , permissions = permissions + , fileCount = 0 + } + let expBody = encode expDto + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = do + create_test_403 + "HTTP 403 FORBIDDEN (Non-Owner, Private)" + appContext + project1 + [reqNonAdminAuthHeader] + (_ERROR_VALIDATION__FORBIDDEN "View Project") + create_test_403 + "HTTP 403 FORBIDDEN (Anonymous, VisibleView)" + appContext + project2 + [] + _ERROR_SERVICE_USER__MISSING_USER + create_test_403 + "HTTP 403 FORBIDDEN (Anonymous, Public)" + appContext + project3 + [] + _ERROR_SERVICE_USER__MISSING_USER + +create_test_403 title appContext project authHeader errorMessage = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT project.uuid + let reqHeaders = reqHeadersT authHeader + -- AND: Prepare expectation + let expStatus = 403 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = ForbiddenError errorMessage + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + "/wizard-api/projects/f08ead5f-746d-411b-aee6-77ea3d24016a" + [reqHeadersT reqAuthHeader] + reqBody + "project" + [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Project/Detail_Preview_GET.hs b/wizard-server/test/Wizard/Specs/API/Project/Detail_Preview_GET.hs new file mode 100644 index 000000000..606cb5010 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Detail_Preview_GET.hs @@ -0,0 +1,202 @@ +module Wizard.Specs.API.Project.Detail_Preview_GET ( + detail_preview_GET, +) where + +import Data.Aeson (encode) +import qualified Data.ByteString.Char8 as BS +import Data.Foldable (traverse_) +import qualified Data.UUID as U +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplateFormats +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Database.DAO.Project.ProjectDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Detail.ProjectDetailPreview +import Wizard.Model.Project.Project +import WizardLib.Public.Localization.Messages.Public + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- GET /wizard-api/projects/{projectUuid}/preview +-- ------------------------------------------------------------------------ +detail_preview_GET :: AppContext -> SpecWith ((), Application) +detail_preview_GET appContext = + describe "GET /wizard-api/projects/{projectUuid}/preview" $ do + test_200 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodGet + +reqUrlT projectUuid = BS.pack $ "/wizard-api/projects/" ++ U.toString projectUuid ++ "/preview" + +reqHeadersT authHeader = authHeader + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = do + create_test_200 + "HTTP 200 OK (Owner, Private)" + appContext + project1 + [reqAuthHeader] + [project1AlbertEditProjectPermDto] + create_test_200 + "HTTP 200 OK (Non-Owner, VisibleView)" + appContext + project2 + [reqNonAdminAuthHeader] + [project2AlbertEditProjectPermDto] + create_test_200 + "HTTP 200 OK (Commenter)" + appContext + (project13 {visibility = PrivateProjectVisibility}) + [reqNonAdminAuthHeader] + [project13NikolaCommentProjectPermDto] + create_test_200 + "HTTP 200 OK (Non-Commenter, VisibleComment)" + appContext + project13 + [reqIsaacAuthTokenHeader] + [project13NikolaCommentProjectPermDto] + create_test_200 + "HTTP 200 OK (Anonymous, VisibleComment, AnyoneWithLinkComment)" + appContext + (project13 {sharing = AnyoneWithLinkCommentProjectSharing}) + [] + [project13NikolaCommentProjectPermDto] + create_test_200 + "HTTP 200 OK (Anonymous, VisibleView, Sharing)" + appContext + project7 + [] + [project7AlbertEditProjectPermDto] + create_test_200 + "HTTP 200 OK (Non-Owner, VisibleEdit)" + appContext + project3 + [reqNonAdminAuthHeader] + [] + create_test_200 + "HTTP 200 OK (Anonymous, Public, Sharing)" + appContext + project10 + [] + [] + +create_test_200 title appContext project authHeader permissions = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT project.uuid + let reqHeaders = reqHeadersT authHeader + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO (insertPackage germanyKmPackage) appContext + runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext + runInContextIO (insertProject project) appContext + -- AND: Prepare expectation + let expStatus = 200 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = + ProjectDetailPreview + { uuid = project.uuid + , name = project.name + , visibility = project.visibility + , sharing = project.sharing + , knowledgeModelPackageId = project.knowledgeModelPackageId + , isTemplate = project.isTemplate + , migrationUuid = Nothing + , permissions = permissions + , documentTemplateId = project.documentTemplateId + , format = Just formatJsonSimple + , fileCount = 0 + } + let expBody = encode expDto + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = do + create_test_403 + "HTTP 403 FORBIDDEN (Non-Owner, Private)" + appContext + project1 + [reqNonAdminAuthHeader] + (_ERROR_VALIDATION__FORBIDDEN "View Project") + create_test_403 + "HTTP 403 FORBIDDEN (Anonymous, VisibleView)" + appContext + project2 + [] + _ERROR_SERVICE_USER__MISSING_USER + create_test_403 + "HTTP 403 FORBIDDEN (Anonymous, Public)" + appContext + project3 + [] + _ERROR_SERVICE_USER__MISSING_USER + +create_test_403 title appContext project authHeader errorMessage = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT project.uuid + let reqHeaders = reqHeadersT authHeader + -- AND: Prepare expectation + let expStatus = 403 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = ForbiddenError errorMessage + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + "/wizard-api/projects/f08ead5f-746d-411b-aee6-77ea3d24016a/preview" + [reqHeadersT reqAuthHeader] + reqBody + "project" + [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Project/Detail_Questionnaire_GET.hs b/wizard-server/test/Wizard/Specs/API/Project/Detail_Questionnaire_GET.hs new file mode 100644 index 000000000..14700efc9 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Detail_Questionnaire_GET.hs @@ -0,0 +1,245 @@ +module Wizard.Specs.API.Project.Detail_Questionnaire_GET ( + detail_questionnaire_GET, +) where + +import Data.Aeson (encode) +import qualified Data.ByteString.Char8 as BS +import Data.Foldable (traverse_) +import qualified Data.Map.Strict as M +import qualified Data.UUID as U +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.KnowledgeModels +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Api.Resource.Project.Detail.ProjectDetailQuestionnaireDTO +import Wizard.Database.DAO.Project.ProjectCommentDAO +import Wizard.Database.DAO.Project.ProjectCommentThreadDAO +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectEventDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.ProjectComments +import Wizard.Database.Migration.Development.Project.Data.ProjectReplies +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Comment.ProjectComment +import Wizard.Model.Project.Project +import Wizard.Model.Project.ProjectContent +import WizardLib.Public.Localization.Messages.Public + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- GET /wizard-api/projects/{projectUuid}/questionnaire +-- ------------------------------------------------------------------------ +detail_questionnaire_GET :: AppContext -> SpecWith ((), Application) +detail_questionnaire_GET appContext = + describe "GET /wizard-api/projects/{projectUuid}/questionnaire" $ do + test_200 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodGet + +reqUrlT projectUuid = BS.pack $ "/wizard-api/projects/" ++ U.toString projectUuid ++ "/questionnaire" + +reqHeadersT authHeader = authHeader + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = do + create_test_200 + "HTTP 200 OK (Owner, Private)" + appContext + project1 + project1Events + project1Ctn + True + [reqAuthHeader] + [project1AlbertEditProjectPermDto] + create_test_200 + "HTTP 200 OK (Non-Owner, VisibleView)" + appContext + project2 + project2Events + (project2Ctn {labels = M.empty} :: ProjectContent) + False + [reqNonAdminAuthHeader] + [project2AlbertEditProjectPermDto] + create_test_200 + "HTTP 200 OK (Commenter)" + appContext + (project13 {visibility = PrivateProjectVisibility}) + project13Events + (project13Ctn {labels = M.empty} :: ProjectContent) + True + [reqNonAdminAuthHeader] + [project13NikolaCommentProjectPermDto] + create_test_200 + "HTTP 200 OK (Non-Commenter, VisibleComment)" + appContext + project13 + project13Events + (project13Ctn {labels = M.empty} :: ProjectContent) + True + [reqIsaacAuthTokenHeader] + [project13NikolaCommentProjectPermDto] + create_test_200 + "HTTP 200 OK (Anonymous, VisibleComment, AnyoneWithLinkComment)" + appContext + (project13 {sharing = AnyoneWithLinkCommentProjectSharing}) + project13Events + (project13Ctn {labels = M.empty} :: ProjectContent) + True + [] + [project13NikolaCommentProjectPermDto] + create_test_200 + "HTTP 200 OK (Anonymous, VisibleView, Sharing)" + appContext + project7 + project7Events + (project7Ctn {labels = M.empty} :: ProjectContent) + False + [] + [project7AlbertEditProjectPermDto] + create_test_200 + "HTTP 200 OK (Non-Owner, VisibleEdit)" + appContext + project3 + project3Events + project3Ctn + True + [reqNonAdminAuthHeader] + [] + create_test_200 "HTTP 200 OK (Anonymous, Public, Sharing)" appContext project10 project10Events project10Ctn True [] [] + +create_test_200 title appContext project projectEvents projectContent showComments authHeader permissions = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT project.uuid + let reqHeaders = reqHeadersT authHeader + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO (insertPackage germanyKmPackage) appContext + runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext + thread1 <- liftIO . create_cmtQ1_t1 $ project.uuid + comment1 <- liftIO . create_cmtQ1_t1_1 $ thread1.uuid + comment2 <- liftIO . create_cmtQ1_t1_2 $ thread1.uuid + runInContextIO (insertProject project) appContext + runInContextIO (insertProjectEvents projectEvents) appContext + runInContextIO (insertProjectCommentThread thread1) appContext + runInContextIO (insertProjectComment comment1) appContext + runInContextIO (insertProjectComment comment2) appContext + let unresolvedCommentCounts = + if showComments + then M.fromList [(cmtQ1_path, M.fromList [(thread1.uuid, 2)])] + else M.empty + -- AND: Prepare expectation + let expStatus = 200 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = + ProjectDetailQuestionnaireDTO + { uuid = project.uuid + , name = project.name + , visibility = project.visibility + , sharing = project.sharing + , knowledgeModelPackageId = project.knowledgeModelPackageId + , selectedQuestionTagUuids = project.selectedQuestionTagUuids + , isTemplate = project.isTemplate + , knowledgeModel = km1WithQ4 + , replies = fReplies + , labels = projectContent.labels + , phaseUuid = projectContent.phaseUuid + , migrationUuid = Nothing + , permissions = permissions + , files = [] + , unresolvedCommentCounts = unresolvedCommentCounts + , resolvedCommentCounts = M.empty + , projectActionsAvailable = 0 + , projectImportersAvailable = 0 + , fileCount = 0 + } + let expBody = encode expDto + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = do + create_test_403 + "HTTP 403 FORBIDDEN (Non-Owner, Private)" + appContext + project1 + [reqNonAdminAuthHeader] + (_ERROR_VALIDATION__FORBIDDEN "View Project") + create_test_403 + "HTTP 403 FORBIDDEN (Anonymous, VisibleView)" + appContext + project2 + [] + _ERROR_SERVICE_USER__MISSING_USER + create_test_403 + "HTTP 403 FORBIDDEN (Anonymous, Public)" + appContext + project3 + [] + _ERROR_SERVICE_USER__MISSING_USER + +create_test_403 title appContext project authHeader errorMessage = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT project.uuid + let reqHeaders = reqHeadersT authHeader + -- AND: Prepare expectation + let expStatus = 403 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = ForbiddenError errorMessage + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + "/wizard-api/projects/f08ead5f-746d-411b-aee6-77ea3d24016a/questionnaire" + [reqHeadersT reqAuthHeader] + reqBody + "project" + [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Project/Detail_Report_GET.hs b/wizard-server/test/Wizard/Specs/API/Project/Detail_Report_GET.hs new file mode 100644 index 000000000..ad6af0eb1 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Detail_Report_GET.hs @@ -0,0 +1,156 @@ +module Wizard.Specs.API.Project.Detail_Report_GET ( + detail_report_GET, +) where + +import Data.Aeson (encode) +import qualified Data.ByteString.Char8 as BS +import Data.Foldable (traverse_) +import qualified Data.UUID as U +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Api.Resource.Project.Detail.ProjectDetailReportDTO +import Wizard.Api.Resource.Project.Detail.ProjectDetailReportJM () +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectEventDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ +import Wizard.Database.Migration.Development.Report.Data.Reports +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Project +import Wizard.Model.Report.Report +import WizardLib.Public.Localization.Messages.Public + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.API.Project.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- GET /wizard-api/projects/{projectUuid}/report +-- ------------------------------------------------------------------------ +detail_report_GET :: AppContext -> SpecWith ((), Application) +detail_report_GET appContext = + describe "GET /wizard-api/projects/{projectUuid}/report" $ do + test_200 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodGet + +reqUrlT projectUuid = BS.pack $ "/wizard-api/projects/" ++ U.toString projectUuid ++ "/report" + +reqHeadersT authHeader = reqCtHeader : authHeader + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = do + create_test_200 "HTTP 200 OK (Owner, Private)" appContext project1 [reqAuthHeader] + create_test_200 "HTTP 200 OK (Non-Owner, VisibleView)" appContext project2 [reqNonAdminAuthHeader] + create_test_200 "HTTP 200 OK (Non-Owner, VisibleView, Sharing)" appContext project7 [] + create_test_200 "HTTP 200 OK (Non-Owner, VisibleEdit)" appContext project3 [reqNonAdminAuthHeader] + create_test_200 "HTTP 200 OK (Non-Owner, VisibleEdit, Sharing)" appContext project10 [] + +create_test_200 title appContext project authHeader = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT $ project.uuid + let reqHeaders = reqHeadersT authHeader + -- GIVEN: Prepare expectation + let expStatus = 200 + let expHeaders = resCtHeaderPlain : resCorsHeadersPlain + let expDto = report1 + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + runInContextIO (insertPackage germanyKmPackage) appContext + runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext + runInContextIO (insertProject project7) appContext + runInContextIO (insertProjectEvents project7Events) appContext + runInContextIO (insertProject project10) appContext + runInContextIO (insertProjectEvents project10Events) appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + result <- destructResponse' response + let (status, headers, resBody) = result :: (Int, ResponseHeaders, ProjectDetailReportDTO) + assertResStatus status expStatus + assertResHeaders headers expHeaders + compareReportDtos resBody expDto + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = do + create_test_403 + "HTTP 403 FORBIDDEN (Non-Owner, Private)" + appContext + project1 + [reqNonAdminAuthHeader] + (_ERROR_VALIDATION__FORBIDDEN "View Project") + create_test_403 + "HTTP 403 FORBIDDEN (Anonymous, VisibleView)" + appContext + project2 + [] + _ERROR_SERVICE_USER__MISSING_USER + create_test_403 + "HTTP 403 FORBIDDEN (Anonymous, VisibleEdit)" + appContext + project3 + [] + _ERROR_SERVICE_USER__MISSING_USER + +create_test_403 title appContext project authHeader errorMessage = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT project.uuid + let reqHeaders = reqHeadersT authHeader + -- AND: Prepare expectation + let expStatus = 403 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = ForbiddenError errorMessage + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + "/wizard-api/projects/f08ead5f-746d-411b-aee6-77ea3d24016a/report" + (reqHeadersT [reqAuthHeader]) + reqBody + "project" + [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Project/Detail_Revert_POST.hs b/wizard-server/test/Wizard/Specs/API/Project/Detail_Revert_POST.hs new file mode 100644 index 000000000..dc2984d86 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Detail_Revert_POST.hs @@ -0,0 +1,82 @@ +module Wizard.Specs.API.Project.Detail_Revert_POST ( + detail_revert_POST, +) where + +import Data.Aeson (encode) +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Api.Resource.Error.ErrorJM () +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.Project.Data.ProjectVersions +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Version.ProjectVersion + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.API.Project.Common +import Wizard.Specs.API.Project.Version.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- POST /wizard-api/projects/{projectUuid}/revert +-- ------------------------------------------------------------------------ +detail_revert_POST :: AppContext -> SpecWith ((), Application) +detail_revert_POST appContext = + describe "POST /wizard-api/projects/{projectUuid}/revert" $ do + test_200 appContext + test_400 appContext + test_401 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodPost + +reqUrl = "/wizard-api/projects/af984a75-56e3-49f8-b16f-d6b99599910a/revert" + +reqHeaders = [reqAuthHeader, reqCtHeader] + +reqDto = projectVersion1RevertDto project1Uuid + +reqBody = encode reqDto + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = + it "HTTP 200 OK" $ + -- GIVEN: Prepare expectation + do + let expStatus = 200 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = project1CtnRevertedDto + let expBody = encode expDto + -- AND: Run migrations + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + -- AND: Find a result in DB + assertExistenceOfProjectInDB appContext project1 [sre_rQ1' project1Uuid, sre_rQ2' project1Uuid] + assertAbsenceOfProjectVersionInDB appContext (projectVersion1 project1Uuid) + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_400 appContext = createInvalidJsonTest reqMethod reqUrl "name" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod reqUrl [reqCtHeader] reqBody diff --git a/wizard-server/test/Wizard/Specs/API/Project/Detail_Revert_Preview_POST.hs b/wizard-server/test/Wizard/Specs/API/Project/Detail_Revert_Preview_POST.hs new file mode 100644 index 000000000..bc5b6a66a --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Detail_Revert_Preview_POST.hs @@ -0,0 +1,88 @@ +module Wizard.Specs.API.Project.Detail_Revert_Preview_POST ( + detail_revert_preview_POST, +) where + +import Data.Aeson (encode) +import qualified Data.Map.Strict as M +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Wizard.Api.Resource.Project.ProjectContentDTO +import Wizard.Database.DAO.Project.ProjectDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.ProjectVersions +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Project + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.API.Project.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- POST /wizard-api/projects/{projectUuid}/revert/preview +-- ------------------------------------------------------------------------ +detail_revert_preview_POST :: AppContext -> SpecWith ((), Application) +detail_revert_preview_POST appContext = + describe "POST /wizard-api/projects/{projectUuid}/revert/preview" $ do + test_200 appContext + test_400 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodPost + +reqUrl = "/wizard-api/projects/af984a75-56e3-49f8-b16f-d6b99599910a/revert/preview" + +reqHeadersT authHeader = authHeader ++ [reqCtHeader] + +reqDto = projectVersion1RevertDto project1Uuid + +reqBody = encode reqDto + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = do + create_test_200 "HTTP 200 OK (logged user)" appContext True [reqAuthHeader] + create_test_200 "HTTP 200 OK (anonymous)" appContext False [] + +create_test_200 title appContext showComments authHeader = + it title $ + -- GIVEN: Prepare request + do + let reqHeaders = reqHeadersT authHeader + -- AND: Prepare expectation + let expStatus = 200 + let expHeaders = resCtHeader : resCorsHeaders + let expProject = project1 {sharing = AnyoneWithLinkViewProjectSharing} + let expProjectEvents = project1Events + let expDto = + if showComments + then project1CtnRevertedDto + else project1CtnRevertedDto {commentThreadsMap = M.empty} + let expBody = encode expDto + -- AND: Run migrations + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + runInContextIO (updateProjectByUuid expProject) appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + -- AND: Find a result in DB + assertExistenceOfProjectInDB appContext expProject expProjectEvents + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_400 appContext = createInvalidJsonTest reqMethod reqUrl "name" diff --git a/wizard-server/test/Wizard/Specs/API/Project/Detail_Settings_GET.hs b/wizard-server/test/Wizard/Specs/API/Project/Detail_Settings_GET.hs new file mode 100644 index 000000000..31730b2c7 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Detail_Settings_GET.hs @@ -0,0 +1,217 @@ +module Wizard.Specs.API.Project.Detail_Settings_GET ( + detail_settings_GET, +) where + +import Data.Aeson (encode) +import qualified Data.ByteString.Char8 as BS +import Data.Foldable (traverse_) +import qualified Data.Map.Strict as M +import qualified Data.UUID as U +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplateFormats +import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplates +import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplate +import qualified Shared.DocumentTemplate.Service.DocumentTemplate.DocumentTemplateMapper as STM +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.KnowledgeModels +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel hiding (request) +import Wizard.Database.DAO.Project.ProjectDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Detail.ProjectDetailSettings +import Wizard.Model.Project.Project +import qualified Wizard.Service.KnowledgeModel.Package.KnowledgeModelPackageMapper as PM +import Wizard.Service.Project.ProjectMapper +import WizardLib.Public.Localization.Messages.Public + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- GET /wizard-api/projects/{projectUuid}/settings +-- ------------------------------------------------------------------------ +detail_settings_GET :: AppContext -> SpecWith ((), Application) +detail_settings_GET appContext = + describe "GET /wizard-api/projects/{projectUuid}/settings" $ do + test_200 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodGet + +reqUrlT projectUuid = BS.pack $ "/wizard-api/projects/" ++ U.toString projectUuid ++ "/settings" + +reqHeadersT authHeader = authHeader + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = do + create_test_200 + "HTTP 200 OK (Owner, Private)" + appContext + project1 + [reqAuthHeader] + [project1AlbertEditProjectPermDto] + create_test_200 + "HTTP 200 OK (Non-Owner, VisibleView)" + appContext + project2 + [reqNonAdminAuthHeader] + [project2AlbertEditProjectPermDto] + create_test_200 + "HTTP 200 OK (Commenter)" + appContext + (project13 {visibility = PrivateProjectVisibility}) + [reqNonAdminAuthHeader] + [project13NikolaCommentProjectPermDto] + create_test_200 + "HTTP 200 OK (Non-Commenter, VisibleComment)" + appContext + project13 + [reqIsaacAuthTokenHeader] + [project13NikolaCommentProjectPermDto] + create_test_200 + "HTTP 200 OK (Anonymous, VisibleComment, AnyoneWithLinkComment)" + appContext + (project13 {sharing = AnyoneWithLinkCommentProjectSharing}) + [] + [project13NikolaCommentProjectPermDto] + create_test_200 + "HTTP 200 OK (Anonymous, VisibleView, Sharing)" + appContext + project7 + [] + [project7AlbertEditProjectPermDto] + create_test_200 + "HTTP 200 OK (Non-Owner, VisibleEdit)" + appContext + project3 + [reqNonAdminAuthHeader] + [] + create_test_200 + "HTTP 200 OK (Anonymous, Public, Sharing)" + appContext + project10 + [] + [] + +create_test_200 title appContext project authHeader permissions = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT project.uuid + let reqHeaders = reqHeadersT authHeader + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO (insertPackage germanyKmPackage) appContext + runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext + runInContextIO (insertProject project) appContext + -- AND: Prepare expectation + let expStatus = 200 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = + ProjectDetailSettings + { uuid = project.uuid + , name = project.name + , description = project.description + , visibility = project.visibility + , sharing = project.sharing + , isTemplate = project.isTemplate + , migrationUuid = Nothing + , permissions = permissions + , projectTags = project.projectTags + , knowledgeModelPackageId = project.knowledgeModelPackageId + , knowledgeModelPackage = PM.toSimpleDTO' [] [] germanyKmPackage + , knowledgeModelTags = M.elems km1WithQ4.entities.tags + , documentTemplate = Just $ STM.toDTO wizardDocumentTemplate wizardDocumentTemplateFormats + , documentTemplateState = toProjectDetailTemplateState (Just wizardDocumentTemplate) + , documentTemplatePhase = Just wizardDocumentTemplate.phase + , formatUuid = Just formatJson.uuid + , selectedQuestionTagUuids = project.selectedQuestionTagUuids + , fileCount = 0 + } + let expBody = encode expDto + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = do + create_test_403 + "HTTP 403 FORBIDDEN (Non-Owner, Private)" + appContext + project1 + [reqNonAdminAuthHeader] + (_ERROR_VALIDATION__FORBIDDEN "View Project") + create_test_403 + "HTTP 403 FORBIDDEN (Anonymous, VisibleView)" + appContext + project2 + [] + _ERROR_SERVICE_USER__MISSING_USER + create_test_403 + "HTTP 403 FORBIDDEN (Anonymous, Public)" + appContext + project3 + [] + _ERROR_SERVICE_USER__MISSING_USER + +create_test_403 title appContext project authHeader errorMessage = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT project.uuid + let reqHeaders = reqHeadersT authHeader + -- AND: Prepare expectation + let expStatus = 403 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = ForbiddenError errorMessage + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + "/wizard-api/projects/f08ead5f-746d-411b-aee6-77ea3d24016a/settings" + [reqHeadersT reqAuthHeader] + reqBody + "project" + [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Project/Detail_Settings_PUT.hs b/wizard-server/test/Wizard/Specs/API/Project/Detail_Settings_PUT.hs new file mode 100644 index 000000000..015b35d5f --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Detail_Settings_PUT.hs @@ -0,0 +1,207 @@ +module Wizard.Specs.API.Project.Detail_Settings_PUT ( + detail_settings_PUT, +) where + +import Data.Aeson (encode) +import qualified Data.ByteString.Char8 as BS +import qualified Data.UUID as U +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Wizard.Api.Resource.Project.ProjectSettingsChangeDTO +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectEventDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Project + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.API.Project.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- PUT /wizard-api/projects/{projectUuid}/settings +-- ------------------------------------------------------------------------ +detail_settings_PUT :: AppContext -> SpecWith ((), Application) +detail_settings_PUT appContext = + describe "PUT /wizard-api/projects/{projectUuid}/settings" $ do + test_200 appContext + test_400 appContext + test_401 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodPut + +reqUrlT projectUuid = BS.pack $ "/wizard-api/projects/" ++ U.toString projectUuid ++ "/settings" + +reqHeadersT authHeader = authHeader ++ [reqCtHeader] + +reqDtoT project = + ProjectSettingsChangeDTO + { name = project.name + , description = project.description + , projectTags = project.projectTags + , documentTemplateId = project.documentTemplateId + , formatUuid = project.formatUuid + , isTemplate = project.isTemplate + } + +reqBodyT project = encode $ reqDtoT project + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = do + create_test_200 + "HTTP 200 OK (Owner, Private)" + appContext + project1 + project1SettingsEdited + project1Events + project1Ctn + [] + True + [reqAuthHeader] + False + create_test_200 + "HTTP 200 OK (Owner, VisibleView)" + appContext + project2 + project2SettingsEdited + project2Events + project2Ctn + [] + False + [reqAuthHeader] + False + create_test_200 + "HTTP 200 OK (Non-Owner, Private, Sharing, Anonymous Enabled)" + appContext + project10 + project10EditedSettings + project10Events + project10Ctn + [project10NikolaEditProjectPermDto] + False + [reqNonAdminAuthHeader] + True + +create_test_200 title appContext project projectEdited projectEvents projectContent permissions showComments authHeader anonymousEnabled = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT $ project.uuid + let reqHeaders = reqHeadersT authHeader + let reqBody = reqBodyT projectEdited + -- AND: Prepare expectation + let expStatus = 200 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = reqDtoT projectEdited + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + runInContextIO (insertProject project10) appContext + runInContextIO (insertProjectEvents project10Events) appContext + -- AND: Enabled anonymous sharing + updateAnonymousProjectSharing appContext anonymousEnabled + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + -- AND: Find a result in DB + assertExistenceOfProjectInDB appContext projectEdited projectEvents + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_400 appContext = createInvalidJsonTest reqMethod (reqUrlT project3.uuid) "visibility" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = + createAuthTest reqMethod (reqUrlT project3.uuid) [reqCtHeader] (reqBodyT project1) + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = do + createNoPermissionTest + appContext + reqMethod + (reqUrlT project3.uuid) + [reqCtHeader] + (reqBodyT project1) + "PRJ_PERM" + create_test_403 + "HTTP 403 FORBIDDEN (Non-Owner, Private)" + appContext + project1 + project1SettingsEdited + "Administrate Project" + create_test_403 + "HTTP 403 FORBIDDEN (Non-Owner, VisibleView)" + appContext + project2 + project2SettingsEdited + "Administrate Project" + create_test_403 + "HTTP 403 FORBIDDEN (Non-Owner, Private, Sharing, Anonymous Disabled)" + appContext + project10 + project10EditedSettings + "Administrate Project" + +create_test_403 title appContext project projectEdited reason = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT $ project.uuid + let reqHeaders = reqHeadersT [reqNonAdminAuthHeader] + let reqBody = reqBodyT projectEdited + -- AND: Prepare expectation + let expStatus = 403 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN reason + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + runInContextIO (insertProject project10) appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + "/wizard-api/projects/f08ead5f-746d-411b-aee6-77ea3d24016a/settings" + (reqHeadersT [reqAuthHeader]) + (reqBodyT project1) + "project" + [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Project/Detail_Share_PUT.hs b/wizard-server/test/Wizard/Specs/API/Project/Detail_Share_PUT.hs new file mode 100644 index 000000000..84d91661d --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Detail_Share_PUT.hs @@ -0,0 +1,205 @@ +module Wizard.Specs.API.Project.Detail_Share_PUT ( + detail_share_PUT, +) where + +import Data.Aeson (encode) +import qualified Data.ByteString.Char8 as BS +import qualified Data.UUID as U +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Wizard.Api.Resource.Project.ProjectShareChangeDTO +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectEventDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Project +import Wizard.Service.Project.ProjectMapper + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.API.Project.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- PUT /wizard-api/projects/{projectUuid}/share +-- ------------------------------------------------------------------------ +detail_share_PUT :: AppContext -> SpecWith ((), Application) +detail_share_PUT appContext = + describe "PUT /wizard-api/projects/{projectUuid}/share" $ do + test_200 appContext + test_400 appContext + test_401 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodPut + +reqUrlT projectUuid = BS.pack $ "/wizard-api/projects/" ++ U.toString projectUuid ++ "/share" + +reqHeadersT authHeader = authHeader ++ [reqCtHeader] + +reqDtoT project = + ProjectShareChangeDTO + { visibility = project.visibility + , sharing = project.sharing + , permissions = fmap toProjectPermChangeDTO project.permissions + } + +reqBodyT project = encode $ reqDtoT project + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = do + create_test_200 + "HTTP 200 OK (Owner, Private)" + appContext + project1 + project1ShareEdited + project1Events + project1Ctn + [] + True + [reqAuthHeader] + False + create_test_200 + "HTTP 200 OK (Owner, VisibleView)" + appContext + project2 + project2ShareEdited + project2Events + project2Ctn + [] + False + [reqAuthHeader] + False + create_test_200 + "HTTP 200 OK (Non-Owner, Private, Sharing, Anonymous Enabled)" + appContext + project10 + project10EditedShare + project10Events + project10Ctn + [project10NikolaEditProjectPermDto] + False + [reqNonAdminAuthHeader] + True + +create_test_200 title appContext project projectEdited projectEvents projectContent permissions showComments authHeader anonymousEnabled = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT $ project.uuid + let reqHeaders = reqHeadersT authHeader + let reqBody = reqBodyT projectEdited + -- AND: Prepare expectation + let expStatus = 200 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = reqDtoT projectEdited + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + runInContextIO (insertProject project10) appContext + runInContextIO (insertProjectEvents project10Events) appContext + -- AND: Enabled anonymous sharing + updateAnonymousProjectSharing appContext anonymousEnabled + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + -- AND: Find a result in DB + assertExistenceOfProjectInDB appContext projectEdited projectEvents + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_400 appContext = createInvalidJsonTest reqMethod (reqUrlT project3.uuid) "visibility" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = + createAuthTest reqMethod (reqUrlT project3.uuid) [reqCtHeader] (reqBodyT project1) + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = do + createNoPermissionTest + appContext + reqMethod + (reqUrlT project3.uuid) + [reqCtHeader] + (reqBodyT project1) + "PRJ_PERM" + create_test_403 + "HTTP 403 FORBIDDEN (Non-Owner, Private)" + appContext + project1 + project1ShareEdited + "Administrate Project" + create_test_403 + "HTTP 403 FORBIDDEN (Non-Owner, VisibleView)" + appContext + project2 + project2ShareEdited + "Administrate Project" + create_test_403 + "HTTP 403 FORBIDDEN (Non-Owner, Private, Sharing, Anonymous Disabled)" + appContext + project10 + project10EditedShare + "Administrate Project" + +create_test_403 title appContext project projectEdited reason = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT $ project.uuid + let reqHeaders = reqHeadersT [reqNonAdminAuthHeader] + let reqBody = reqBodyT projectEdited + -- AND: Prepare expectation + let expStatus = 403 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN reason + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + runInContextIO (insertProject project10) appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + "/wizard-api/projects/f08ead5f-746d-411b-aee6-77ea3d24016a/share" + (reqHeadersT [reqAuthHeader]) + (reqBodyT project1) + "project" + [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Project/Event/APISpec.hs b/wizard-server/test/Wizard/Specs/API/Project/Event/APISpec.hs new file mode 100644 index 000000000..cd25e3c00 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Event/APISpec.hs @@ -0,0 +1,11 @@ +module Wizard.Specs.API.Project.Event.APISpec where + +import Test.Hspec + +import Wizard.Specs.API.Project.Event.Detail_GET +import Wizard.Specs.API.Project.Event.List_GET + +projectEventAPI appContext = + describe "PROJECT EVENT API Spec" $ do + list_GET appContext + detail_GET appContext diff --git a/wizard-server/test/Wizard/Specs/API/Project/Event/Detail_GET.hs b/wizard-server/test/Wizard/Specs/API/Project/Event/Detail_GET.hs new file mode 100644 index 000000000..e650402ec --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Event/Detail_GET.hs @@ -0,0 +1,181 @@ +module Wizard.Specs.API.Project.Event.Detail_GET ( + detail_GET, +) where + +import Data.Aeson (encode) +import qualified Data.ByteString.Char8 as BS +import qualified Data.UUID as U +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Common.Lens +import Shared.Common.Model.Error.Error +import Wizard.Database.DAO.Project.ProjectCommentDAO +import Wizard.Database.DAO.Project.ProjectCommentThreadDAO +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectEventDAO +import Wizard.Database.DAO.Project.ProjectPermDAO +import Wizard.Database.DAO.Project.ProjectVersionDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ +import Wizard.Database.Migration.Development.User.Data.Users +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Event.ProjectEventLenses () +import Wizard.Model.Project.Project +import Wizard.Service.Project.Event.ProjectEventMapper +import WizardLib.Public.Localization.Messages.Public + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- GET /wizard-api/projects/{projectUuid}/events/{eventUuid} +-- ------------------------------------------------------------------------ +detail_GET :: AppContext -> SpecWith ((), Application) +detail_GET appContext = + describe "GET /wizard-api/projects/{projectUuid}/events/{eventUuid}" $ do + test_200 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodGet + +reqUrlT projectUuid projectEventUuid = + BS.pack $ "/wizard-api/projects/" ++ U.toString projectUuid ++ "/events/" ++ U.toString projectEventUuid + +reqHeadersT authHeader = authHeader + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = do + create_test_200 "HTTP 200 OK (Owner, Private)" appContext project1 project1Events (sre_rQ1' project1Uuid) [reqAuthHeader] + create_test_200 "HTTP 200 OK (Non-Owner, VisibleView)" appContext project2 project2Events (sre_rQ1' project2Uuid) [reqNonAdminAuthHeader] + create_test_200 + "HTTP 200 OK (Commenter)" + appContext + (project13 {visibility = PrivateProjectVisibility}) + project13Events + (sre_rQ1' project13Uuid) + [reqNonAdminAuthHeader] + create_test_200 + "HTTP 200 OK (Non-Commenter, VisibleComment)" + appContext + project13 + project13Events + (sre_rQ1' project13Uuid) + [reqIsaacAuthTokenHeader] + create_test_200 + "HTTP 200 OK (Anonymous, VisibleComment, AnyoneWithLinkComment)" + appContext + (project13 {sharing = AnyoneWithLinkCommentProjectSharing}) + project13Events + (sre_rQ1' project13Uuid) + [] + create_test_200 "HTTP 200 OK (Anonymous, VisibleView, Sharing)" appContext project7 project7Events (sre_rQ1' project7Uuid) [] + create_test_200 "HTTP 200 OK (Non-Owner, VisibleEdit)" appContext project3 project3Events (sre_rQ1' project3Uuid) [reqNonAdminAuthHeader] + create_test_200 "HTTP 200 OK (Anonymous, Public, Sharing)" appContext project10 project10Events (sre_rQ1' project10Uuid) [] + +create_test_200 title appContext project projectEvents projectEvent authHeader = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT project.uuid (getUuid projectEvent) + let reqHeaders = reqHeadersT authHeader + -- AND: Prepare expectation + let expStatus = 200 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = toEventDTO projectEvent (Just userAlbert) + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + runInContextIO deleteProjectVersions appContext + runInContextIO deleteProjectEvents appContext + runInContextIO deleteProjectComments appContext + runInContextIO deleteProjectCommentThreads appContext + runInContextIO deleteProjectPerms appContext + runInContextIO deleteProjects appContext + runInContextIO (insertProject project) appContext + runInContextIO (insertProjectEvents projectEvents) appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = do + create_test_403 + "HTTP 403 FORBIDDEN (Non-Owner, Private)" + appContext + project1 + (sre_rQ1' project1Uuid) + [reqNonAdminAuthHeader] + (_ERROR_VALIDATION__FORBIDDEN "View Project") + create_test_403 + "HTTP 403 FORBIDDEN (Anonymous, VisibleView)" + appContext + project2 + (sre_rQ1' project2Uuid) + [] + _ERROR_SERVICE_USER__MISSING_USER + create_test_403 + "HTTP 403 FORBIDDEN (Anonymous, Public)" + appContext + project3 + (sre_rQ1' project3Uuid) + [] + _ERROR_SERVICE_USER__MISSING_USER + +create_test_403 title appContext project projectEvent authHeader errorMessage = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT project.uuid (getUuid projectEvent) + let reqHeaders = reqHeadersT authHeader + -- AND: Prepare expectation + let expStatus = 403 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = ForbiddenError errorMessage + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + "/wizard-api/projects/f08ead5f-746d-411b-aee6-77ea3d24016a/events" + [reqHeadersT reqAuthHeader] + reqBody + "project" + [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Project/Event/List_GET.hs b/wizard-server/test/Wizard/Specs/API/Project/Event/List_GET.hs new file mode 100644 index 000000000..59f7dd493 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Event/List_GET.hs @@ -0,0 +1,167 @@ +module Wizard.Specs.API.Project.Event.List_GET ( + list_GET, +) where + +import Data.Aeson (encode) +import qualified Data.ByteString.Char8 as BS +import qualified Data.UUID as U +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.PageMetadata +import Shared.Common.Model.Error.Error +import Wizard.Database.DAO.Project.ProjectCommentDAO +import Wizard.Database.DAO.Project.ProjectCommentThreadDAO +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectEventDAO +import Wizard.Database.DAO.Project.ProjectPermDAO +import Wizard.Database.DAO.Project.ProjectVersionDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Project +import WizardLib.Public.Localization.Messages.Public + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- GET /wizard-api/projects/{projectUuid}/events +-- ------------------------------------------------------------------------ +list_GET :: AppContext -> SpecWith ((), Application) +list_GET appContext = + describe "GET /wizard-api/projects/{projectUuid}/events" $ do + test_200 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodGet + +reqUrlT projectUuid = BS.pack $ "/wizard-api/projects/" ++ U.toString projectUuid ++ "/events" + +reqHeadersT authHeader = authHeader + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = do + create_test_200 "HTTP 200 OK (Owner, Private)" appContext project1 project1Events [reqAuthHeader] + create_test_200 "HTTP 200 OK (Non-Owner, VisibleView)" appContext project2 project2Events [reqNonAdminAuthHeader] + create_test_200 + "HTTP 200 OK (Commenter)" + appContext + (project13 {visibility = PrivateProjectVisibility}) + project13Events + [reqNonAdminAuthHeader] + create_test_200 "HTTP 200 OK (Non-Commenter, VisibleComment)" appContext project13 project13Events [reqIsaacAuthTokenHeader] + create_test_200 + "HTTP 200 OK (Anonymous, VisibleComment, AnyoneWithLinkComment)" + appContext + (project13 {sharing = AnyoneWithLinkCommentProjectSharing}) + project13Events + [] + create_test_200 "HTTP 200 OK (Anonymous, VisibleView, Sharing)" appContext project7 project7Events [] + create_test_200 "HTTP 200 OK (Non-Owner, VisibleEdit)" appContext project3 project3Events [reqNonAdminAuthHeader] + create_test_200 "HTTP 200 OK (Anonymous, Public, Sharing)" appContext project10 project10Events [] + +create_test_200 title appContext project projectEvents authHeader = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT project.uuid + let reqHeaders = reqHeadersT authHeader + -- AND: Prepare expectation + let expStatus = 200 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = Page "projectEvents" (PageMetadata 20 16 1 0) (fEventsDto project.uuid) + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + runInContextIO deleteProjectVersions appContext + runInContextIO deleteProjectEvents appContext + runInContextIO deleteProjectComments appContext + runInContextIO deleteProjectCommentThreads appContext + runInContextIO deleteProjectPerms appContext + runInContextIO deleteProjects appContext + runInContextIO (insertProject project) appContext + runInContextIO (insertProjectEvents projectEvents) appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = do + create_test_403 + "HTTP 403 FORBIDDEN (Non-Owner, Private)" + appContext + project1 + [reqNonAdminAuthHeader] + (_ERROR_VALIDATION__FORBIDDEN "View Project") + create_test_403 + "HTTP 403 FORBIDDEN (Anonymous, VisibleView)" + appContext + project2 + [] + _ERROR_SERVICE_USER__MISSING_USER + create_test_403 + "HTTP 403 FORBIDDEN (Anonymous, Public)" + appContext + project3 + [] + _ERROR_SERVICE_USER__MISSING_USER + +create_test_403 title appContext project authHeader errorMessage = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT project.uuid + let reqHeaders = reqHeadersT authHeader + -- AND: Prepare expectation + let expStatus = 403 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = ForbiddenError errorMessage + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + "/wizard-api/projects/f08ead5f-746d-411b-aee6-77ea3d24016a/events" + [reqHeadersT reqAuthHeader] + reqBody + "project" + [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Project/List_GET.hs b/wizard-server/test/Wizard/Specs/API/Project/List_GET.hs new file mode 100644 index 000000000..77683c121 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/List_GET.hs @@ -0,0 +1,273 @@ +module Wizard.Specs.API.Project.List_GET ( + list_GET, +) where + +import Data.Aeson (encode) +import qualified Data.ByteString.Char8 as BS +import qualified Data.UUID as U +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.PageMetadata +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Api.Resource.Project.ProjectDTO +import Wizard.Database.DAO.Project.ProjectDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ +import Wizard.Database.Migration.Development.User.Data.Users +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Context.AppContext +import Wizard.Model.User.User + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- GET /wizard-api/projects +-- ------------------------------------------------------------------------ +list_GET :: AppContext -> SpecWith ((), Application) +list_GET appContext = + describe "GET /wizard-api/projects" $ do + test_200 appContext + test_401 appContext + test_403 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodGet + +reqUrl = "/wizard-api/projects" + +reqHeadersT reqAuthHeader = [reqAuthHeader] + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = do + create_test_200 + "HTTP 200 OK (Admin - pagination)" + appContext + "/wizard-api/projects?sort=uuid,asc&page=1&size=1" + reqAuthHeader + (Page "projects" (PageMetadata 1 6 6 1) [project14Dto]) + create_test_200 + "HTTP 200 OK (Admin - query)" + appContext + "/wizard-api/projects?sort=uuid,asc&q=pri" + reqAuthHeader + (Page "projects" (PageMetadata 20 2 1 0) [project1Dto, project12Dto]) + create_test_200 + "HTTP 200 OK (Admin - userUuids)" + appContext + (BS.pack $ "/wizard-api/projects?sort=uuid,asc&userUuids=" ++ U.toString userAlbert.uuid) + reqAuthHeader + (Page "projects" (PageMetadata 20 3 1 0) [project1Dto, project2Dto, project12Dto]) + create_test_200 + "HTTP 200 OK (Admin - userUuids, or)" + appContext + ( BS.pack $ + "/wizard-api/projects?sort=uuid,asc&userUuidsOp=or&userUuids=" + ++ U.toString userAlbert.uuid + ++ "," + ++ U.toString userIsaac.uuid + ) + reqAuthHeader + (Page "projects" (PageMetadata 20 3 1 0) [project1Dto, project2Dto, project12Dto]) + create_test_200 + "HTTP 200 OK (Admin - userUuids, and)" + appContext + ( BS.pack $ + "/wizard-api/projects?sort=uuid,asc&userUuidsOp=and&userUuids=" + ++ U.toString userAlbert.uuid + ++ "," + ++ U.toString userIsaac.uuid + ) + reqAuthHeader + (Page "projects" (PageMetadata 20 0 0 0) ([] :: [ProjectDTO])) + create_test_200 + "HTTP 200 OK (Admin - isTemplate - true)" + appContext + "/wizard-api/projects?sort=uuid,asc&isTemplate=true" + reqAuthHeader + (Page "projects" (PageMetadata 20 3 1 0) [project14Dto, project1Dto, project12Dto]) + create_test_200 + "HTTP 200 OK (Admin - isTemplate - false)" + appContext + "/wizard-api/projects?sort=uuid,asc&isTemplate=false" + reqAuthHeader + (Page "projects" (PageMetadata 20 3 1 0) [project3Dto, project15Dto, project2Dto]) + create_test_200 + "HTTP 200 OK (Admin - isMigrating - true)" + appContext + "/wizard-api/projects?sort=uuid,asc&isMigrating=true" + reqAuthHeader + (Page "projects" (PageMetadata 20 0 0 0) ([] :: [ProjectDTO])) + create_test_200 + "HTTP 200 OK (Admin - isMigrating - false)" + appContext + "/wizard-api/projects?sort=uuid,asc&isMigrating=false" + reqAuthHeader + ( Page + "projects" + (PageMetadata 20 6 1 0) + [project3Dto, project14Dto, project1Dto, project15Dto, project2Dto, project12Dto] + ) + create_test_200 + "HTTP 200 OK (Admin - projectTags)" + appContext + "/wizard-api/projects?sort=uuid,asc&projectTags=projectTag1" + reqAuthHeader + ( Page + "projects" + (PageMetadata 20 4 1 0) + [project14Dto, project1Dto, project2Dto, project12Dto] + ) + create_test_200 + "HTTP 200 OK (Admin - projectTags, or)" + appContext + "/wizard-api/projects?sort=uuid,asc&projectTagsOp=or&projectTags=projectTag1,projectTag2" + reqAuthHeader + ( Page + "projects" + (PageMetadata 20 4 1 0) + [project14Dto, project1Dto, project2Dto, project12Dto] + ) + create_test_200 + "HTTP 200 OK (Admin - projectTags, and)" + appContext + "/wizard-api/projects?sort=uuid,asc&projectTagsOp=and&projectTags=projectTag1,projectTag2" + reqAuthHeader + (Page "projects" (PageMetadata 20 1 1 0) [project2Dto]) + create_test_200 + "HTTP 200 OK (Admin - knowledgePackage)" + appContext + "/wizard-api/projects?sort=uuid,asc&knowledgeModelPackageIds=org.nl.amsterdam:core-amsterdam:all" + reqAuthHeader + (Page "projects" (PageMetadata 20 1 1 0) [project14Dto]) + create_test_200 + "HTTP 200 OK (Admin - sort asc)" + appContext + "/wizard-api/projects?sort=uuid,asc" + reqAuthHeader + ( Page + "projects" + (PageMetadata 20 6 1 0) + [project3Dto, project14Dto, project1Dto, project15Dto, project2Dto, project12Dto] + ) + create_test_200 + "HTTP 200 OK (Admin - sort desc)" + appContext + "/wizard-api/projects?sort=updatedAt,desc" + reqAuthHeader + ( Page + "projects" + (PageMetadata 20 6 1 0) + [project15Dto, project3Dto, project14Dto, project1Dto, project12Dto, project2Dto] + ) + create_test_200 + "HTTP 200 OK (Non-Admin)" + appContext + "/wizard-api/projects?sort=uuid,asc" + reqNonAdminAuthHeader + ( Page + "projects" + (PageMetadata 20 5 1 0) + [project3Dto, project14Dto, project15Dto, project2Dto, project12Dto] + ) + create_test_200 + "HTTP 200 OK (Non-Admin - query)" + appContext + "/wizard-api/projects?q=pri" + reqNonAdminAuthHeader + (Page "projects" (PageMetadata 20 1 1 0) [project12Dto]) + create_test_200 + "HTTP 200 OK (Non-Admin - query users)" + appContext + (BS.pack $ "/wizard-api/projects?sort=uuid,asc&userUuids=" ++ U.toString userAlbert.uuid) + reqNonAdminAuthHeader + (Page "projects" (PageMetadata 20 2 1 0) [project2Dto, project12Dto]) + create_test_200 + "HTTP 200 OK (Non-Admin - projectTags)" + appContext + "/wizard-api/projects?sort=uuid,asc&projectTags=projectTag1" + reqNonAdminAuthHeader + (Page "projects" (PageMetadata 20 3 1 0) [project14Dto, project2Dto, project12Dto]) + create_test_200 + "HTTP 200 OK (Non-Admin - knowledgeModelPackage)" + appContext + "/wizard-api/projects?sort=uuid,asc&knowledgeModelPackageIds=org.nl.amsterdam:core-amsterdam:all" + reqNonAdminAuthHeader + (Page "projects" (PageMetadata 20 1 1 0) [project14Dto]) + create_test_200 + "HTTP 200 OK (Non-Admin - isTemplate - true)" + appContext + "/wizard-api/projects?sort=uuid,asc&isTemplate=true" + reqNonAdminAuthHeader + (Page "projects" (PageMetadata 20 2 1 0) [project14Dto, project12Dto]) + create_test_200 + "HTTP 200 OK (Non-Admin - isTemplate - false)" + appContext + "/wizard-api/projects?sort=uuid,asc&isTemplate=false" + reqNonAdminAuthHeader + (Page "projects" (PageMetadata 20 3 1 0) [project3Dto, project15Dto, project2Dto]) + create_test_200 + "HTTP 200 OK (Non-Admin - isMigrating - true)" + appContext + "/wizard-api/projects?sort=uuid,asc&isMigrating=true" + reqNonAdminAuthHeader + (Page "projects" (PageMetadata 20 0 0 0) ([] :: [ProjectDTO])) + create_test_200 + "HTTP 200 OK (Non-Admin - isMigrating - false)" + appContext + "/wizard-api/projects?sort=uuid,asc&isMigrating=false" + reqNonAdminAuthHeader + ( Page + "projects" + (PageMetadata 20 5 1 0) + [project3Dto, project14Dto, project15Dto, project2Dto, project12Dto] + ) + +create_test_200 title appContext reqUrl reqAuthHeader expDto = + it title $ + -- GIVEN: Prepare request + do + let reqHeaders = reqHeadersT reqAuthHeader + -- AND: Prepare expectation + let expStatus = 200 + let expHeaders = resCtHeader : resCorsHeaders + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + runInContextIO (insertPackage amsterdamKmPackage) appContext + runInContextIO (insertProject project12) appContext + runInContextIO (insertProject project14) appContext + runInContextIO (insertProject project15) appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod reqUrl [reqCtHeader] reqBody + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [reqCtHeader] reqBody "PRJ_PERM" diff --git a/wizard-server/test/Wizard/Specs/API/Project/List_POST.hs b/wizard-server/test/Wizard/Specs/API/Project/List_POST.hs new file mode 100644 index 000000000..fb1004f6f --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/List_POST.hs @@ -0,0 +1,142 @@ +module Wizard.Specs.API.Project.List_POST ( + list_POST, +) where + +import Data.Aeson (encode) +import Data.Foldable (traverse_) +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Api.Resource.Project.ProjectCreateDTO +import Wizard.Api.Resource.Project.ProjectCreateJM () +import Wizard.Api.Resource.Project.ProjectDTO +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectEventDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Acl.ProjectPerm +import Wizard.Model.Project.Project + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.API.Project.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- POST /wizard-api/projects +-- ------------------------------------------------------------------------ +list_POST :: AppContext -> SpecWith ((), Application) +list_POST appContext = + describe "POST /wizard-api/projects" $ do + test_201 appContext + test_400 appContext + test_403 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodPost + +reqUrl = "/wizard-api/projects" + +reqHeadersT authHeader = authHeader ++ [reqCtHeader] + +reqDtoT project = project + +reqBodyT project = encode (reqDtoT project) + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_201 appContext = do + create_test_201 appContext "HTTP 201 CREATED (with token)" False project1Create [reqAuthHeader] + create_test_201 + appContext + "HTTP 201 CREATED (without token)" + True + (project1Create {sharing = AnyoneWithLinkEditProjectSharing} :: ProjectCreateDTO) + [] + +create_test_201 appContext title anonymousSharingEnabled project authHeader = + it title $ + -- GIVEN: Prepare request + do + let reqHeaders = reqHeadersT authHeader + let reqBody = reqBodyT project + -- AND: Prepare expectation + let expStatus = 201 + let expHeaders = resCtHeaderPlain : resCorsHeadersPlain + let expDto = + if anonymousSharingEnabled + then project1Dto {sharing = AnyoneWithLinkEditProjectSharing} :: ProjectDTO + else project1Dto + let expBody = encode expDto + -- AND: Run migrations + runInContextIO TML.runMigration appContext + runInContextIO (insertPackage germanyKmPackage) appContext + runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext + runInContextIO deleteProjects appContext + -- AND: Enabled anonymous sharing + updateAnonymousProjectSharing appContext anonymousSharingEnabled + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let (status, headers, resBody) = destructResponse response :: (Int, ResponseHeaders, ProjectDTO) + assertResStatus status expStatus + assertResHeaders headers expHeaders + compareProjectCreateDtos resBody expDto + -- AND: Find a result in DB + (Right eventsInDB) <- runInContextIO (findProjectEventsByProjectUuid resBody.uuid) appContext + if anonymousSharingEnabled + then + assertExistenceOfProjectInDB + appContext + ( project1 + { uuid = resBody.uuid + , description = Nothing + , isTemplate = False + , sharing = AnyoneWithLinkEditProjectSharing + , projectTags = [] + , permissions = [] + , creatorUuid = Nothing + } + :: Project + ) + eventsInDB + else do + let aPermissions = + [ (head project1.permissions) + { projectUuid = resBody.uuid + } + :: ProjectPerm + ] + assertExistenceOfProjectInDB + appContext + ( project1 + { uuid = resBody.uuid + , description = Nothing + , isTemplate = False + , projectTags = [] + , permissions = aPermissions + } + :: Project + ) + eventsInDB + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_400 appContext = createInvalidJsonTest reqMethod reqUrl "packageId" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = + createNoPermissionTest appContext reqMethod reqUrl [reqCtHeader] (reqBodyT project1Create) "PRJ_PERM" diff --git a/wizard-server/test/Wizard/Specs/API/Project/List_POST_CloneUuid.hs b/wizard-server/test/Wizard/Specs/API/Project/List_POST_CloneUuid.hs new file mode 100644 index 000000000..324c82aa1 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/List_POST_CloneUuid.hs @@ -0,0 +1,129 @@ +module Wizard.Specs.API.Project.List_POST_CloneUuid ( + list_POST_cloneUuid, +) where + +import Data.Aeson (encode) +import qualified Data.ByteString.Char8 as BS +import qualified Data.UUID as U +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Wizard.Api.Resource.Project.ProjectCreateJM () +import Wizard.Api.Resource.Project.ProjectDTO +import Wizard.Database.DAO.Project.ProjectDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Project + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.API.Project.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- POST /wizard-api/projects?cloneUuid={projectUuid} +-- ------------------------------------------------------------------------ +list_POST_cloneUuid :: AppContext -> SpecWith ((), Application) +list_POST_cloneUuid appContext = + describe "POST /wizard-api/projects/{projectUuid}/clone" $ do + test_201 appContext + test_401 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodPost + +reqUrlT projectUuid = BS.pack $ "/wizard-api/projects/" ++ U.toString projectUuid ++ "/clone" + +reqHeadersT authHeader = [authHeader] + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_201 appContext = do + create_test_201 "HTTP 200 OK (Owner, Private)" appContext project1Dto + create_test_201 "HTTP 200 OK (Owner, VisibleView)" appContext project2Dto + create_test_201 "HTTP 200 OK (Non-Owner, VisibleEdit)" appContext project3Dto + +create_test_201 title appContext project = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT $ project.uuid + let reqHeaders = reqHeadersT reqAuthHeader + -- AND: Prepare expectation + let expStatus = 201 + let expHeaders = resCtHeaderPlain : resCorsHeadersPlain + let expDto = project + let expBody = encode expDto + -- AND: Run migrations + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let (status, headers, resBody) = destructResponse response :: (Int, ResponseHeaders, ProjectDTO) + assertResStatus status expStatus + assertResHeaders headers expHeaders + compareProjectCloneDtos resBody expDto + -- AND: Find a result in DB + assertCountInDB findProjects appContext 4 + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod (reqUrlT project3.uuid) [] reqBody + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = + create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, Private)" appContext project1 "View Project" + +create_test_403 title appContext project reason = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT $ project.uuid + let reqHeaders = reqHeadersT reqNonAdminAuthHeader + -- AND: Prepare expectation + let expStatus = 403 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN reason + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + "/wizard-api/projects/f08ead5f-746d-411b-aee6-77ea3d24016a/clone" + (reqHeadersT reqAuthHeader) + reqBody + "project" + [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Project/List_POST_FromTemplate.hs b/wizard-server/test/Wizard/Specs/API/Project/List_POST_FromTemplate.hs new file mode 100644 index 000000000..6ab5decb5 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/List_POST_FromTemplate.hs @@ -0,0 +1,144 @@ +module Wizard.Specs.API.Project.List_POST_FromTemplate ( + list_POST_fromTemplate, +) where + +import Data.Aeson (encode) +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Wizard.Api.Resource.Project.ProjectCreateFromTemplateDTO +import Wizard.Api.Resource.Project.ProjectCreateJM () +import Wizard.Api.Resource.Project.ProjectDTO +import Wizard.Database.DAO.Project.ProjectDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ_Migration +import qualified Wizard.Database.Migration.Development.User.UserMigration as U_Migration +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Project +import Wizard.Model.Tenant.Config.TenantConfig hiding (request) +import Wizard.Service.Tenant.Config.ConfigService + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.API.Project.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- POST /wizard-api/projects?fromTemplate=true +-- ------------------------------------------------------------------------ +list_POST_fromTemplate :: AppContext -> SpecWith ((), Application) +list_POST_fromTemplate appContext = + describe "POST /wizard-api/projects/from-template" $ do + test_201 appContext + test_400 appContext + test_403 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodPost + +reqUrl = "/wizard-api/projects/from-template" + +reqHeadersT authHeader = authHeader ++ [reqCtHeader] + +reqDtoT projectTemplateUuid name = + ProjectCreateFromTemplateDTO + { name = name + , projectUuid = projectTemplateUuid + } + +reqBodyT projectTemplateUuid name = encode (reqDtoT projectTemplateUuid name) + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_201 appContext = + it "HTTP 200 OK" $ + -- GIVEN: Prepare request + do + let reqHeaders = reqHeadersT [reqAuthHeader] + let reqBody = reqBodyT project1.uuid project11.name + -- AND: Prepare expectation + let expStatus = 201 + let expHeaders = resCtHeaderPlain : resCorsHeadersPlain + let expDto = project11Dto + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U_Migration.runMigration appContext + runInContextIO TML_Migration.runMigration appContext + runInContextIO PRJ_Migration.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let (status, headers, resBody) = destructResponse response :: (Int, ResponseHeaders, ProjectDTO) + assertResStatus status expStatus + assertResHeaders headers expHeaders + compareProjectCreateFromTemplateDtos resBody expDto + -- AND: Find a result in DB + assertCountInDB findProjects appContext 4 + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_400 appContext = + it "HTTP 400 BAD REQUEST (projectCreation: CustomProjectCreation)" $ + -- GIVEN: Prepare request + do + let reqHeaders = reqHeadersT [reqAuthHeader] + let reqBody = reqBodyT project2.uuid project11.name + -- AND: Prepare expectation + let expStatus = 400 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = UserError . _ERROR_SERVICE_COMMON__FEATURE_IS_DISABLED $ "Project Template" + let expBody = encode expDto + -- AND: Change tenantConfig + (Right tcProject) <- runInContextIO getCurrentTenantConfigProject appContext + let tcProjectUpdated = tcProject {projectCreation = CustomProjectCreation} + runInContextIO (modifyTenantConfigProject tcProjectUpdated) appContext + -- AND: Run migrations + runInContextIO U_Migration.runMigration appContext + runInContextIO TML_Migration.runMigration appContext + runInContextIO PRJ_Migration.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + -- AND: Find a result in DB + assertCountInDB findProjects appContext 3 + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = + it "HTTP 403 FORBIDDEN (isTemplate: False)" $ + -- GIVEN: Prepare request + do + let reqHeaders = reqHeadersT [reqAuthHeader] + let reqBody = reqBodyT project2.uuid project11.name + -- AND: Prepare expectation + let expStatus = 403 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN "Project Template" + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U_Migration.runMigration appContext + runInContextIO TML_Migration.runMigration appContext + runInContextIO PRJ_Migration.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + -- AND: Find a result in DB + assertCountInDB findProjects appContext 3 diff --git a/wizard-server/test/Wizard/Specs/API/Project/Migration/APISpec.hs b/wizard-server/test/Wizard/Specs/API/Project/Migration/APISpec.hs new file mode 100644 index 000000000..e738969cd --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Migration/APISpec.hs @@ -0,0 +1,17 @@ +module Wizard.Specs.API.Project.Migration.APISpec where + +import Test.Hspec + +import Wizard.Specs.API.Project.Migration.List_Current_Completion_POST +import Wizard.Specs.API.Project.Migration.List_Current_DELETE +import Wizard.Specs.API.Project.Migration.List_Current_GET +import Wizard.Specs.API.Project.Migration.List_Current_PUT +import Wizard.Specs.API.Project.Migration.List_POST + +projectMigrationAPI appContext = + describe "PROJECT MIGRATION API Spec" $ do + list_POST appContext + list_current_GET appContext + list_current_PUT appContext + list_current_DELETE appContext + list_current_completion_POST appContext diff --git a/wizard-server/test/Wizard/Specs/API/Project/Migration/Common.hs b/wizard-server/test/Wizard/Specs/API/Project/Migration/Common.hs new file mode 100644 index 000000000..8dad388b7 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Migration/Common.hs @@ -0,0 +1,37 @@ +module Wizard.Specs.API.Project.Migration.Common where + +import Data.Either (isRight) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Wizard.Database.DAO.Project.ProjectMigrationDAO +import Wizard.Model.Project.Migration.ProjectMigration + +import Wizard.Specs.API.Project.Common +import Wizard.Specs.Common + +-- -------------------------------- +-- ASSERTS +-- -------------------------------- +assertExistenceOfMigrationStateInDB appContext entity = do + eEntitiesFromDb <- + runInContextIO (findProjectMigrationsByOldProjectUuid entity.oldProjectUuid) appContext + liftIO $ isRight eEntitiesFromDb `shouldBe` True + let (Right entitiesFromDb) = eEntitiesFromDb + liftIO $ length entitiesFromDb `shouldBe` 1 + let entityFromDb = head entitiesFromDb + compareProjectMigrators entityFromDb entity + +-- -------------------------------- +-- COMPARATORS +-- -------------------------------- +compareProjectMigrators resDto expDto = do + liftIO $ resDto.oldProjectUuid `shouldBe` expDto.oldProjectUuid + liftIO $ resDto.newProjectUuid `shouldBe` expDto.newProjectUuid + liftIO $ resDto.resolvedQuestionUuids `shouldBe` expDto.resolvedQuestionUuids + +compareProjectMigratorDtos resDto expDto = do + compareProjectCreateDtos'' resDto.oldProject expDto.oldProject + compareProjectCreateDtos'' resDto.newProject expDto.newProject + liftIO $ resDto.resolvedQuestionUuids `shouldBe` expDto.resolvedQuestionUuids diff --git a/wizard-server/test/Wizard/Specs/API/Project/Migration/List_Current_Completion_POST.hs b/wizard-server/test/Wizard/Specs/API/Project/Migration/List_Current_Completion_POST.hs new file mode 100644 index 000000000..63091c824 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Migration/List_Current_Completion_POST.hs @@ -0,0 +1,135 @@ +module Wizard.Specs.API.Project.Migration.List_Current_Completion_POST ( + list_current_completion_POST, +) where + +import Data.Aeson (encode) +import qualified Data.ByteString.Char8 as BS +import qualified Data.UUID as U +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectMigrationDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.ProjectMigrations +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ +import qualified Wizard.Database.Migration.Development.Project.ProjectMigrationMigration as PRJ_MIG +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Migration.ProjectMigration +import Wizard.Model.Project.Project + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- POST /wizard-api/projects/{projectUuid}/migrations/current/completion +-- ------------------------------------------------------------------------ +list_current_completion_POST :: AppContext -> SpecWith ((), Application) +list_current_completion_POST appContext = + describe "POST /wizard-api/projects/{projectUuid}/migrations/current/completion" $ do + test_204 appContext + test_401 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodPost + +reqUrlT projectUuid = BS.pack $ "/wizard-api/projects/" ++ U.toString projectUuid ++ "/migrations/current/completion" + +reqHeadersT authHeader = [authHeader] + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_204 appContext = + it "HTTP 204 NO CONTENT" $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT $ project4Upgraded.uuid + let reqHeaders = reqHeadersT reqAuthHeader + -- AND: Prepare expectation + let expStatus = 204 + let expBody = "" + let expHeaders = resCorsHeaders + -- AND: Prepare database + runInContextIO TML.runMigration appContext + runInContextIO (insertProject project4) appContext + runInContextIO (insertProject project4Upgraded) appContext + runInContextIO (insertProject differentProject) appContext + runInContextIO PRJ_MIG.runMigration appContext + runInContextIO (insertProjectMigration projectMigration) appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + -- AND: Find result in DB and compare with expectation state + assertCountInDB findProjects appContext 1 + assertCountInDB findProjectMigrations appContext 0 + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod (reqUrlT project3.uuid) [] reqBody + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = do + createNoPermissionTest appContext reqMethod (reqUrlT project3.uuid) [] "" "PRJ_PERM" + create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, Private)" appContext project1 "View Project" + create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, VisibleView)" appContext project2 "Migrate Project" + +create_test_403 title appContext project reason = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT $ project.uuid + let reqHeaders = reqHeadersT reqNonAdminAuthHeader + -- AND: Prepare expectation + let expStatus = 403 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN reason + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + let ms = projectMigration {oldProjectUuid = project.uuid, newProjectUuid = project.uuid} + runInContextIO (insertProjectMigration ms) appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + -- AND: Find result in DB and compare with expectation state + assertCountInDB findProjects appContext 3 + assertCountInDB findProjectMigrations appContext 1 + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + (reqUrlT project4.uuid) + (reqHeadersT reqAuthHeader) + reqBody + "project_migration" + [("new_project_uuid", "57250a07-a663-4ff3-ac1f-16530f2c1bfe")] diff --git a/wizard-server/test/Wizard/Specs/API/Project/Migration/List_Current_DELETE.hs b/wizard-server/test/Wizard/Specs/API/Project/Migration/List_Current_DELETE.hs new file mode 100644 index 000000000..f83728978 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Migration/List_Current_DELETE.hs @@ -0,0 +1,135 @@ +module Wizard.Specs.API.Project.Migration.List_Current_DELETE ( + list_current_DELETE, +) where + +import Data.Aeson (encode) +import qualified Data.ByteString.Char8 as BS +import qualified Data.UUID as U +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectMigrationDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.ProjectMigrations +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ +import qualified Wizard.Database.Migration.Development.Project.ProjectMigrationMigration as PRJ_MIG +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Migration.ProjectMigration +import Wizard.Model.Project.Project + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- DELETE /wizard-api/projects/{projectUuid}/migrations/current +-- ------------------------------------------------------------------------ +list_current_DELETE :: AppContext -> SpecWith ((), Application) +list_current_DELETE appContext = + describe "DELETE /wizard-api/projects/{projectUuid}/migrations/current" $ do + test_204 appContext + test_401 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodDelete + +reqUrlT projectUuid = BS.pack $ "/wizard-api/projects/" ++ U.toString projectUuid ++ "/migrations/current" + +reqHeadersT authHeader = [authHeader] + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_204 appContext = + it "HTTP 204 NO CONTENT" $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT $ project4Upgraded.uuid + let reqHeaders = reqHeadersT reqAuthHeader + -- AND: Prepare expectation + let expStatus = 204 + let expBody = "" + let expHeaders = resCorsHeaders + -- AND: Prepare database + runInContextIO TML.runMigration appContext + runInContextIO (insertProject project4) appContext + runInContextIO (insertProject project4Upgraded) appContext + runInContextIO (insertProject differentProject) appContext + runInContextIO PRJ_MIG.runMigration appContext + runInContextIO (insertProjectMigration projectMigration) appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + -- AND: Find result in DB and compare with expectation state + assertCountInDB findProjects appContext 1 + assertCountInDB findProjectMigrations appContext 0 + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod (reqUrlT project3.uuid) [] reqBody + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = do + createNoPermissionTest appContext reqMethod (reqUrlT project3.uuid) [] "" "PRJ_PERM" + create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, Private)" appContext project1 "View Project" + create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, VisibleView)" appContext project2 "Migrate Project" + +create_test_403 title appContext project reason = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT $ project.uuid + let reqHeaders = reqHeadersT reqNonAdminAuthHeader + -- AND: Prepare expectation + let expStatus = 403 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN reason + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + let ms = projectMigration {oldProjectUuid = project.uuid, newProjectUuid = project.uuid} + runInContextIO (insertProjectMigration ms) appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + -- AND: Find result in DB and compare with expectation state + assertCountInDB findProjects appContext 3 + assertCountInDB findProjectMigrations appContext 1 + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + (reqUrlT project4.uuid) + (reqHeadersT reqAuthHeader) + reqBody + "project_migration" + [("new_project_uuid", "57250a07-a663-4ff3-ac1f-16530f2c1bfe")] diff --git a/wizard-server/test/Wizard/Specs/API/Project/Migration/List_Current_GET.hs b/wizard-server/test/Wizard/Specs/API/Project/Migration/List_Current_GET.hs new file mode 100644 index 000000000..b951f9499 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Migration/List_Current_GET.hs @@ -0,0 +1,165 @@ +module Wizard.Specs.API.Project.Migration.List_Current_GET ( + list_current_GET, +) where + +import Data.Aeson (encode) +import qualified Data.ByteString.Char8 as BS +import qualified Data.UUID as U +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectEventDAO +import Wizard.Database.DAO.Project.ProjectMigrationDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.ProjectMigrations +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ +import qualified Wizard.Database.Migration.Development.Project.ProjectMigrationMigration as PRJ_MIG +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Migration.ProjectMigration +import Wizard.Model.Project.Project + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- GET /wizard-api/projects/{projectUuid}/migrations/current +-- ------------------------------------------------------------------------ +list_current_GET :: AppContext -> SpecWith ((), Application) +list_current_GET appContext = + describe "GET /wizard-api/projects/{projectUuid}/migrations/current" $ do + test_200 appContext + test_401 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodGet + +reqUrlT projectUuid = BS.pack $ "/wizard-api/projects/" ++ U.toString projectUuid ++ "/migrations/current" + +reqHeadersT authHeader = [authHeader, reqCtHeader] + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = do + create_test_200 + "HTTP 200 OK (Owner, Private)" + appContext + project4 + project4Events + project4Upgraded + project4UpgradedEvents + projectMigration + projectMigrationDto + reqNonAdminAuthHeader + create_test_200 + "HTTP 200 OK (Non-Owner, VisibleView)" + appContext + project4VisibleView + project4VisibleViewEvents + project4VisibleViewUpgraded + project4VisibleViewUpgradedEvents + projectMigration + projectMigrationVisibleViewDto + reqNonAdminAuthHeader + create_test_200 + "HTTP 200 OK (Non-Owner, Public)" + appContext + project4VisibleEdit + project4VisibleEditEvents + project4VisibleEditUpgraded + project4VisibleEditUpgradedEvents + projectMigration + projectMigrationVisibleEditDto + reqNonAdminAuthHeader + +create_test_200 title appContext oldProject oldProjectEvents newProject newProjectEvents state stateDto authHeader = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT $ project4Upgraded.uuid + let reqHeaders = reqHeadersT reqAuthHeader + -- AND: Prepare expectation + let expStatus = 200 + let expDto = stateDto + let expBody = encode expDto + let expHeaders = resCtHeader : resCorsHeaders + -- AND: Prepare database + runInContextIO TML.runMigration appContext + runInContextIO (insertProject oldProject) appContext + runInContextIO (insertProjectEvents oldProjectEvents) appContext + runInContextIO (insertProject newProject) appContext + runInContextIO (insertProjectEvents newProjectEvents) appContext + runInContextIO (insertProject differentProject) appContext + runInContextIO (insertProjectEvents differentProjectEvents) appContext + runInContextIO PRJ_MIG.runMigration appContext + runInContextIO (insertProjectMigration state) appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod (reqUrlT project4.uuid) [] reqBody + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = do + createNoPermissionTest appContext reqMethod (reqUrlT project3.uuid) [] "" "PRJ_PERM" + create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, Private)" appContext project1 "View Project" + create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, VisibleView)" appContext project2 "Migrate Project" + +create_test_403 title appContext project reason = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT $ project.uuid + let reqHeaders = reqHeadersT reqNonAdminAuthHeader + -- AND: Prepare expectation + let expStatus = 403 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN reason + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + let ms = projectMigration {oldProjectUuid = project.uuid, newProjectUuid = project.uuid} + runInContextIO (insertProjectMigration ms) appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + (reqUrlT project4.uuid) + (reqHeadersT reqAuthHeader) + reqBody + "project_migration" + [("new_project_uuid", "57250a07-a663-4ff3-ac1f-16530f2c1bfe")] diff --git a/wizard-server/test/Wizard/Specs/API/Project/Migration/List_Current_PUT.hs b/wizard-server/test/Wizard/Specs/API/Project/Migration/List_Current_PUT.hs new file mode 100644 index 000000000..fa53318b7 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Migration/List_Current_PUT.hs @@ -0,0 +1,141 @@ +module Wizard.Specs.API.Project.Migration.List_Current_PUT ( + list_current_PUT, +) where + +import Data.Aeson (encode) +import qualified Data.ByteString.Char8 as BS +import qualified Data.UUID as U +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectEventDAO +import Wizard.Database.DAO.Project.ProjectMigrationDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.ProjectMigrations +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ +import qualified Wizard.Database.Migration.Development.Project.ProjectMigrationMigration as PRJ_MIG +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Migration.ProjectMigration +import Wizard.Model.Project.Project + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- PUT /wizard-api/projects/{projectUuid}/migrations/current +-- ------------------------------------------------------------------------ +list_current_PUT :: AppContext -> SpecWith ((), Application) +list_current_PUT appContext = + describe "PUT /wizard-api/projects/{projectUuid}/migrations/current" $ do + test_204 appContext + test_400 appContext + test_401 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodPut + +reqUrlT projectUuid = BS.pack $ "/wizard-api/projects/" ++ U.toString projectUuid ++ "/migrations/current" + +reqHeadersT authHeader = [authHeader, reqCtHeader] + +reqDto = projectMigrationChangeDto + +reqBody = encode reqDto + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_204 appContext = + it "HTTP 204 NO CONTENT" $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT $ project4Upgraded.uuid + let reqHeaders = reqHeadersT reqAuthHeader + -- AND: Prepare expectation + let expStatus = 200 + let expDto = projectMigrationDtoEdited + let expBody = encode expDto + let expHeaders = resCtHeader : resCorsHeaders + -- AND: Prepare database + runInContextIO TML.runMigration appContext + runInContextIO (insertProject project4) appContext + runInContextIO (insertProjectEvents project4Events) appContext + runInContextIO (insertProject project4Upgraded) appContext + runInContextIO (insertProjectEvents project4UpgradedEvents) appContext + runInContextIO (insertProject differentProject) appContext + runInContextIO (insertProjectEvents differentProjectEvents) appContext + runInContextIO PRJ_MIG.runMigration appContext + runInContextIO (insertProjectMigration projectMigration) appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_400 appContext = createInvalidJsonTest reqMethod (reqUrlT project4.uuid) "resolvedQuestionUuids" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod (reqUrlT project4.uuid) [reqCtHeader] reqBody + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = do + createNoPermissionTest appContext reqMethod (reqUrlT project3.uuid) [reqCtHeader] reqBody "PRJ_PERM" + create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, Private)" appContext project1 "View Project" + create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, VisibleView)" appContext project2 "Migrate Project" + +create_test_403 title appContext project reason = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT $ project.uuid + let reqHeaders = reqHeadersT reqNonAdminAuthHeader + -- AND: Prepare expectation + let expStatus = 403 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN reason + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + let ms = projectMigration {oldProjectUuid = project.uuid, newProjectUuid = project.uuid} + runInContextIO (insertProjectMigration ms) appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + (reqUrlT project4.uuid) + (reqHeadersT reqAuthHeader) + reqBody + "project_migration" + [("new_project_uuid", "57250a07-a663-4ff3-ac1f-16530f2c1bfe")] diff --git a/wizard-server/test/Wizard/Specs/API/Project/Migration/List_POST.hs b/wizard-server/test/Wizard/Specs/API/Project/Migration/List_POST.hs new file mode 100644 index 000000000..15d38ed0e --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Migration/List_POST.hs @@ -0,0 +1,183 @@ +module Wizard.Specs.API.Project.Migration.List_POST ( + list_POST, +) where + +import Data.Aeson (encode) +import qualified Data.ByteString.Char8 as BS +import qualified Data.UUID as U +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Wizard.Api.Resource.Project.Detail.ProjectDetailQuestionnaireDTO +import Wizard.Api.Resource.Project.Migration.ProjectMigrationDTO +import Wizard.Api.Resource.Project.Migration.ProjectMigrationJM () +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectEventDAO +import Wizard.Database.DAO.Project.ProjectMigrationDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.ProjectMigrations +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ +import qualified Wizard.Database.Migration.Development.Project.ProjectMigrationMigration as PRJ_MIG +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Migration.ProjectMigration +import Wizard.Model.Project.Project + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.API.Project.Migration.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- POST /wizard-api/projects/{projectUuid}/migrations +-- ------------------------------------------------------------------------ +list_POST :: AppContext -> SpecWith ((), Application) +list_POST appContext = + describe "POST /wizard-api/projects/{projectUuid}/migrations" $ do + test_201 appContext + test_400 appContext + test_401 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodPost + +reqUrlT projectUuid = BS.pack $ "/wizard-api/projects/" ++ U.toString projectUuid ++ "/migrations" + +reqHeadersT authHeader = [authHeader, reqCtHeader] + +reqDto = projectMigrationCreateDto + +reqBody = encode reqDto + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_201 appContext = do + create_test_201 + "HTTP 201 CREATED (Owner, Private)" + appContext + project4 + project4Events + project4Upgraded + project4UpgradedEvents + projectMigration + projectMigrationDto + reqNonAdminAuthHeader + create_test_201 + "HTTP 201 CREATED (Non-Owner, VisibleView)" + appContext + project4VisibleView + project4VisibleViewEvents + project4VisibleViewUpgraded + project4VisibleViewUpgradedEvents + projectMigration + projectMigrationVisibleViewDto + reqNonAdminAuthHeader + create_test_201 + "HTTP 201 CREATED (Non-Owner, Public)" + appContext + project4VisibleEdit + project4VisibleEditEvents + project4VisibleEditUpgraded + project4VisibleEditUpgradedEvents + projectMigration + projectMigrationVisibleEditDto + reqNonAdminAuthHeader + +create_test_201 title appContext oldProject oldProjectEvents newProject newProjectEvents state stateDto authHeader = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT $ oldProject.uuid + let reqHeaders = reqHeadersT reqAuthHeader + -- AND: Prepare expectation + let expStatus = 201 + let expHeaders = resCorsHeadersPlain + let expDto = stateDto {resolvedQuestionUuids = []} :: ProjectMigrationDTO + let expBody = encode expDto + -- AND: Prepare database + runInContextIO TML.runMigration appContext + runInContextIO (insertProject oldProject) appContext + runInContextIO (insertProjectEvents oldProjectEvents) appContext + runInContextIO (insertProject newProject) appContext + runInContextIO (insertProjectEvents newProjectEvents) appContext + runInContextIO (insertProject differentProject) appContext + runInContextIO (insertProjectEvents differentProjectEvents) appContext + runInContextIO PRJ_MIG.runMigration appContext + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let (status, headers, resBody) = destructResponse response :: (Int, ResponseHeaders, ProjectMigrationDTO) + assertResStatus status expStatus + assertResHeaders headers expHeaders + compareProjectMigratorDtos resBody expDto + -- AND: Find a result in DB + let entityInDB = + state + { newProjectUuid = resBody.newProject.uuid + , resolvedQuestionUuids = [] + } + assertExistenceOfMigrationStateInDB appContext entityInDB + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_400 appContext = createInvalidJsonTest reqMethod (reqUrlT project4.uuid) "targetKnowledgeModelPackageId" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod (reqUrlT project4.uuid) [reqCtHeader] reqBody + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = do + createNoPermissionTest appContext reqMethod (reqUrlT project3.uuid) [reqCtHeader] reqBody "PRJ_PERM" + create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, Private)" appContext project1 "Migrate Project" + create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, VisibleView)" appContext project2 "Migrate Project" + +create_test_403 title appContext project reason = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT $ project.uuid + let reqHeaders = reqHeadersT reqNonAdminAuthHeader + -- AND: Prepare expectation + let expStatus = 403 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN reason + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + -- AND: Find result in DB and compare with expectation state + assertCountInDB findProjectMigrations appContext 0 + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + (reqUrlT project4.uuid) + (reqHeadersT reqAuthHeader) + reqBody + "project" + [("uuid", "57250a07-a663-4ff3-ac1f-16530f2c1bfe")] diff --git a/wizard-server/test/Wizard/Specs/API/Project/ProjectTag/APISpec.hs b/wizard-server/test/Wizard/Specs/API/Project/ProjectTag/APISpec.hs new file mode 100644 index 000000000..d3156299e --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/ProjectTag/APISpec.hs @@ -0,0 +1,9 @@ +module Wizard.Specs.API.Project.ProjectTag.APISpec where + +import Test.Hspec + +import Wizard.Specs.API.Project.ProjectTag.List_Suggestions_GET + +projectTagAPI appContext = + describe "PROJECT TAG API Spec" $ + do list_suggestions_GET appContext diff --git a/wizard-server/test/Wizard/Specs/API/Project/ProjectTag/List_Suggestions_GET.hs b/wizard-server/test/Wizard/Specs/API/Project/ProjectTag/List_Suggestions_GET.hs new file mode 100644 index 000000000..068aef087 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/ProjectTag/List_Suggestions_GET.hs @@ -0,0 +1,102 @@ +module Wizard.Specs.API.Project.ProjectTag.List_Suggestions_GET ( + list_suggestions_GET, +) where + +import Data.Aeson (encode) +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.PageMetadata +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ_Migration +import Wizard.Database.Migration.Development.Tenant.Data.TenantConfigs +import Wizard.Model.Context.AppContext + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- GET /wizard-api/projects/project-tags/suggestions +-- ------------------------------------------------------------------------ +list_suggestions_GET :: AppContext -> SpecWith ((), Application) +list_suggestions_GET appContext = + describe "GET /wizard-api/projects/project-tags/suggestions" $ do + test_200 appContext + test_401 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodGet + +reqUrl = "/wizard-api/projects/project-tags/suggestions" + +reqHeaders = [reqAuthHeader] + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = do + create_test_200 + "HTTP 200 OK (All)" + appContext + "/wizard-api/projects/project-tags/suggestions?sort=projectTag,asc" + ( Page + "projectTags" + (PageMetadata 20 4 1 0) + [_PROJECT_TAG_1, _PROJECT_TAG_2, _SETTINGS__PROJECT_TAG_1, _SETTINGS__PROJECT_TAG_2] + ) + create_test_200 + "HTTP 200 OK (pagination)" + appContext + "/wizard-api/projects/project-tags/suggestions?sort=projectTag,asc&page=1&size=1" + (Page "projectTags" (PageMetadata 1 4 4 1) [_PROJECT_TAG_2]) + create_test_200 + "HTTP 200 OK (query)" + appContext + "/wizard-api/projects/project-tags/suggestions?sort=projectTag,asc&q=settingsProject" + (Page "projectTags" (PageMetadata 20 2 1 0) [_SETTINGS__PROJECT_TAG_1, _SETTINGS__PROJECT_TAG_2]) + create_test_200 + "HTTP 200 OK (exclude)" + appContext + "/wizard-api/projects/project-tags/suggestions?sort=projectTag,asc&exclude=settingsProjectTag2" + ( Page + "projectTags" + (PageMetadata 20 3 1 0) + [_PROJECT_TAG_1, _PROJECT_TAG_2, _SETTINGS__PROJECT_TAG_1] + ) + create_test_200 + "HTTP 200 OK (query, exclude)" + appContext + "/wizard-api/projects/project-tags/suggestions?sort=projectTag,asc&q=settings&exclude=settingsProjectTag2" + (Page "projectTags" (PageMetadata 20 1 1 0) [_SETTINGS__PROJECT_TAG_1]) + +create_test_200 title appContext reqUrl expDto = + it title $ + -- GIVEN: Prepare request + do + let expStatus = 200 + let expHeaders = resCtHeader : resCorsHeaders + let expBody = encode expDto + -- AND: Run migrations + runInContextIO TML_Migration.runMigration appContext + runInContextIO PRJ_Migration.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- AND: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod reqUrl [] reqBody diff --git a/wizard-server/test/Wizard/Specs/API/Project/User/APISpec.hs b/wizard-server/test/Wizard/Specs/API/Project/User/APISpec.hs new file mode 100644 index 000000000..4867ed3c3 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/User/APISpec.hs @@ -0,0 +1,9 @@ +module Wizard.Specs.API.Project.User.APISpec where + +import Test.Hspec + +import Wizard.Specs.API.Project.User.List_Suggestions_GET + +projectUserAPI appContext = + describe "PROJECT USER API Spec" $ + list_suggestions_GET appContext diff --git a/wizard-server/test/Wizard/Specs/API/Project/User/List_Suggestions_GET.hs b/wizard-server/test/Wizard/Specs/API/Project/User/List_Suggestions_GET.hs new file mode 100644 index 000000000..c9c8e5c0f --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/User/List_Suggestions_GET.hs @@ -0,0 +1,191 @@ +module Wizard.Specs.API.Project.User.List_Suggestions_GET ( + list_suggestions_GET, +) where + +import Data.Aeson (encode) +import qualified Data.ByteString.Char8 as BS +import Data.Foldable (traverse_) +import qualified Data.UUID as U +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.PageMetadata +import Shared.Common.Model.Error.Error +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Database.DAO.Project.ProjectDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Database.Migration.Development.User.Data.Users +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Project +import Wizard.Service.User.UserMapper +import WizardLib.Public.Localization.Messages.Public + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- GET /wizard-api/projects/{projectUuid}/users/suggestions +-- ------------------------------------------------------------------------ +list_suggestions_GET :: AppContext -> SpecWith ((), Application) +list_suggestions_GET appContext = + describe "GET /wizard-api/projects/{projectUuid}/users/suggestions" $ do + test_200 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodGet + +reqUrlT projectUuid query = BS.pack $ "/wizard-api/projects/" ++ U.toString projectUuid ++ "/users/suggestions?sort=uuid,asc" ++ query + +reqHeadersT authHeader = authHeader + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = do + create_test_200 + "HTTP 200 OK (Owner, Private)" + appContext + project1 + [reqAuthHeader] + (Page "users" (PageMetadata 20 1 1 0) (fmap (toSuggestion . toSimple) [userAlbert])) + create_test_200 + "HTTP 200 OK (Commenter)" + appContext + (project13 {visibility = PrivateProjectVisibility}) + [reqNonAdminAuthHeader] + (Page "users" (PageMetadata 20 1 1 0) (fmap (toSuggestion . toSimple) [userNikola])) + create_test_200 + "HTTP 200 OK (Non-Commenter, VisibleComment)" + appContext + project13 + [reqIsaacAuthTokenHeader] + (Page "users" (PageMetadata 20 3 1 0) (fmap (toSuggestion . toSimple) [userNikola, userIsaac, userAlbert])) + create_test_200 + "HTTP 200 OK (Anonymous, VisibleComment, AnyoneWithLinkComment)" + appContext + (project13 {sharing = AnyoneWithLinkCommentProjectSharing}) + [] + (Page "users" (PageMetadata 20 3 1 0) (fmap (toSuggestion . toSimple) [userNikola, userIsaac, userAlbert])) + create_test_200 + "HTTP 200 OK (Non-Owner, VisibleEdit)" + appContext + project3 + [reqNonAdminAuthHeader] + (Page "users" (PageMetadata 20 3 1 0) (fmap (toSuggestion . toSimple) [userNikola, userIsaac, userAlbert])) + create_test_200 + "HTTP 200 OK (Anonymous, Public, Sharing)" + appContext + project10 + [] + (Page "users" (PageMetadata 20 3 1 0) (fmap (toSuggestion . toSimple) [userNikola, userIsaac, userAlbert])) + +create_test_200 title appContext project authHeader expDto = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT project.uuid "" + let reqHeaders = reqHeadersT authHeader + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO (insertPackage germanyKmPackage) appContext + runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext + runInContextIO (insertProject project) appContext + -- AND: Prepare expectation + let expStatus = 200 + let expHeaders = resCtHeader : resCorsHeaders + let expBody = encode expDto + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = do + create_test_403 + "HTTP 403 FORBIDDEN (Non-Owner, Private)" + appContext + project1 + [reqNonAdminAuthHeader] + (_ERROR_VALIDATION__FORBIDDEN "Comment Project") + create_test_403 + "HTTP 200 OK (Non-Owner, VisibleView)" + appContext + project2 + [reqNonAdminAuthHeader] + (_ERROR_VALIDATION__FORBIDDEN "Comment Project") + create_test_403 + "HTTP 403 FORBIDDEN (Anonymous, VisibleView)" + appContext + project2 + [] + _ERROR_SERVICE_USER__MISSING_USER + create_test_403 + "HTTP 200 OK (Anonymous, VisibleView, Sharing)" + appContext + project7 + [] + _ERROR_SERVICE_USER__MISSING_USER + create_test_403 + "HTTP 403 FORBIDDEN (Anonymous, Public)" + appContext + project3 + [] + _ERROR_SERVICE_USER__MISSING_USER + +create_test_403 title appContext project authHeader errorMessage = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT project.uuid "" + let reqHeaders = reqHeadersT authHeader + -- AND: Prepare expectation + let expStatus = 403 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = ForbiddenError errorMessage + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO (insertPackage germanyKmPackage) appContext + runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext + runInContextIO (insertProject project) appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + "/wizard-api/projects/f08ead5f-746d-411b-aee6-77ea3d24016a/users/suggestions" + [reqHeadersT reqAuthHeader] + reqBody + "project" + [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Project/Version/APISpec.hs b/wizard-server/test/Wizard/Specs/API/Project/Version/APISpec.hs new file mode 100644 index 000000000..7a19ed88e --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Version/APISpec.hs @@ -0,0 +1,15 @@ +module Wizard.Specs.API.Project.Version.APISpec where + +import Test.Hspec + +import Wizard.Specs.API.Project.Version.Detail_DELETE +import Wizard.Specs.API.Project.Version.Detail_PUT +import Wizard.Specs.API.Project.Version.List_GET +import Wizard.Specs.API.Project.Version.List_POST + +projectVersionAPI appContext = + describe "PROJECT VERSION API Spec" $ do + list_GET appContext + list_POST appContext + detail_PUT appContext + detail_DELETE appContext diff --git a/wizard-server/test/Wizard/Specs/API/Project/Version/Common.hs b/wizard-server/test/Wizard/Specs/API/Project/Version/Common.hs new file mode 100644 index 000000000..78aad764e --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Version/Common.hs @@ -0,0 +1,40 @@ +module Wizard.Specs.API.Project.Version.Common where + +import Data.Either (isLeft, isRight) +import qualified Data.UUID as U +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) + +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Wizard.Database.DAO.Project.ProjectVersionDAO +import Wizard.Database.Migration.Development.Tenant.Data.Tenants +import Wizard.Model.Project.Version.ProjectVersion +import Wizard.Model.Tenant.Tenant + +import Wizard.Specs.Common + +-- -------------------------------- +-- ASSERTS +-- -------------------------------- +assertExistenceOfProjectVersionInDB appContext version = do + eVersion <- runInContextIO (findProjectVersionByUuid version.uuid) appContext + liftIO $ isRight eVersion `shouldBe` True + let (Right versionFromDb) = eVersion + compareProjectVersionCreateDtos versionFromDb version + +assertAbsenceOfProjectVersionInDB appContext version = do + eVersion <- runInContextIO (findProjectVersionByUuid version.uuid) appContext + liftIO $ isLeft eVersion `shouldBe` True + let (Left error) = eVersion + liftIO $ + error + `shouldBe` NotExistsError + (_ERROR_DATABASE__ENTITY_NOT_FOUND "project_version" [("tenant_uuid", U.toString defaultTenant.uuid), ("uuid", U.toString version.uuid)]) + +-- -------------------------------- +-- COMPARATORS +-- -------------------------------- +compareProjectVersionCreateDtos resDto expDto = do + liftIO $ resDto.name `shouldBe` expDto.name + liftIO $ resDto.eventUuid `shouldBe` expDto.eventUuid diff --git a/wizard-server/test/Wizard/Specs/API/Project/Version/Detail_DELETE.hs b/wizard-server/test/Wizard/Specs/API/Project/Version/Detail_DELETE.hs new file mode 100644 index 000000000..e25f44636 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Version/Detail_DELETE.hs @@ -0,0 +1,82 @@ +module Wizard.Specs.API.Project.Version.Detail_DELETE ( + detail_DELETE, +) where + +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Api.Resource.Error.ErrorJM () +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.ProjectVersions +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Version.ProjectVersion + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.API.Project.Version.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- DELETE /wizard-api/projects/{projectUuid}/versions/{vUuid} +-- ------------------------------------------------------------------------ +detail_DELETE :: AppContext -> SpecWith ((), Application) +detail_DELETE appContext = + describe "DELETE /wizard-api/projects/{projectUuid}/versions/{vUuid}" $ do + test_204 appContext + test_401 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodDelete + +reqUrl = "/wizard-api/projects/af984a75-56e3-49f8-b16f-d6b99599910a/versions/af984a75-56e3-49f8-b16f-dd016270ce7e" + +reqHeaders = [reqAuthHeader, reqCtHeader] + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_204 appContext = + it "HTTP 204 NO CONTENT" $ + -- GIVEN: Prepare expectation + do + let expStatus = 204 + let expHeaders = resCtHeader : resCorsHeaders + let expBody = "" + -- AND: Run migrations + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + -- AND: Find a result in DB + assertAbsenceOfProjectVersionInDB appContext (projectVersion1 project1Uuid) + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod reqUrl [] reqBody + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + "/wizard-api/projects/00084a75-56e3-49f8-b16f-d6b99599910a/versions/00084a75-56e3-49f8-b16f-dd016270ce7e" + reqHeaders + reqBody + "project" + [("uuid", "00084a75-56e3-49f8-b16f-d6b99599910a")] diff --git a/wizard-server/test/Wizard/Specs/API/Project/Version/Detail_PUT.hs b/wizard-server/test/Wizard/Specs/API/Project/Version/Detail_PUT.hs new file mode 100644 index 000000000..0fa976399 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Version/Detail_PUT.hs @@ -0,0 +1,93 @@ +module Wizard.Specs.API.Project.Version.Detail_PUT ( + detail_PUT, +) where + +import Data.Aeson (encode) +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) + +import Shared.Common.Api.Resource.Error.ErrorJM () +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.ProjectVersions +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Version.ProjectVersion +import Wizard.Model.Project.Version.ProjectVersionList + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.API.Project.Version.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- PUT /wizard-api/projects/{projectUuid}/versions/{vUuid} +-- ------------------------------------------------------------------------ +detail_PUT :: AppContext -> SpecWith ((), Application) +detail_PUT appContext = + describe "PUT /wizard-api/projects/{projectUuid}/versions/{vUuid}" $ do + test_200 appContext + test_400 appContext + test_401 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodPut + +reqUrl = "/wizard-api/projects/af984a75-56e3-49f8-b16f-d6b99599910a/versions/af984a75-56e3-49f8-b16f-dd016270ce7e" + +reqHeaders = [reqAuthHeader, reqCtHeader] + +reqDto = projectVersion1EditedChangeDto project1Uuid + +reqBody = encode reqDto + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = + it "HTTP 20O OK" $ + -- GIVEN: Prepare expectation + do + let expStatus = 200 + let expHeaders = resCtHeaderPlain : resCorsHeadersPlain + let expDto = projectVersion1EditedList project1Uuid + let expBody = encode expDto + -- AND: Run migrations + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let (status, headers, resBody) = destructResponse response :: (Int, ResponseHeaders, ProjectVersionList) + assertResStatus status expStatus + assertResHeaders headers expHeaders + compareProjectVersionCreateDtos resBody expDto + -- AND: Find a result in DB + assertExistenceOfProjectVersionInDB appContext (projectVersion1Edited project1Uuid) + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_400 appContext = createInvalidJsonTest reqMethod reqUrl "name" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod reqUrl [reqCtHeader] reqBody + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + "/wizard-api/projects/00084a75-56e3-49f8-b16f-d6b99599910a/versions/bd6611c8-ea11-48ab-adaa-3ce51b66aae5" + reqHeaders + reqBody + "project" + [("uuid", "00084a75-56e3-49f8-b16f-d6b99599910a")] diff --git a/wizard-server/test/Wizard/Specs/API/Project/Version/List_GET.hs b/wizard-server/test/Wizard/Specs/API/Project/Version/List_GET.hs new file mode 100644 index 000000000..02a511a32 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Version/List_GET.hs @@ -0,0 +1,172 @@ +module Wizard.Specs.API.Project.Version.List_GET ( + list_GET, +) where + +import Data.Aeson (encode) +import qualified Data.ByteString.Char8 as BS +import Data.Foldable (traverse_) +import qualified Data.UUID as U +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectEventDAO +import Wizard.Database.DAO.Project.ProjectVersionDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.ProjectVersions +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Project +import WizardLib.Public.Localization.Messages.Public + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- GET /wizard-api/projects/{projectUuid}/versions +-- ------------------------------------------------------------------------ +list_GET :: AppContext -> SpecWith ((), Application) +list_GET appContext = + describe "GET /wizard-api/projects/{projectUuid}/versions" $ do + test_200 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodGet + +reqUrlT projectUuid = BS.pack $ "/wizard-api/projects/" ++ U.toString projectUuid ++ "/versions" + +reqHeadersT authHeader = authHeader + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = do + create_test_200 + "HTTP 200 OK (Owner, Private)" + appContext + project1 + project1Ctn + [reqAuthHeader] + [project1AlbertEditProjectPermDto] + create_test_200 + "HTTP 200 OK (Non-Owner, VisibleView)" + appContext + project2 + project2Ctn + [reqNonAdminAuthHeader] + [project1AlbertEditProjectPermDto] + create_test_200 + "HTTP 200 OK (Anonymous, VisibleView, Sharing)" + appContext + project7 + project7Ctn + [] + [project1AlbertEditProjectPermDto] + create_test_200 + "HTTP 200 OK (Non-Owner, VisibleEdit)" + appContext + project3 + project3Ctn + [reqNonAdminAuthHeader] + [] + create_test_200 "HTTP 200 OK (Anonymous, Public, Sharing)" appContext project10 project10Ctn [] [] + +create_test_200 title appContext project projectContent authHeader permissions = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT project.uuid + let reqHeaders = reqHeadersT authHeader + -- AND: Prepare expectation + let expStatus = 200 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = qVersionsList project.uuid + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + runInContextIO (insertProject project7) appContext + runInContextIO (insertProjectEvents project7Events) appContext + runInContextIO (traverse_ insertProjectVersion project7Versions) appContext + runInContextIO (insertProject project10) appContext + runInContextIO (insertProjectEvents project10Events) appContext + runInContextIO (traverse_ insertProjectVersion project10Versions) appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = do + create_test_403 + "HTTP 403 FORBIDDEN (Non-Owner, Private)" + appContext + project1 + [reqNonAdminAuthHeader] + (_ERROR_VALIDATION__FORBIDDEN "View Project") + create_test_403 + "HTTP 403 FORBIDDEN (Anonymous, VisibleView)" + appContext + project2 + [] + _ERROR_SERVICE_USER__MISSING_USER + create_test_403 + "HTTP 403 FORBIDDEN (Anonymous, Public)" + appContext + project3 + [] + _ERROR_SERVICE_USER__MISSING_USER + +create_test_403 title appContext project authHeader errorMessage = + it title $ + -- GIVEN: Prepare request + do + let reqUrl = reqUrlT project.uuid + let reqHeaders = reqHeadersT authHeader + -- AND: Prepare expectation + let expStatus = 403 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = ForbiddenError errorMessage + let expBody = encode expDto + -- AND: Run migrations + runInContextIO U.runMigration appContext + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + "/wizard-api/projects/f08ead5f-746d-411b-aee6-77ea3d24016a/versions" + [reqHeadersT reqAuthHeader] + reqBody + "project" + [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Project/Version/List_POST.hs b/wizard-server/test/Wizard/Specs/API/Project/Version/List_POST.hs new file mode 100644 index 000000000..96b145753 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/Project/Version/List_POST.hs @@ -0,0 +1,80 @@ +module Wizard.Specs.API.Project.Version.List_POST ( + list_POST, +) where + +import Data.Aeson (encode) +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) + +import Shared.Common.Api.Resource.Error.ErrorJM () +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML +import Wizard.Database.Migration.Development.Project.Data.ProjectVersions +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Version.ProjectVersion +import Wizard.Model.Project.Version.ProjectVersionList + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.API.Project.Version.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- POST /wizard-api/projects/{projectUuid}/versions +-- ------------------------------------------------------------------------ +list_POST :: AppContext -> SpecWith ((), Application) +list_POST appContext = + describe "POST /wizard-api/projects/{projectUuid}/versions" $ do + test_201 appContext + test_400 appContext + test_401 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodPost + +reqUrl = "/wizard-api/projects/af984a75-56e3-49f8-b16f-d6b99599910a/versions" + +reqHeaders = [reqAuthHeader, reqCtHeader] + +reqDto = projectVersion2ChangeDto project1Uuid + +reqBody = encode reqDto + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_201 appContext = + it "HTTP 201 CREATED" $ + -- GIVEN: Prepare expectation + do + let expStatus = 201 + let expHeaders = resCtHeaderPlain : resCorsHeadersPlain + let expDto = projectVersion2 project1Uuid + let expBody = encode expDto + -- AND: Run migrations + runInContextIO TML.runMigration appContext + runInContextIO PRJ.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let (status, headers, resBody) = destructResponse response :: (Int, ResponseHeaders, ProjectVersionList) + assertResStatus status expStatus + assertResHeaders headers expHeaders + compareProjectVersionCreateDtos resBody expDto + -- AND: Find a result in DB + assertExistenceOfProjectVersionInDB appContext ((projectVersion2 project1Uuid) {uuid = resBody.uuid} :: ProjectVersion) + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_400 appContext = createInvalidJsonTest reqMethod reqUrl "name" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod reqUrl [reqCtHeader] reqBody diff --git a/wizard-server/test/Wizard/Specs/API/ProjectAction/APISpec.hs b/wizard-server/test/Wizard/Specs/API/ProjectAction/APISpec.hs new file mode 100644 index 000000000..3aa9eda6b --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/ProjectAction/APISpec.hs @@ -0,0 +1,18 @@ +module Wizard.Specs.API.ProjectAction.APISpec where + +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) + +import Wizard.Specs.API.Common +import Wizard.Specs.API.ProjectAction.Detail_GET +import Wizard.Specs.API.ProjectAction.Detail_PUT +import Wizard.Specs.API.ProjectAction.List_GET +import Wizard.Specs.API.ProjectAction.List_Suggestions_GET + +projectActionAPI baseContext appContext = + with (startWebApp baseContext appContext) $ + describe "PROJECT ACTION API Spec" $ do + list_GET appContext + list_suggestions_GET appContext + detail_GET appContext + detail_PUT appContext diff --git a/wizard-server/test/Wizard/Specs/API/ProjectAction/Common.hs b/wizard-server/test/Wizard/Specs/API/ProjectAction/Common.hs new file mode 100644 index 000000000..45c471a5e --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/ProjectAction/Common.hs @@ -0,0 +1,27 @@ +module Wizard.Specs.API.ProjectAction.Common where + +import Data.Either (isRight) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Wizard.Database.DAO.Project.ProjectActionDAO +import Wizard.Model.Project.Action.ProjectAction + +import Wizard.Specs.Common + +-- -------------------------------- +-- ASSERTS +-- -------------------------------- +assertExistenceOfProjectActionInDB appContext action = do + eProjectAction <- runInContextIO (findProjectActionById action.paId) appContext + liftIO $ isRight eProjectAction `shouldBe` True + let (Right actionFromDB) = eProjectAction + compareProjectActionDtos actionFromDB action + +-- -------------------------------- +-- COMPARATORS +-- -------------------------------- +compareProjectActionDtos resDto expDto = do + liftIO $ resDto.name `shouldBe` expDto.name + liftIO $ resDto.enabled `shouldBe` expDto.enabled diff --git a/wizard-server/test/Wizard/Specs/API/ProjectAction/Detail_GET.hs b/wizard-server/test/Wizard/Specs/API/ProjectAction/Detail_GET.hs new file mode 100644 index 000000000..013590cb6 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/ProjectAction/Detail_GET.hs @@ -0,0 +1,86 @@ +module Wizard.Specs.API.ProjectAction.Detail_GET ( + detail_GET, +) where + +import Data.Aeson (encode) +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Wizard.Database.Migration.Development.Project.Data.ProjectActions +import qualified Wizard.Database.Migration.Development.Project.ProjectActionMigration as ProjectAction_Migration +import Wizard.Model.Context.AppContext +import Wizard.Service.Project.Action.ProjectActionMapper + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- GET /wizard-api/project-actions/{id} +-- ------------------------------------------------------------------------ +detail_GET :: AppContext -> SpecWith ((), Application) +detail_GET appContext = + describe "GET /wizard-api/project-actions/{id}" $ do + test_200 appContext + test_401 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodGet + +reqUrl = "/wizard-api/project-actions/global:project-action-ftp:3.0.0" + +reqHeadersT reqAuthHeader = [reqCtHeader, reqAuthHeader] + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = create_test_200 "HTTP 200 OK" appContext reqAuthHeader + +create_test_200 title appContext reqAuthHeader = + it title $ + -- GIVEN: Prepare request + do + let reqHeaders = reqHeadersT reqAuthHeader + -- AND: Prepare expectation + let expStatus = 200 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = toDTO projectActionFtp3 + let expBody = encode expDto + -- AND: Run migrations + runInContextIO ProjectAction_Migration.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod reqUrl [reqCtHeader] reqBody + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [reqCtHeader] reqBody "PRJ_PERM" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + "/wizard-api/project-actions/deab6c38-aeac-4b17-a501-4365a0a70176" + (reqHeadersT reqAuthHeader) + reqBody + "project_action" + [("id", "deab6c38-aeac-4b17-a501-4365a0a70176")] diff --git a/wizard-server/test/Wizard/Specs/API/ProjectAction/Detail_PUT.hs b/wizard-server/test/Wizard/Specs/API/ProjectAction/Detail_PUT.hs new file mode 100644 index 000000000..f2ecf971d --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/ProjectAction/Detail_PUT.hs @@ -0,0 +1,94 @@ +module Wizard.Specs.API.ProjectAction.Detail_PUT ( + detail_PUT, +) where + +import Data.Aeson (encode) +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) + +import Wizard.Api.Resource.Project.Action.ProjectActionDTO +import Wizard.Api.Resource.Project.Action.ProjectActionJM () +import Wizard.Database.Migration.Development.Project.Data.ProjectActions +import qualified Wizard.Database.Migration.Development.Project.ProjectActionMigration as ProjectAction_Migration +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Action.ProjectAction +import Wizard.Service.Project.Action.ProjectActionMapper + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.API.ProjectAction.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- PUT /wizard-api/project-actions/{id} +-- ------------------------------------------------------------------------ +detail_PUT :: AppContext -> SpecWith ((), Application) +detail_PUT appContext = + describe "PUT /wizard-api/project-actions/{id}" $ do + test_200 appContext + test_401 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodPut + +reqUrl = "/wizard-api/project-actions/global:project-action-ftp:3.0.0" + +reqHeadersT reqAuthHeader = [reqCtHeader, reqAuthHeader] + +reqDto = toChangeDTO projectActionFtp3Edited + +reqBody = encode reqDto + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = create_test_200 "HTTP 200 OK" appContext reqAuthHeader + +create_test_200 title appContext reqAuthHeader = + it title $ + -- GIVEN: Prepare request + do + let reqHeaders = reqHeadersT reqAuthHeader + -- AND: Prepare expectation + let expStatus = 200 + let expHeaders = resCtHeaderPlain : resCorsHeadersPlain + let expDto = toDTO projectActionFtp3Edited + let expBody = encode expDto + let expType (a :: ProjectActionDTO) = a + -- AND: Run migrations + runInContextIO ProjectAction_Migration.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let (status, headers, resDto) = destructResponse response :: (Int, ResponseHeaders, ProjectActionDTO) + assertResponseWithoutFields expStatus expHeaders expDto expType response ["updatedAt"] + -- AND: Find result in DB and compare with expectation state + assertExistenceOfProjectActionInDB appContext projectActionFtp3Edited + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod reqUrl [reqCtHeader] reqBody + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [reqCtHeader] reqBody "PRJ_ACTION_PERM" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + "/wizard-api/project-actions/deab6c38-aeac-4b17-a501-4365a0a70176" + (reqHeadersT reqAuthHeader) + reqBody + "project_action" + [("id", "deab6c38-aeac-4b17-a501-4365a0a70176")] diff --git a/wizard-server/test/Wizard/Specs/API/ProjectAction/List_GET.hs b/wizard-server/test/Wizard/Specs/API/ProjectAction/List_GET.hs new file mode 100644 index 000000000..5b98a33c3 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/ProjectAction/List_GET.hs @@ -0,0 +1,93 @@ +module Wizard.Specs.API.ProjectAction.List_GET ( + list_GET, +) where + +import Data.Aeson (encode) +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.PageMetadata +import Wizard.Database.Migration.Development.Project.Data.ProjectActions +import qualified Wizard.Database.Migration.Development.Project.ProjectActionMigration as ProjectAction_Migration +import Wizard.Model.Context.AppContext +import Wizard.Service.Project.Action.ProjectActionMapper + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- GET /wizard-api/project-actions +-- ------------------------------------------------------------------------ +list_GET :: AppContext -> SpecWith ((), Application) +list_GET appContext = + describe "GET /wizard-api/project-actions" $ do + test_200 appContext + test_401 appContext + test_403 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodGet + +reqUrl = "/wizard-api/project-actions" + +reqHeadersT reqAuthHeader = [reqAuthHeader] + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = do + create_test_200 + "HTTP 200 OK" + appContext + "/wizard-api/project-actions" + reqAuthHeader + (Page "projectActions" (PageMetadata 20 3 1 0) [projectActionFtp3, projectActionMail1, projectActionScp1]) + create_test_200 + "HTTP 200 OK (query 'q')" + appContext + "/wizard-api/project-actions?q=FTP" + reqAuthHeader + (Page "projectActions" (PageMetadata 20 1 1 0) [projectActionFtp3]) + create_test_200 + "HTTP 200 OK (query 'q' for non-existing)" + appContext + "/wizard-api/project-actions?q=Non-existing Project Report" + reqAuthHeader + (Page "projectActions" (PageMetadata 20 0 0 0) []) + +create_test_200 title appContext reqUrl reqAuthHeader expEntities = + it title $ + -- GIVEN: Prepare request + do + let reqHeaders = reqHeadersT reqAuthHeader + -- AND: Prepare expectation + let expStatus = 200 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = fmap toDTO expEntities + let expBody = encode expDto + -- AND: Run migrations + runInContextIO ProjectAction_Migration.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod reqUrl [] reqBody + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [] reqBody "PRJ_PERM" diff --git a/wizard-server/test/Wizard/Specs/API/ProjectAction/List_Suggestions_GET.hs b/wizard-server/test/Wizard/Specs/API/ProjectAction/List_Suggestions_GET.hs new file mode 100644 index 000000000..549ecbb85 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/ProjectAction/List_Suggestions_GET.hs @@ -0,0 +1,103 @@ +module Wizard.Specs.API.ProjectAction.List_Suggestions_GET ( + list_suggestions_GET, +) where + +import Data.Aeson (encode) +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.PageMetadata +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration +import Wizard.Database.Migration.Development.Project.Data.ProjectActions +import qualified Wizard.Database.Migration.Development.Project.ProjectActionMigration as ProjectAction_Migration +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ_Migration +import Wizard.Model.Context.AppContext +import Wizard.Service.Project.Action.ProjectActionMapper + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- GET /wizard-api/project-actions/suggestions +-- ------------------------------------------------------------------------ +list_suggestions_GET :: AppContext -> SpecWith ((), Application) +list_suggestions_GET appContext = + describe "GET /wizard-api/project-actions/suggestions" $ do + test_200 appContext + test_401 appContext + test_403 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodGet + +reqUrl = "/wizard-api/project-actions/suggestions" + +reqHeadersT reqAuthHeader = [reqAuthHeader] + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = do + create_test_200 + "HTTP 200 OK" + appContext + "/wizard-api/project-actions/suggestions?enabled=true" + reqAuthHeader + (Page "projectActions" (PageMetadata 20 2 1 0) [projectActionFtp2, projectActionMail1]) + create_test_200 + "HTTP 200 OK (query 'q')" + appContext + "/wizard-api/project-actions/suggestions?enabled=true&q=FTP" + reqAuthHeader + (Page "projectActions" (PageMetadata 20 1 1 0) [projectActionFtp2]) + create_test_200 + "HTTP 200 OK (query 'q' for non-existing)" + appContext + "/wizard-api/project-actions/suggestions?enabled=true&q=Non-existing Project Report" + reqAuthHeader + (Page "projectActions" (PageMetadata 20 0 0 0) []) + create_test_200 + "HTTP 200 OK (query 'projectUuid')" + appContext + "/wizard-api/project-actions/suggestions?enabled=true&projectUuid=af984a75-56e3-49f8-b16f-d6b99599910a" + reqAuthHeader + (Page "projectActions" (PageMetadata 20 1 1 0) [projectActionFtp2]) + +create_test_200 title appContext reqUrl reqAuthHeader expEntities = + it title $ + -- GIVEN: Prepare request + do + let reqHeaders = reqHeadersT reqAuthHeader + -- AND: Prepare expectation + let expStatus = 200 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = fmap toDTO expEntities + let expBody = encode expDto + -- AND: Run migrations + runInContextIO TML_Migration.runMigration appContext + runInContextIO PRJ_Migration.runMigration appContext + runInContextIO ProjectAction_Migration.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod reqUrl [] reqBody + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [] reqBody "PRJ_PERM" diff --git a/wizard-server/test/Wizard/Specs/API/ProjectCommentThread/APISpec.hs b/wizard-server/test/Wizard/Specs/API/ProjectCommentThread/APISpec.hs new file mode 100644 index 000000000..c5282e3f9 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/ProjectCommentThread/APISpec.hs @@ -0,0 +1,13 @@ +module Wizard.Specs.API.ProjectCommentThread.APISpec where + +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) + +import Wizard.Specs.API.Common + +import Wizard.Specs.API.ProjectCommentThread.List_GET + +projectCommentThreadAPI baseContext appContext = + with (startWebApp baseContext appContext) $ + describe "PROJECT COMMENT THREAD API Spec" $ do + list_GET appContext diff --git a/wizard-server/test/Wizard/Specs/API/ProjectCommentThread/List_GET.hs b/wizard-server/test/Wizard/Specs/API/ProjectCommentThread/List_GET.hs new file mode 100644 index 000000000..4666e6080 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/ProjectCommentThread/List_GET.hs @@ -0,0 +1,104 @@ +module Wizard.Specs.API.ProjectCommentThread.List_GET ( + list_GET, +) where + +import Data.Aeson (encode) +import Data.Foldable (traverse_) +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.PageMetadata +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Database.DAO.Project.ProjectCommentDAO +import Wizard.Database.DAO.Project.ProjectCommentThreadDAO +import Wizard.Database.DAO.Project.ProjectDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration +import Wizard.Database.Migration.Development.Project.Data.ProjectComments +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Database.Migration.Development.User.Data.Users +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Comment.ProjectComment +import Wizard.Model.Project.Comment.ProjectCommentThreadAssigned +import Wizard.Model.Project.Project +import Wizard.Model.User.User + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- GET /wizard-api/project-comment-threads +-- ------------------------------------------------------------------------ +list_GET :: AppContext -> SpecWith ((), Application) +list_GET appContext = + describe "GET /wizard-api/project-comment-threads" $ do + test_200 appContext + test_401 appContext + test_403 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodGet + +reqUrl = "/wizard-api/project-comment-threads?sort=updatedAt,desc" + +reqHeadersT reqAuthHeader = [reqAuthHeader] + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = + it "HTTP 200 OK" $ + -- GIVEN: Prepare request + do + let reqHeaders = reqHeadersT reqAuthHeader + -- AND: Run migrations + runInContextIO TML_Migration.runMigration appContext + runInContextIO (insertPackage germanyKmPackage) appContext + runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext + runInContextIO (insertProject project1) appContext + -- AND: Create thread without assignee + thread1 <- liftIO . create_cmtQ1_t1 $ project1.uuid + comment1_1 <- liftIO . create_cmtQ1_t1_1 $ thread1.uuid + comment1_2 <- liftIO . create_cmtQ1_t1_2 $ thread1.uuid + runInContextIO (insertProjectCommentThread thread1) appContext + runInContextIO (insertProjectComment comment1_1) appContext + runInContextIO (insertProjectComment comment1_2) appContext + -- AND: Create thread with assignee + thread2 <- liftIO . create_cmtQ1_t1 $ project1.uuid + comment2_1 <- liftIO . create_cmtQ1_t1_1 $ thread2.uuid + comment2_2 <- liftIO . create_cmtQ1_t1_2 $ thread2.uuid + runInContextIO (insertProjectCommentThread (thread2 {assignedTo = Just userAlbert.uuid})) appContext + runInContextIO (insertProjectComment comment2_1) appContext + runInContextIO (insertProjectComment comment2_2) appContext + -- AND: Prepare expectation + let expStatus = 200 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = Page "projectCommentThreads" (PageMetadata 20 1 1 0) [cmtAssigned {commentThreadUuid = thread2.uuid}] + let expBody = encode expDto + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod reqUrl [] reqBody + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [] reqBody "PRJ_PERM" diff --git a/wizard-server/test/Wizard/Specs/API/ProjectImporter/APISpec.hs b/wizard-server/test/Wizard/Specs/API/ProjectImporter/APISpec.hs new file mode 100644 index 000000000..3ff8b2bd6 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/ProjectImporter/APISpec.hs @@ -0,0 +1,18 @@ +module Wizard.Specs.API.ProjectImporter.APISpec where + +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) + +import Wizard.Specs.API.Common +import Wizard.Specs.API.ProjectImporter.Detail_GET +import Wizard.Specs.API.ProjectImporter.Detail_PUT +import Wizard.Specs.API.ProjectImporter.List_GET +import Wizard.Specs.API.ProjectImporter.List_Suggestions_GET + +projectImporterAPI baseContext appContext = + with (startWebApp baseContext appContext) $ + describe "PROJECT IMPORTER API Spec" $ do + list_GET appContext + list_suggestions_GET appContext + detail_GET appContext + detail_PUT appContext diff --git a/wizard-server/test/Wizard/Specs/API/ProjectImporter/Common.hs b/wizard-server/test/Wizard/Specs/API/ProjectImporter/Common.hs new file mode 100644 index 000000000..3ed1fbc4c --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/ProjectImporter/Common.hs @@ -0,0 +1,27 @@ +module Wizard.Specs.API.ProjectImporter.Common where + +import Data.Either (isRight) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) + +import Shared.Common.Api.Resource.Error.ErrorJM () +import Wizard.Database.DAO.Project.ProjectImporterDAO +import Wizard.Model.Project.Importer.ProjectImporter + +import Wizard.Specs.Common + +-- -------------------------------- +-- ASSERTS +-- -------------------------------- +assertExistenceOfProjectImporterInDB appContext importer = do + eProjectImporter <- runInContextIO (findProjectImporterById importer.piId) appContext + liftIO $ isRight eProjectImporter `shouldBe` True + let (Right importerFromDB) = eProjectImporter + compareProjectImporterDtos importerFromDB importer + +-- -------------------------------- +-- COMPARATORS +-- -------------------------------- +compareProjectImporterDtos resDto expDto = do + liftIO $ resDto.name `shouldBe` expDto.name + liftIO $ resDto.enabled `shouldBe` expDto.enabled diff --git a/wizard-server/test/Wizard/Specs/API/ProjectImporter/Detail_GET.hs b/wizard-server/test/Wizard/Specs/API/ProjectImporter/Detail_GET.hs new file mode 100644 index 000000000..1155c8b8c --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/ProjectImporter/Detail_GET.hs @@ -0,0 +1,87 @@ +module Wizard.Specs.API.ProjectImporter.Detail_GET ( + detail_GET, +) where + +import Data.Aeson (encode) +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Wizard.Database.Migration.Development.Project.Data.ProjectImporters +import qualified Wizard.Database.Migration.Development.Project.ProjectImporterMigration as ProjectImporterMigration +import Wizard.Model.Context.AppContext +import Wizard.Service.Project.Importer.ProjectImporterMapper + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- GET /wizard-api/project-importers/{id} +-- ------------------------------------------------------------------------ +detail_GET :: AppContext -> SpecWith ((), Application) +detail_GET appContext = + describe "GET /wizard-api/project-importers/{id}" $ do + test_200 appContext + test_401 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodGet + +reqUrl = "/wizard-api/project-importers/global:project-importer-bio:3.0.0" + +reqHeadersT reqAuthHeader = [reqCtHeader, reqAuthHeader] + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = create_test_200 "HTTP 200 OK" appContext reqAuthHeader + +create_test_200 title appContext reqAuthHeader = + it title $ + -- GIVEN: Prepare request + do + let reqHeaders = reqHeadersT reqAuthHeader + -- AND: Prepare expectation + let expStatus = 200 + let expHeaders = resCtHeader : resCorsHeaders + let expDto = toDTO projectImporterBio3 + let expBody = encode expDto + -- AND: Run migrations + runInContextIO ProjectImporterMigration.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod reqUrl [reqCtHeader] reqBody + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [reqCtHeader] reqBody "PRJ_PERM" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + "/wizard-api/project-importers/deab6c38-aeac-4b17-a501-4365a0a70176" + (reqHeadersT reqAuthHeader) + reqBody + "project_importer" + [("id", "deab6c38-aeac-4b17-a501-4365a0a70176")] diff --git a/wizard-server/test/Wizard/Specs/API/ProjectImporter/Detail_PUT.hs b/wizard-server/test/Wizard/Specs/API/ProjectImporter/Detail_PUT.hs new file mode 100644 index 000000000..1043fff20 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/ProjectImporter/Detail_PUT.hs @@ -0,0 +1,94 @@ +module Wizard.Specs.API.ProjectImporter.Detail_PUT ( + detail_PUT, +) where + +import Data.Aeson (encode) +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) + +import Wizard.Api.Resource.Project.Importer.ProjectImporterDTO +import Wizard.Api.Resource.Project.Importer.ProjectImporterJM () +import Wizard.Database.Migration.Development.Project.Data.ProjectImporters +import qualified Wizard.Database.Migration.Development.Project.ProjectImporterMigration as ProjectImporterMigration +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Importer.ProjectImporter +import Wizard.Service.Project.Importer.ProjectImporterMapper + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.API.ProjectImporter.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- PUT /wizard-api/project-importers/{id} +-- ------------------------------------------------------------------------ +detail_PUT :: AppContext -> SpecWith ((), Application) +detail_PUT appContext = + describe "PUT /wizard-api/project-importers/{id}" $ do + test_200 appContext + test_401 appContext + test_403 appContext + test_404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodPut + +reqUrl = "/wizard-api/project-importers/global:project-importer-bio:3.0.0" + +reqHeadersT reqAuthHeader = [reqCtHeader, reqAuthHeader] + +reqDto = toChangeDTO projectImporterBio3Edited + +reqBody = encode reqDto + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = create_test_200 "HTTP 200 OK" appContext reqAuthHeader + +create_test_200 title appContext reqAuthHeader = + it title $ + -- GIVEN: Prepare request + do + let reqHeaders = reqHeadersT reqAuthHeader + -- AND: Prepare expectation + let expStatus = 200 + let expHeaders = resCtHeaderPlain : resCorsHeadersPlain + let expDto = toDTO projectImporterBio3Edited + let expBody = encode expDto + let expType (a :: ProjectImporterDTO) = a + -- AND: Run migrations + runInContextIO ProjectImporterMigration.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let (status, headers, resDto) = destructResponse response :: (Int, ResponseHeaders, ProjectImporterDTO) + assertResponseWithoutFields expStatus expHeaders expDto expType response ["updatedAt"] + -- AND: Find result in DB and compare with expectation state + assertExistenceOfProjectImporterInDB appContext projectImporterBio3Edited + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod reqUrl [reqCtHeader] reqBody + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [reqCtHeader] reqBody "PRJ_IMPORTER_PERM" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_404 appContext = + createNotFoundTest' + reqMethod + "/wizard-api/project-importers/deab6c38-aeac-4b17-a501-4365a0a70176" + (reqHeadersT reqAuthHeader) + reqBody + "project_importer" + [("id", "deab6c38-aeac-4b17-a501-4365a0a70176")] diff --git a/wizard-server/test/Wizard/Specs/API/ProjectImporter/List_GET.hs b/wizard-server/test/Wizard/Specs/API/ProjectImporter/List_GET.hs new file mode 100644 index 000000000..30083e826 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/ProjectImporter/List_GET.hs @@ -0,0 +1,99 @@ +module Wizard.Specs.API.ProjectImporter.List_GET ( + list_GET, +) where + +import Data.Aeson (encode) +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.PageMetadata +import Wizard.Api.Resource.Project.Importer.ProjectImporterDTO +import Wizard.Api.Resource.Project.Importer.ProjectImporterJM () +import Wizard.Database.Migration.Development.Project.Data.ProjectImporters +import qualified Wizard.Database.Migration.Development.Project.ProjectImporterMigration as ProjectImporterMigration +import Wizard.Model.Context.AppContext +import Wizard.Service.Project.Importer.ProjectImporterMapper + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- GET /wizard-api/project-importers +-- ------------------------------------------------------------------------ +list_GET :: AppContext -> SpecWith ((), Application) +list_GET appContext = + describe "GET /wizard-api/project-importers" $ do + test_200 appContext + test_401 appContext + test_403 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodGet + +reqUrl = "/wizard-api/project-importers" + +reqHeadersT reqAuthHeader = [reqAuthHeader] + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = do + create_test_200 + "HTTP 200 OK" + appContext + "/wizard-api/project-importers" + reqAuthHeader + ( Page + "projectImporters" + (PageMetadata 20 3 1 0) + (fmap toDTO [projectImporterBio3, projectImporterExt1, projectImporterOnto1]) + ) + create_test_200 + "HTTP 200 OK (query 'q')" + appContext + "/wizard-api/project-importers?q=ProjectImporterBio" + reqAuthHeader + (Page "projectImporters" (PageMetadata 20 1 1 0) (fmap toDTO [projectImporterBio3])) + create_test_200 + "HTTP 200 OK (query 'q' for non-existing)" + appContext + "/wizard-api/project-importers?q=Non-existing Project Report" + reqAuthHeader + (Page "projectImporters" (PageMetadata 20 0 0 0) ([] :: [ProjectImporterDTO])) + +create_test_200 title appContext reqUrl reqAuthHeader expDto = + it title $ + -- GIVEN: Prepare request + do + let reqHeaders = reqHeadersT reqAuthHeader + -- AND: Prepare expectation + let expStatus = 200 + let expHeaders = resCtHeader : resCorsHeaders + let expBody = encode expDto + -- AND: Run migrations + runInContextIO ProjectImporterMigration.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod reqUrl [] reqBody + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [] reqBody "PRJ_PERM" diff --git a/wizard-server/test/Wizard/Specs/API/ProjectImporter/List_Suggestions_GET.hs b/wizard-server/test/Wizard/Specs/API/ProjectImporter/List_Suggestions_GET.hs new file mode 100644 index 000000000..5e0d9da1a --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/ProjectImporter/List_Suggestions_GET.hs @@ -0,0 +1,109 @@ +module Wizard.Specs.API.ProjectImporter.List_Suggestions_GET ( + list_suggestions_GET, +) where + +import Data.Aeson (encode) +import Network.HTTP.Types +import Network.Wai (Application) +import Test.Hspec +import Test.Hspec.Wai hiding (shouldRespondWith) +import Test.Hspec.Wai.Matcher + +import Shared.Common.Model.Common.Page +import Shared.Common.Model.Common.PageMetadata +import Wizard.Api.Resource.Project.Importer.ProjectImporterDTO +import Wizard.Api.Resource.Project.Importer.ProjectImporterJM () +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration +import Wizard.Database.Migration.Development.Project.Data.ProjectImporters +import qualified Wizard.Database.Migration.Development.Project.ProjectImporterMigration as ProjectImporterMigration +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ_Migration +import Wizard.Model.Context.AppContext +import Wizard.Service.Project.Importer.ProjectImporterMapper + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- GET /wizard-api/project-importers/suggestions +-- ------------------------------------------------------------------------ +list_suggestions_GET :: AppContext -> SpecWith ((), Application) +list_suggestions_GET appContext = + describe "GET /wizard-api/project-importers/suggestions" $ do + test_200 appContext + test_401 appContext + test_403 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodGet + +reqUrl = "/wizard-api/project-importers/suggestions" + +reqHeadersT reqAuthHeader = [reqAuthHeader] + +reqBody = "" + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_200 appContext = do + create_test_200 + "HTTP 200 OK" + appContext + "/wizard-api/project-importers/suggestions?enabled=true" + reqAuthHeader + ( Page + "projectImporters" + (PageMetadata 20 2 1 0) + (fmap toDTO [projectImporterBio2, projectImporterExt1]) + ) + create_test_200 + "HTTP 200 OK (query 'q')" + appContext + "/wizard-api/project-importers/suggestions?enabled=true&q=ProjectImporterBio" + reqAuthHeader + (Page "projectImporters" (PageMetadata 20 1 1 0) (fmap toDTO [projectImporterBio2])) + create_test_200 + "HTTP 200 OK (query 'q' for non-existing)" + appContext + "/wizard-api/project-importers/suggestions?enabled=true&q=Non-existing Project Report" + reqAuthHeader + (Page "projectImporters" (PageMetadata 20 0 0 0) ([] :: [ProjectImporterDTO])) + create_test_200 + "HTTP 200 OK (query 'projectUuid')" + appContext + "/wizard-api/project-importers/suggestions?enabled=true&projectUuid=af984a75-56e3-49f8-b16f-d6b99599910a" + reqAuthHeader + (Page "projectImporters" (PageMetadata 20 1 1 0) (fmap toDTO [projectImporterBio2])) + +create_test_200 title appContext reqUrl reqAuthHeader expDto = + it title $ + -- GIVEN: Prepare request + do + let reqHeaders = reqHeadersT reqAuthHeader + -- AND: Prepare expectation + let expStatus = 200 + let expHeaders = resCtHeader : resCorsHeaders + let expBody = encode expDto + -- AND: Run migrations + runInContextIO TML_Migration.runMigration appContext + runInContextIO PRJ_Migration.runMigration appContext + runInContextIO ProjectImporterMigration.runMigration appContext + -- WHEN: Call API + response <- request reqMethod reqUrl reqHeaders reqBody + -- THEN: Compare response with expectation + let responseMatcher = + ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} + response `shouldRespondWith` responseMatcher + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod reqUrl [] reqBody + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [] reqBody "PRJ_PERM" diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/APISpec.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/APISpec.hs deleted file mode 100644 index a0885d748..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/APISpec.hs +++ /dev/null @@ -1,42 +0,0 @@ -module Wizard.Specs.API.Questionnaire.APISpec where - -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) - -import Wizard.Specs.API.Common -import Wizard.Specs.API.Questionnaire.Detail_Content_PUT -import Wizard.Specs.API.Questionnaire.Detail_DELETE -import Wizard.Specs.API.Questionnaire.Detail_Documents_GET -import Wizard.Specs.API.Questionnaire.Detail_GET -import Wizard.Specs.API.Questionnaire.Detail_Preview_GET -import Wizard.Specs.API.Questionnaire.Detail_Questionnaire_GET -import Wizard.Specs.API.Questionnaire.Detail_Report_GET -import Wizard.Specs.API.Questionnaire.Detail_Revert_POST -import Wizard.Specs.API.Questionnaire.Detail_Revert_Preview_POST -import Wizard.Specs.API.Questionnaire.Detail_Settings_GET -import Wizard.Specs.API.Questionnaire.Detail_Settings_PUT -import Wizard.Specs.API.Questionnaire.Detail_Share_PUT -import Wizard.Specs.API.Questionnaire.List_GET -import Wizard.Specs.API.Questionnaire.List_POST -import Wizard.Specs.API.Questionnaire.List_POST_CloneUuid -import Wizard.Specs.API.Questionnaire.List_POST_FromTemplate - -questionnaireAPI baseContext appContext = - with (startWebApp baseContext appContext) $ - describe "QUESTIONNAIRE API Spec" $ do - list_GET appContext - list_POST appContext - list_POST_fromTemplate appContext - list_POST_cloneUuid appContext - detail_GET appContext - detail_questionnaire_GET appContext - detail_share_PUT appContext - detail_preview_GET appContext - detail_settings_GET appContext - detail_settings_PUT appContext - detail_DELETE appContext - detail_content_PUT appContext - detail_report_GET appContext - detail_documents_GET appContext - detail_revert_POST appContext - detail_revert_preview_POST appContext diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/Comment/APISpec.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/Comment/APISpec.hs deleted file mode 100644 index 5e05d6138..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/Comment/APISpec.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Specs.API.Questionnaire.Comment.APISpec where - -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) - -import Wizard.Specs.API.Common -import Wizard.Specs.API.Questionnaire.Comment.List_GET - -questionnaireCommentAPI baseContext appContext = - with (startWebApp baseContext appContext) $ - describe "QUESTIONNAIRE COMMENT API Spec" $ - list_GET appContext diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/Comment/List_GET.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/Comment/List_GET.hs deleted file mode 100644 index a7dcc217c..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/Comment/List_GET.hs +++ /dev/null @@ -1,202 +0,0 @@ -module Wizard.Specs.API.Questionnaire.Comment.List_GET ( - list_GET, -) where - -import Data.Aeson (encode) -import qualified Data.ByteString.Char8 as BS -import Data.Foldable (traverse_) -import qualified Data.List as L -import qualified Data.Map.Strict as M -import qualified Data.UUID as U -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Database.DAO.Questionnaire.QuestionnaireCommentDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireCommentThreadDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireComments -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Database.Migration.Development.User.Data.Users -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireComment -import Wizard.Service.Questionnaire.Comment.QuestionnaireCommentMapper -import WizardLib.Public.Localization.Messages.Public - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- GET /wizard-api/questionnaires/{qtnUuid}/comments --- ------------------------------------------------------------------------ -list_GET :: AppContext -> SpecWith ((), Application) -list_GET appContext = - describe "GET /wizard-api/questionnaires/{qtnUuid}/comments" $ do - test_200 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodGet - -reqUrlT qtnUuid = BS.pack $ "/wizard-api/questionnaires/" ++ U.toString qtnUuid ++ "/comments" - -reqHeadersT authHeader = authHeader - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = do - create_test_200 - "HTTP 200 OK (Owner, Private)" - appContext - questionnaire1 - [reqAuthHeader] - [qtn1AlbertEditQtnPermDto] - create_test_200 - "HTTP 200 OK (Commenter)" - appContext - (questionnaire13 {visibility = PrivateQuestionnaire}) - [reqNonAdminAuthHeader] - [qtn13NikolaCommentQtnPermDto] - create_test_200 - "HTTP 200 OK (Non-Commenter, VisibleComment)" - appContext - questionnaire13 - [reqIsaacAuthTokenHeader] - [qtn13NikolaCommentQtnPermDto] - create_test_200 - "HTTP 200 OK (Anonymous, VisibleComment, AnyoneWithLinkComment)" - appContext - (questionnaire13 {sharing = AnyoneWithLinkCommentQuestionnaire}) - [] - [qtn13NikolaCommentQtnPermDto] - create_test_200 - "HTTP 200 OK (Non-Owner, VisibleEdit)" - appContext - questionnaire3 - [reqNonAdminAuthHeader] - [] - create_test_200 - "HTTP 200 OK (Anonymous, Public, Sharing)" - appContext - questionnaire10 - [] - [] - -create_test_200 title appContext qtn authHeader permissions = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT qtn.uuid - let reqHeaders = reqHeadersT authHeader - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO (insertPackage germanyKmPackage) appContext - runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - thread1 <- liftIO . create_cmtQ1_t1 $ qtn.uuid - comment1 <- liftIO . create_cmtQ1_t1_1 $ thread1.uuid - comment2 <- liftIO . create_cmtQ1_t1_2 $ thread1.uuid - runInContextIO (insertQuestionnaire qtn) appContext - runInContextIO (insertQuestionnaireCommentThread thread1) appContext - runInContextIO (insertQuestionnaireComment comment1) appContext - runInContextIO (insertQuestionnaireComment comment2) appContext - -- AND: Prepare expectation - let expStatus = 200 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = M.fromList [(cmtQ1_path, [toCommentThreadList thread1 Nothing (Just userAlbert) (L.sort [toCommentList comment1 (Just userAlbert), toCommentList comment2 (Just userAlbert)])])] - let expBody = encode expDto - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = do - create_test_403 - "HTTP 403 FORBIDDEN (Non-Owner, Private)" - appContext - questionnaire1 - [reqNonAdminAuthHeader] - (_ERROR_VALIDATION__FORBIDDEN "Comment Questionnaire") - create_test_403 - "HTTP 403 FORBIDDEN (Non-Owner, VisibleView)" - appContext - questionnaire2 - [reqNonAdminAuthHeader] - (_ERROR_VALIDATION__FORBIDDEN "Comment Questionnaire") - create_test_403 - "HTTP 403 FORBIDDEN (Anonymous, VisibleView, Sharing)" - appContext - questionnaire7 - [] - _ERROR_SERVICE_USER__MISSING_USER - create_test_403 - "HTTP 403 FORBIDDEN (Anonymous, VisibleView)" - appContext - questionnaire2 - [] - _ERROR_SERVICE_USER__MISSING_USER - create_test_403 - "HTTP 403 FORBIDDEN (Anonymous, Public)" - appContext - questionnaire3 - [] - _ERROR_SERVICE_USER__MISSING_USER - -create_test_403 title appContext qtn authHeader errorMessage = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT qtn.uuid - let reqHeaders = reqHeadersT authHeader - -- AND: Prepare expectation - let expStatus = 403 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = ForbiddenError errorMessage - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO (insertPackage germanyKmPackage) appContext - runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - runInContextIO (insertQuestionnaire qtn) appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - "/wizard-api/questionnaires/f08ead5f-746d-411b-aee6-77ea3d24016a/comments" - [reqHeadersT reqAuthHeader] - reqBody - "questionnaire" - [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/Common.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/Common.hs deleted file mode 100644 index e3680e851..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/Common.hs +++ /dev/null @@ -1,112 +0,0 @@ -module Wizard.Specs.API.Questionnaire.Common where - -import Data.Either (isLeft, isRight) -import qualified Data.UUID as U -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireEventDAO -import Wizard.Database.Migration.Development.Tenant.Data.Tenants -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Tenant.Config.TenantConfig -import Wizard.Model.Tenant.Tenant -import Wizard.Service.Tenant.Config.ConfigService - -import Wizard.Specs.Common - --- -------------------------------- --- ASSERTS --- -------------------------------- -assertExistenceOfQuestionnaireInDB appContext qtn qtnEvents = do - eQtn <- runInContextIO (findQuestionnaireByUuid qtn.uuid) appContext - liftIO $ isRight eQtn `shouldBe` True - let (Right qtnFromDb) = eQtn - compareQuestionnaireDtos qtnFromDb qtn - eQtnEvents <- runInContextIO (findQuestionnaireEventsByQuestionnaireUuid qtn.uuid) appContext - liftIO $ isRight eQtnEvents `shouldBe` True - let (Right qtnEventsFromDb) = eQtnEvents - liftIO $ qtnEventsFromDb `shouldBe` qtnEvents - -assertExistenceOfQuestionnaireContentInDB appContext qtnUuid content = do - eQtnEvents <- runInContextIO (findQuestionnaireEventsByQuestionnaireUuid qtnUuid) appContext - liftIO $ isRight eQtnEvents `shouldBe` True - let (Right qtnEventsFromDb) = eQtnEvents - compareQuestionnaireContentDtos qtnEventsFromDb content - -assertAbsenceOfQuestionnaireInDB appContext qtn = do - eQtn <- runInContextIO (findQuestionnaireByUuid qtn.uuid) appContext - liftIO $ isLeft eQtn `shouldBe` True - let (Left error) = eQtn - liftIO $ - error - `shouldBe` NotExistsError - ( _ERROR_DATABASE__ENTITY_NOT_FOUND - "questionnaire" - [("tenant_uuid", U.toString defaultTenant.uuid), ("uuid", U.toString qtn.uuid)] - ) - --- -------------------------------- --- COMPARATORS --- -------------------------------- -compareQuestionnaireCreateDtos resDto expDto = do - liftIO $ resDto.name `shouldBe` expDto.name - liftIO $ resDto.visibility `shouldBe` expDto.visibility - liftIO $ resDto.sharing `shouldBe` expDto.sharing - liftIO $ resDto.knowledgeModelPackage `shouldBe` expDto.knowledgeModelPackage - -compareQuestionnaireCreateFromTemplateDtos resDto expDto = do - liftIO $ resDto.uuid `shouldNotBe` expDto.uuid - liftIO $ resDto.name `shouldBe` expDto.name - liftIO $ resDto.visibility `shouldBe` expDto.visibility - liftIO $ resDto.sharing `shouldBe` expDto.sharing - liftIO $ resDto.state `shouldBe` expDto.state - liftIO $ resDto.knowledgeModelPackage `shouldBe` expDto.knowledgeModelPackage - -compareQuestionnaireCloneDtos resDto expDto = do - liftIO $ resDto.uuid `shouldNotBe` expDto.uuid - liftIO $ resDto.name `shouldBe` ("Copy of " ++ expDto.name) - liftIO $ resDto.visibility `shouldBe` expDto.visibility - liftIO $ resDto.sharing `shouldBe` expDto.sharing - liftIO $ resDto.state `shouldBe` expDto.state - liftIO $ resDto.knowledgeModelPackage `shouldBe` expDto.knowledgeModelPackage - -compareQuestionnaireCreateDtos' resDto expDto = do - liftIO $ resDto.name `shouldBe` expDto.name - liftIO $ resDto.phaseUuid `shouldBe` expDto.phaseUuid - liftIO $ resDto.visibility `shouldBe` expDto.visibility - liftIO $ resDto.sharing `shouldBe` expDto.sharing - liftIO $ resDto.state `shouldBe` expDto.state - liftIO $ resDto.knowledgeModelPackage `shouldBe` expDto.knowledgeModelPackage - liftIO $ resDto.selectedQuestionTagUuids `shouldBe` expDto.selectedQuestionTagUuids - liftIO $ resDto.knowledgeModel `shouldBe` expDto.knowledgeModel - liftIO $ resDto.replies `shouldBe` expDto.replies - -compareQuestionnaireCreateDtos'' resDto expDto = do - liftIO $ resDto.name `shouldBe` expDto.name - liftIO $ resDto.phaseUuid `shouldBe` expDto.phaseUuid - liftIO $ resDto.visibility `shouldBe` expDto.visibility - liftIO $ resDto.sharing `shouldBe` expDto.sharing - liftIO $ resDto.selectedQuestionTagUuids `shouldBe` expDto.selectedQuestionTagUuids - liftIO $ resDto.knowledgeModel `shouldBe` expDto.knowledgeModel - liftIO $ resDto.replies `shouldBe` expDto.replies - -compareQuestionnaireDtos resDto expDto = liftIO $ resDto `shouldBe` expDto - -compareQuestionnaireContentDtos resDto expDto = - liftIO $ resDto `shouldBe` expDto - -compareReportDtos resDto expDto = do - liftIO $ resDto.totalReport `shouldBe` expDto.totalReport - liftIO $ resDto.chapterReports `shouldBe` expDto.chapterReports - --- -------------------------------- --- HELPERS --- -------------------------------- -updateAnonymousQuestionnaireSharing appContext value = do - (Right tcQuestionnaire) <- runInContextIO getCurrentTenantConfigQuestionnaire appContext - let tcQuestionnaireUpdated = tcQuestionnaire {questionnaireSharing = tcQuestionnaire.questionnaireSharing {anonymousEnabled = value}} - runInContextIO (modifyTenantConfigQuestionnaire tcQuestionnaireUpdated) appContext diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Content_PUT.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Content_PUT.hs deleted file mode 100644 index 258827f2e..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Content_PUT.hs +++ /dev/null @@ -1,176 +0,0 @@ -module Wizard.Specs.API.Questionnaire.Detail_Content_PUT ( - detail_content_PUT, -) where - -import Data.Aeson (encode) -import qualified Data.ByteString.Char8 as BS -import Data.Foldable (traverse_) -import qualified Data.UUID as U -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Shared.Common.Util.Uuid -import Wizard.Api.Resource.Questionnaire.QuestionnaireContentChangeDTO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireEventDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireVersionDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire -import WizardLib.Public.Localization.Messages.Public - -import SharedTest.Specs.API.Common -import Wizard.Service.Questionnaire.Event.QuestionnaireEventMapper -import Wizard.Specs.API.Common -import Wizard.Specs.API.Questionnaire.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- PUT /wizard-api/questionnaires/{qtnUuid}/content --- ------------------------------------------------------------------------ -detail_content_PUT :: AppContext -> SpecWith ((), Application) -detail_content_PUT appContext = - describe "PUT /wizard-api/questionnaires/{qtnUuid}/content" $ do - test_200 appContext - test_400 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodPut - -reqUrlT qtnUuid = BS.pack $ "/wizard-api/questionnaires/" ++ U.toString qtnUuid ++ "/content" - -reqHeadersT authHeader = reqCtHeader : authHeader - -reqDto qtnUuid = - QuestionnaireContentChangeDTO - { events = [toEventChangeDTO (slble_rQ2' qtnUuid)] - } - -reqBody qtnUuid = encode (reqDto qtnUuid) - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = do - create_test_200 "HTTP 200 OK (Owner, Private)" appContext questionnaire1 questionnaire1EventsEdited [reqAuthHeader] - create_test_200 "HTTP 200 OK (Owner, VisibleView)" appContext questionnaire2 questionnaire2EventsEdited [reqAuthHeader] - create_test_200 "HTTP 200 OK (Non-Owner, Public)" appContext questionnaire3 questionnaire3EventsEdited [reqAuthHeader] - create_test_200 "HTTP 200 OK (Anonymous, Public, Sharing" appContext questionnaire10 questionnaire10EventsEdited [] - -create_test_200 title appContext qtn qtnEventsEdited authHeader = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT $ qtn.uuid - let reqHeaders = reqHeadersT authHeader - -- AND: Prepare expectation - let expStatus = 200 - let expHeaders = resCtHeaderPlain : resCorsHeadersPlain - let expDto = reqDto qtn.uuid - let expBody = encode expDto - -- AND: Run migrations - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - runInContextIO (insertQuestionnaire questionnaire7) appContext - runInContextIO (insertQuestionnaireEvents questionnaire7Events) appContext - runInContextIO (traverse_ insertQuestionnaireVersion questionnaire7Versions) appContext - runInContextIO (insertQuestionnaire questionnaire10) appContext - runInContextIO (insertQuestionnaireEvents questionnaire10Events) appContext - runInContextIO (traverse_ insertQuestionnaireVersion questionnaire10Versions) appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders (reqBody qtn.uuid) - -- THEN: Compare response with expectation - let (status, headers, resBody) = destructResponse response :: (Int, ResponseHeaders, QuestionnaireContentChangeDTO) - assertResStatus status expStatus - assertResHeaders headers expHeaders - compareQuestionnaireDtos resBody expDto - -- AND: Find a result in DB - assertExistenceOfQuestionnaireContentInDB appContext qtn.uuid qtnEventsEdited - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_400 appContext = createInvalidJsonTest reqMethod (reqUrlT questionnaire3.uuid) "visibility" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = do - create_test_403 - "HTTP 403 FORBIDDEN (Non-Owner, Private)" - appContext - questionnaire1 - questionnaire1EventsEdited - [reqNonAdminAuthHeader] - (_ERROR_VALIDATION__FORBIDDEN "Edit Questionnaire") - create_test_403 - "HTTP 403 FORBIDDEN (Non-Owner, VisibleView)" - appContext - questionnaire2 - questionnaire2EventsEdited - [reqNonAdminAuthHeader] - (_ERROR_VALIDATION__FORBIDDEN "Edit Questionnaire") - create_test_403 - "HTTP 403 FORBIDDEN (Anonymous, VisibleView, Sharing)" - appContext - questionnaire7 - questionnaire7EventsEdited - [] - _ERROR_SERVICE_USER__MISSING_USER - create_test_403 - "HTTP 403 FORBIDDEN (Anonymous, Public)" - appContext - questionnaire3 - questionnaire3EventsEdited - [] - _ERROR_SERVICE_USER__MISSING_USER - -create_test_403 title appContext qtn qtnEventsEdited authHeader reason = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT $ qtn.uuid - let reqHeaders = reqHeadersT authHeader - -- AND: Prepare expectation - let expStatus = 403 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = ForbiddenError reason - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - runInContextIO (insertQuestionnaire questionnaire7) appContext - runInContextIO (insertQuestionnaire questionnaire10) appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders (reqBody qtn.uuid) - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - "/wizard-api/questionnaires/f08ead5f-746d-411b-aee6-77ea3d24016a/content" - (reqHeadersT [reqAuthHeader]) - (reqBody $ u' "f08ead5f-746d-411b-aee6-77ea3d24016a") - "questionnaire" - [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_DELETE.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_DELETE.hs deleted file mode 100644 index ec96a63bf..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_DELETE.hs +++ /dev/null @@ -1,168 +0,0 @@ -module Wizard.Specs.API.Questionnaire.Detail_DELETE ( - detail_DELETE, -) where - -import Data.Aeson (encode) -import qualified Data.ByteString.Char8 as BS -import qualified Data.UUID as U -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Wizard.Database.DAO.Document.DocumentDAO -import Wizard.Database.DAO.Questionnaire.MigratorDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import qualified Wizard.Database.Migration.Development.Document.DocumentMigration as DOC -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.MigratorStates -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Localization.Messages.Public -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- DELETE /wizard-api/questionnaires/{qtnUuid} --- ------------------------------------------------------------------------ -detail_DELETE :: AppContext -> SpecWith ((), Application) -detail_DELETE appContext = - describe "DELETE /wizard-api/questionnaires/{qtnUuid}" $ do - test_204 appContext - test_400 appContext - test_401 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodDelete - -reqUrlT qtnUuid = BS.pack $ "/wizard-api/questionnaires/" ++ U.toString qtnUuid - -reqHeadersT authHeader = [authHeader] - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_204 appContext = do - create_test_204 "HTTP 204 NO CONTENT (Owner, Private)" appContext questionnaire1 reqAuthHeader 2 - create_test_204 "HTTP 204 NO CONTENT (Owner, VisibleView)" appContext questionnaire2 reqAuthHeader 1 - -create_test_204 title appContext qtn authHeader docCount = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT qtn.uuid - let reqHeaders = reqHeadersT authHeader - -- AND: Prepare expectation - let expStatus = 204 - let expHeaders = resCorsHeaders - let expBody = "" - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - runInContextIO DOC.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - -- AND: Find result in DB and compare with expectation state - assertCountInDB findQuestionnaires appContext 2 - assertCountInDB findDocuments appContext docCount - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_400 appContext = - it "HTTP 400 BAD REQUEST when package can't be deleted" $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT questionnaire4.uuid - let reqHeaders = reqHeadersT reqAuthHeader - -- AND: Prepare expectation - let expStatus = 400 - let expHeaders = resCorsHeaders - let expDto = UserError _ERROR_SERVICE_QTN__QTN_CANT_BE_DELETED_BECAUSE_IT_IS_USED_IN_MIGRATION - let expBody = encode expDto - -- AND: Prepare DB - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - runInContextIO (insertQuestionnaire questionnaire4) appContext - runInContextIO (insertQuestionnaire questionnaire4Upgraded) appContext - runInContextIO (insertMigratorState nlQtnMigrationState) appContext - runInContextIO DOC.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - -- AND: Find result in DB and compare with expectation state - assertCountInDB findQuestionnaires appContext 5 - assertCountInDB findDocuments appContext 3 - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod (reqUrlT questionnaire3.uuid) [] reqBody - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = do - create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, Private)" appContext questionnaire1 - create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, VisibleView)" appContext questionnaire1 - create_test_403 "HTTP 403 NO CONTENT (Non-Owner, VisibleEdit)" appContext questionnaire3 - -create_test_403 title appContext qtn = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT questionnaire1.uuid - let reqHeaders = reqHeadersT reqNonAdminAuthHeader - -- AND: Prepare expectation - let expStatus = 403 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN "Administrate Questionnaire" - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - -- AND: Find result in DB and compare with expectation state - assertCountInDB findQuestionnaires appContext 3 - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - "/wizard-api/questionnaires/f08ead5f-746d-411b-aee6-77ea3d24016a" - (reqHeadersT reqAuthHeader) - reqBody - "questionnaire" - [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Documents_GET.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Documents_GET.hs deleted file mode 100644 index 8e3cee471..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Documents_GET.hs +++ /dev/null @@ -1,170 +0,0 @@ -module Wizard.Specs.API.Questionnaire.Detail_Documents_GET ( - detail_documents_GET, -) where - -import Data.Aeson (encode) -import qualified Data.ByteString.Char8 as BS -import Data.Foldable (traverse_) -import qualified Data.UUID as U -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Common.Lens -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.PageMetadata -import Shared.Common.Model.Error.Error -import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplateFormats -import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplates -import Wizard.Api.Resource.Document.DocumentJM () -import Wizard.Database.DAO.Document.DocumentDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireEventDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireVersionDAO -import Wizard.Database.Migration.Development.Document.Data.Documents -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN_Migration -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN -import Wizard.Database.Migration.Development.User.Data.Users -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import qualified Wizard.Database.Migration.Development.User.UserMigration as U_Migration -import Wizard.Model.Context.AppContext -import Wizard.Model.Document.Document -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.User.User -import Wizard.S3.Document.DocumentS3 -import Wizard.Service.Document.DocumentMapper -import WizardLib.Public.Localization.Messages.Public - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- GET /wizard-api/questionnaires/{qtnUuid}/documents --- ------------------------------------------------------------------------ -detail_documents_GET :: AppContext -> SpecWith ((), Application) -detail_documents_GET appContext = - describe "GET /wizard-api/questionnaires/{qtnUuid}/documents" $ do - test_200 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodGet - -reqUrlT qtnUuid = BS.pack $ "/wizard-api/questionnaires/" ++ U.toString qtnUuid ++ "/documents?sort=name,asc" - -reqHeadersT authHeader = authHeader - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = do - create_test_200 "HTTP 200 CREATED (Owner)" appContext [reqAuthHeader] - create_test_200 "HTTP 200 CREATED (Non-Owner)" appContext [reqNonAdminAuthHeader] - create_test_200 "HTTP 200 CREATED (Anonymous)" appContext [] - -create_test_200 title appContext authHeader = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT questionnaire6.uuid - let reqHeaders = reqHeadersT authHeader - -- AND: Run migrations - let doc1' = doc1 {questionnaireUuid = Just questionnaire6.uuid, questionnaireEventUuid = Just . getUuid $ slble_rQ1' questionnaire6.uuid} - let doc2' = doc2 {questionnaireUuid = Just questionnaire6.uuid, questionnaireEventUuid = Just . getUuid $ slble_rQ1' questionnaire6.uuid, createdBy = Just userIsaac.uuid} - runInContextIO U_Migration.runMigration appContext - runInContextIO TML_Migration.runMigration appContext - runInContextIO QTN_Migration.runMigration appContext - runInContextIO (insertQuestionnaire questionnaire6) appContext - runInContextIO (insertQuestionnaireEvents questionnaire6Events) appContext - runInContextIO (traverse_ insertQuestionnaireVersion questionnaire6Versions) appContext - runInContextIO deleteDocuments appContext - runInContextIO removeDocumentContents appContext - runInContextIO (insertDocument doc1') appContext - runInContextIO (insertDocument doc2') appContext - -- AND: Prepare expectation - let expStatus = 200 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = - Page - "documents" - (PageMetadata 20 2 1 0) - [ toDTOWithDocTemplate doc1' questionnaire6 (Just "Version 1") [] - , toDTOWithDocTemplate doc2' questionnaire6 (Just "Version 1") [] - ] - let expBody = encode (fmap (\x -> x wizardDocumentTemplate formatJsonSimple) expDto) - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = do - create_test_403 - "HTTP 403 FORBIDDEN (Non-Owner, Private)" - appContext - questionnaire1 - [reqNonAdminAuthHeader] - (_ERROR_VALIDATION__FORBIDDEN "View Questionnaire") - create_test_403 - "HTTP 403 FORBIDDEN (Anonymous, VisibleView)" - appContext - questionnaire2 - [] - _ERROR_SERVICE_USER__MISSING_USER - create_test_403 - "HTTP 403 FORBIDDEN (Anonymous, VisibleEdit)" - appContext - questionnaire3 - [] - _ERROR_SERVICE_USER__MISSING_USER - -create_test_403 title appContext qtn authHeader errorMessage = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT qtn.uuid - let reqHeaders = reqHeadersT authHeader - -- AND: Prepare expectation - let expStatus = 403 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = ForbiddenError errorMessage - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML_Migration.runMigration appContext - runInContextIO QTN.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - "/wizard-api/questionnaires/f08ead5f-746d-411b-aee6-77ea3d24016a/documents" - (reqHeadersT [reqAuthHeader]) - reqBody - "questionnaire" - [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_GET.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_GET.hs deleted file mode 100644 index 024387b0c..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_GET.hs +++ /dev/null @@ -1,209 +0,0 @@ -module Wizard.Specs.API.Questionnaire.Detail_GET ( - detail_GET, -) where - -import Data.Aeson (encode) -import qualified Data.ByteString.Char8 as BS -import Data.Foldable (traverse_) -import qualified Data.UUID as U -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailDTO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireEventDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire -import WizardLib.Public.Localization.Messages.Public - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- GET /wizard-api/questionnaires/{qtnUuid} --- ------------------------------------------------------------------------ -detail_GET :: AppContext -> SpecWith ((), Application) -detail_GET appContext = - describe "GET /wizard-api/questionnaires/{qtnUuid}" $ do - test_200 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodGet - -reqUrlT qtnUuid = BS.pack $ "/wizard-api/questionnaires/" ++ U.toString qtnUuid - -reqHeadersT authHeader = authHeader - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = do - create_test_200 - "HTTP 200 OK (Owner, Private)" - appContext - questionnaire1 - questionnaire1Events - [reqAuthHeader] - [qtn1AlbertEditQtnPermDto] - create_test_200 - "HTTP 200 OK (Non-Owner, VisibleView)" - appContext - questionnaire2 - questionnaire2Events - [reqNonAdminAuthHeader] - [qtn2AlbertEditQtnPermDto] - create_test_200 - "HTTP 200 OK (Commenter)" - appContext - (questionnaire13 {visibility = PrivateQuestionnaire}) - questionnaire13Events - [reqNonAdminAuthHeader] - [qtn13NikolaCommentQtnPermDto] - create_test_200 - "HTTP 200 OK (Non-Commenter, VisibleComment)" - appContext - questionnaire13 - questionnaire13Events - [reqIsaacAuthTokenHeader] - [qtn13NikolaCommentQtnPermDto] - create_test_200 - "HTTP 200 OK (Anonymous, VisibleComment, AnyoneWithLinkComment)" - appContext - (questionnaire13 {sharing = AnyoneWithLinkCommentQuestionnaire}) - questionnaire13Events - [] - [qtn13NikolaCommentQtnPermDto] - create_test_200 - "HTTP 200 OK (Anonymous, VisibleView, Sharing)" - appContext - questionnaire7 - questionnaire7Events - [] - [qtn7AlbertEditQtnPermDto] - create_test_200 - "HTTP 200 OK (Non-Owner, VisibleEdit)" - appContext - questionnaire3 - questionnaire3Events - [reqNonAdminAuthHeader] - [] - create_test_200 - "HTTP 200 OK (Anonymous, Public, Sharing)" - appContext - questionnaire10 - questionnaire10Events - [] - [] - -create_test_200 title appContext qtn qtnEvents authHeader permissions = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT qtn.uuid - let reqHeaders = reqHeadersT authHeader - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO (insertPackage germanyKmPackage) appContext - runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - runInContextIO (insertQuestionnaire qtn) appContext - runInContextIO (insertQuestionnaireEvents qtnEvents) appContext - -- AND: Prepare expectation - let expStatus = 200 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = - QuestionnaireDetailDTO - { uuid = qtn.uuid - , name = qtn.name - , sharing = qtn.sharing - , visibility = qtn.visibility - , knowledgeModelPackageId = qtn.knowledgeModelPackageId - , isTemplate = qtn.isTemplate - , migrationUuid = Nothing - , permissions = permissions - , fileCount = 0 - } - let expBody = encode expDto - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = do - create_test_403 - "HTTP 403 FORBIDDEN (Non-Owner, Private)" - appContext - questionnaire1 - [reqNonAdminAuthHeader] - (_ERROR_VALIDATION__FORBIDDEN "View Questionnaire") - create_test_403 - "HTTP 403 FORBIDDEN (Anonymous, VisibleView)" - appContext - questionnaire2 - [] - _ERROR_SERVICE_USER__MISSING_USER - create_test_403 - "HTTP 403 FORBIDDEN (Anonymous, Public)" - appContext - questionnaire3 - [] - _ERROR_SERVICE_USER__MISSING_USER - -create_test_403 title appContext qtn authHeader errorMessage = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT qtn.uuid - let reqHeaders = reqHeadersT authHeader - -- AND: Prepare expectation - let expStatus = 403 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = ForbiddenError errorMessage - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - "/wizard-api/questionnaires/f08ead5f-746d-411b-aee6-77ea3d24016a" - [reqHeadersT reqAuthHeader] - reqBody - "questionnaire" - [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Preview_GET.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Preview_GET.hs deleted file mode 100644 index e6cc36c12..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Preview_GET.hs +++ /dev/null @@ -1,202 +0,0 @@ -module Wizard.Specs.API.Questionnaire.Detail_Preview_GET ( - detail_preview_GET, -) where - -import Data.Aeson (encode) -import qualified Data.ByteString.Char8 as BS -import Data.Foldable (traverse_) -import qualified Data.UUID as U -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplateFormats -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireDetailPreview -import WizardLib.Public.Localization.Messages.Public - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- GET /wizard-api/questionnaires/{qtnUuid}/preview --- ------------------------------------------------------------------------ -detail_preview_GET :: AppContext -> SpecWith ((), Application) -detail_preview_GET appContext = - describe "GET /wizard-api/questionnaires/{qtnUuid}/preview" $ do - test_200 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodGet - -reqUrlT qtnUuid = BS.pack $ "/wizard-api/questionnaires/" ++ U.toString qtnUuid ++ "/preview" - -reqHeadersT authHeader = authHeader - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = do - create_test_200 - "HTTP 200 OK (Owner, Private)" - appContext - questionnaire1 - [reqAuthHeader] - [qtn1AlbertEditQtnPermDto] - create_test_200 - "HTTP 200 OK (Non-Owner, VisibleView)" - appContext - questionnaire2 - [reqNonAdminAuthHeader] - [qtn2AlbertEditQtnPermDto] - create_test_200 - "HTTP 200 OK (Commenter)" - appContext - (questionnaire13 {visibility = PrivateQuestionnaire}) - [reqNonAdminAuthHeader] - [qtn13NikolaCommentQtnPermDto] - create_test_200 - "HTTP 200 OK (Non-Commenter, VisibleComment)" - appContext - questionnaire13 - [reqIsaacAuthTokenHeader] - [qtn13NikolaCommentQtnPermDto] - create_test_200 - "HTTP 200 OK (Anonymous, VisibleComment, AnyoneWithLinkComment)" - appContext - (questionnaire13 {sharing = AnyoneWithLinkCommentQuestionnaire}) - [] - [qtn13NikolaCommentQtnPermDto] - create_test_200 - "HTTP 200 OK (Anonymous, VisibleView, Sharing)" - appContext - questionnaire7 - [] - [qtn7AlbertEditQtnPermDto] - create_test_200 - "HTTP 200 OK (Non-Owner, VisibleEdit)" - appContext - questionnaire3 - [reqNonAdminAuthHeader] - [] - create_test_200 - "HTTP 200 OK (Anonymous, Public, Sharing)" - appContext - questionnaire10 - [] - [] - -create_test_200 title appContext qtn authHeader permissions = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT qtn.uuid - let reqHeaders = reqHeadersT authHeader - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO (insertPackage germanyKmPackage) appContext - runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - runInContextIO (insertQuestionnaire qtn) appContext - -- AND: Prepare expectation - let expStatus = 200 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = - QuestionnaireDetailPreview - { uuid = qtn.uuid - , name = qtn.name - , visibility = qtn.visibility - , sharing = qtn.sharing - , knowledgeModelPackageId = qtn.knowledgeModelPackageId - , isTemplate = qtn.isTemplate - , migrationUuid = Nothing - , permissions = permissions - , documentTemplateId = qtn.documentTemplateId - , format = Just formatJsonSimple - , fileCount = 0 - } - let expBody = encode expDto - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = do - create_test_403 - "HTTP 403 FORBIDDEN (Non-Owner, Private)" - appContext - questionnaire1 - [reqNonAdminAuthHeader] - (_ERROR_VALIDATION__FORBIDDEN "View Questionnaire") - create_test_403 - "HTTP 403 FORBIDDEN (Anonymous, VisibleView)" - appContext - questionnaire2 - [] - _ERROR_SERVICE_USER__MISSING_USER - create_test_403 - "HTTP 403 FORBIDDEN (Anonymous, Public)" - appContext - questionnaire3 - [] - _ERROR_SERVICE_USER__MISSING_USER - -create_test_403 title appContext qtn authHeader errorMessage = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT qtn.uuid - let reqHeaders = reqHeadersT authHeader - -- AND: Prepare expectation - let expStatus = 403 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = ForbiddenError errorMessage - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - "/wizard-api/questionnaires/f08ead5f-746d-411b-aee6-77ea3d24016a/preview" - [reqHeadersT reqAuthHeader] - reqBody - "questionnaire" - [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Questionnaire_GET.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Questionnaire_GET.hs deleted file mode 100644 index a20a61098..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Questionnaire_GET.hs +++ /dev/null @@ -1,245 +0,0 @@ -module Wizard.Specs.API.Questionnaire.Detail_Questionnaire_GET ( - detail_questionnaire_GET, -) where - -import Data.Aeson (encode) -import qualified Data.ByteString.Char8 as BS -import Data.Foldable (traverse_) -import qualified Data.Map.Strict as M -import qualified Data.UUID as U -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.KnowledgeModels -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailQuestionnaireDTO -import Wizard.Database.DAO.Questionnaire.QuestionnaireCommentDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireCommentThreadDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireEventDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireComments -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireReplies -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireComment -import Wizard.Model.Questionnaire.QuestionnaireContent -import WizardLib.Public.Localization.Messages.Public - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- GET /wizard-api/questionnaires/{qtnUuid}/questionnaire --- ------------------------------------------------------------------------ -detail_questionnaire_GET :: AppContext -> SpecWith ((), Application) -detail_questionnaire_GET appContext = - describe "GET /wizard-api/questionnaires/{qtnUuid}/questionnaire" $ do - test_200 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodGet - -reqUrlT qtnUuid = BS.pack $ "/wizard-api/questionnaires/" ++ U.toString qtnUuid ++ "/questionnaire" - -reqHeadersT authHeader = authHeader - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = do - create_test_200 - "HTTP 200 OK (Owner, Private)" - appContext - questionnaire1 - questionnaire1Events - questionnaire1Ctn - True - [reqAuthHeader] - [qtn1AlbertEditQtnPermDto] - create_test_200 - "HTTP 200 OK (Non-Owner, VisibleView)" - appContext - questionnaire2 - questionnaire2Events - (questionnaire2Ctn {labels = M.empty} :: QuestionnaireContent) - False - [reqNonAdminAuthHeader] - [qtn2AlbertEditQtnPermDto] - create_test_200 - "HTTP 200 OK (Commenter)" - appContext - (questionnaire13 {visibility = PrivateQuestionnaire}) - questionnaire13Events - (questionnaire13Ctn {labels = M.empty} :: QuestionnaireContent) - True - [reqNonAdminAuthHeader] - [qtn13NikolaCommentQtnPermDto] - create_test_200 - "HTTP 200 OK (Non-Commenter, VisibleComment)" - appContext - questionnaire13 - questionnaire13Events - (questionnaire13Ctn {labels = M.empty} :: QuestionnaireContent) - True - [reqIsaacAuthTokenHeader] - [qtn13NikolaCommentQtnPermDto] - create_test_200 - "HTTP 200 OK (Anonymous, VisibleComment, AnyoneWithLinkComment)" - appContext - (questionnaire13 {sharing = AnyoneWithLinkCommentQuestionnaire}) - questionnaire13Events - (questionnaire13Ctn {labels = M.empty} :: QuestionnaireContent) - True - [] - [qtn13NikolaCommentQtnPermDto] - create_test_200 - "HTTP 200 OK (Anonymous, VisibleView, Sharing)" - appContext - questionnaire7 - questionnaire7Events - (questionnaire7Ctn {labels = M.empty} :: QuestionnaireContent) - False - [] - [qtn7AlbertEditQtnPermDto] - create_test_200 - "HTTP 200 OK (Non-Owner, VisibleEdit)" - appContext - questionnaire3 - questionnaire3Events - questionnaire3Ctn - True - [reqNonAdminAuthHeader] - [] - create_test_200 "HTTP 200 OK (Anonymous, Public, Sharing)" appContext questionnaire10 questionnaire10Events questionnaire10Ctn True [] [] - -create_test_200 title appContext qtn qtnEvents qtnCtn showComments authHeader permissions = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT qtn.uuid - let reqHeaders = reqHeadersT authHeader - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO (insertPackage germanyKmPackage) appContext - runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - thread1 <- liftIO . create_cmtQ1_t1 $ qtn.uuid - comment1 <- liftIO . create_cmtQ1_t1_1 $ thread1.uuid - comment2 <- liftIO . create_cmtQ1_t1_2 $ thread1.uuid - runInContextIO (insertQuestionnaire qtn) appContext - runInContextIO (insertQuestionnaireEvents qtnEvents) appContext - runInContextIO (insertQuestionnaireCommentThread thread1) appContext - runInContextIO (insertQuestionnaireComment comment1) appContext - runInContextIO (insertQuestionnaireComment comment2) appContext - let unresolvedCommentCounts = - if showComments - then M.fromList [(cmtQ1_path, M.fromList [(thread1.uuid, 2)])] - else M.empty - -- AND: Prepare expectation - let expStatus = 200 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = - QuestionnaireDetailQuestionnaireDTO - { uuid = qtn.uuid - , name = qtn.name - , visibility = qtn.visibility - , sharing = qtn.sharing - , knowledgeModelPackageId = qtn.knowledgeModelPackageId - , selectedQuestionTagUuids = qtn.selectedQuestionTagUuids - , isTemplate = qtn.isTemplate - , knowledgeModel = km1WithQ4 - , replies = fReplies - , labels = qtnCtn.labels - , phaseUuid = qtnCtn.phaseUuid - , migrationUuid = Nothing - , permissions = permissions - , files = [] - , unresolvedCommentCounts = unresolvedCommentCounts - , resolvedCommentCounts = M.empty - , questionnaireActionsAvailable = 0 - , questionnaireImportersAvailable = 0 - , fileCount = 0 - } - let expBody = encode expDto - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = do - create_test_403 - "HTTP 403 FORBIDDEN (Non-Owner, Private)" - appContext - questionnaire1 - [reqNonAdminAuthHeader] - (_ERROR_VALIDATION__FORBIDDEN "View Questionnaire") - create_test_403 - "HTTP 403 FORBIDDEN (Anonymous, VisibleView)" - appContext - questionnaire2 - [] - _ERROR_SERVICE_USER__MISSING_USER - create_test_403 - "HTTP 403 FORBIDDEN (Anonymous, Public)" - appContext - questionnaire3 - [] - _ERROR_SERVICE_USER__MISSING_USER - -create_test_403 title appContext qtn authHeader errorMessage = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT qtn.uuid - let reqHeaders = reqHeadersT authHeader - -- AND: Prepare expectation - let expStatus = 403 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = ForbiddenError errorMessage - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - "/wizard-api/questionnaires/f08ead5f-746d-411b-aee6-77ea3d24016a/questionnaire" - [reqHeadersT reqAuthHeader] - reqBody - "questionnaire" - [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Report_GET.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Report_GET.hs deleted file mode 100644 index fdf09d6eb..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Report_GET.hs +++ /dev/null @@ -1,156 +0,0 @@ -module Wizard.Specs.API.Questionnaire.Detail_Report_GET ( - detail_report_GET, -) where - -import Data.Aeson (encode) -import qualified Data.ByteString.Char8 as BS -import Data.Foldable (traverse_) -import qualified Data.UUID as U -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailReportDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireDetailReportJM () -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireEventDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN -import Wizard.Database.Migration.Development.Report.Data.Reports -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Report.Report -import WizardLib.Public.Localization.Messages.Public - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.API.Questionnaire.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- GET /wizard-api/questionnaires/{qtnUuid}/report --- ------------------------------------------------------------------------ -detail_report_GET :: AppContext -> SpecWith ((), Application) -detail_report_GET appContext = - describe "GET /wizard-api/questionnaires/{qtnUuid}/report" $ do - test_200 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodGet - -reqUrlT qtnUuid = BS.pack $ "/wizard-api/questionnaires/" ++ U.toString qtnUuid ++ "/report" - -reqHeadersT authHeader = reqCtHeader : authHeader - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = do - create_test_200 "HTTP 200 OK (Owner, Private)" appContext questionnaire1 [reqAuthHeader] - create_test_200 "HTTP 200 OK (Non-Owner, VisibleView)" appContext questionnaire2 [reqNonAdminAuthHeader] - create_test_200 "HTTP 200 OK (Non-Owner, VisibleView, Sharing)" appContext questionnaire7 [] - create_test_200 "HTTP 200 OK (Non-Owner, VisibleEdit)" appContext questionnaire3 [reqNonAdminAuthHeader] - create_test_200 "HTTP 200 OK (Non-Owner, VisibleEdit, Sharing)" appContext questionnaire10 [] - -create_test_200 title appContext qtn authHeader = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT $ qtn.uuid - let reqHeaders = reqHeadersT authHeader - -- GIVEN: Prepare expectation - let expStatus = 200 - let expHeaders = resCtHeaderPlain : resCorsHeadersPlain - let expDto = report1 - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - runInContextIO (insertPackage germanyKmPackage) appContext - runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - runInContextIO (insertQuestionnaire questionnaire7) appContext - runInContextIO (insertQuestionnaireEvents questionnaire7Events) appContext - runInContextIO (insertQuestionnaire questionnaire10) appContext - runInContextIO (insertQuestionnaireEvents questionnaire10Events) appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - result <- destructResponse' response - let (status, headers, resBody) = result :: (Int, ResponseHeaders, QuestionnaireDetailReportDTO) - assertResStatus status expStatus - assertResHeaders headers expHeaders - compareReportDtos resBody expDto - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = do - create_test_403 - "HTTP 403 FORBIDDEN (Non-Owner, Private)" - appContext - questionnaire1 - [reqNonAdminAuthHeader] - (_ERROR_VALIDATION__FORBIDDEN "View Questionnaire") - create_test_403 - "HTTP 403 FORBIDDEN (Anonymous, VisibleView)" - appContext - questionnaire2 - [] - _ERROR_SERVICE_USER__MISSING_USER - create_test_403 - "HTTP 403 FORBIDDEN (Anonymous, VisibleEdit)" - appContext - questionnaire3 - [] - _ERROR_SERVICE_USER__MISSING_USER - -create_test_403 title appContext qtn authHeader errorMessage = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT qtn.uuid - let reqHeaders = reqHeadersT authHeader - -- AND: Prepare expectation - let expStatus = 403 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = ForbiddenError errorMessage - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - "/wizard-api/questionnaires/f08ead5f-746d-411b-aee6-77ea3d24016a/report" - (reqHeadersT [reqAuthHeader]) - reqBody - "questionnaire" - [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Revert_POST.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Revert_POST.hs deleted file mode 100644 index c5a7e552c..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Revert_POST.hs +++ /dev/null @@ -1,82 +0,0 @@ -module Wizard.Specs.API.Questionnaire.Detail_Revert_POST ( - detail_revert_POST, -) where - -import Data.Aeson (encode) -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Api.Resource.Error.ErrorJM () -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireVersions -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.QuestionnaireVersion - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.API.Questionnaire.Common -import Wizard.Specs.API.Questionnaire.Version.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- POST /wizard-api/questionnaires/{qtnUuid}/revert --- ------------------------------------------------------------------------ -detail_revert_POST :: AppContext -> SpecWith ((), Application) -detail_revert_POST appContext = - describe "POST /wizard-api/questionnaires/{qtnUuid}/revert" $ do - test_200 appContext - test_400 appContext - test_401 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodPost - -reqUrl = "/wizard-api/questionnaires/af984a75-56e3-49f8-b16f-d6b99599910a/revert" - -reqHeaders = [reqAuthHeader, reqCtHeader] - -reqDto = questionnaireVersion1RevertDto questionnaire1Uuid - -reqBody = encode reqDto - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = - it "HTTP 200 OK" $ - -- GIVEN: Prepare expectation - do - let expStatus = 200 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = questionnaire1CtnRevertedDto - let expBody = encode expDto - -- AND: Run migrations - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - -- AND: Find a result in DB - assertExistenceOfQuestionnaireInDB appContext questionnaire1 [sre_rQ1' questionnaire1Uuid, sre_rQ2' questionnaire1Uuid] - assertAbsenceOfQuestionnaireVersionInDB appContext (questionnaireVersion1 questionnaire1Uuid) - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_400 appContext = createInvalidJsonTest reqMethod reqUrl "name" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod reqUrl [reqCtHeader] reqBody diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Revert_Preview_POST.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Revert_Preview_POST.hs deleted file mode 100644 index f96aabb22..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Revert_Preview_POST.hs +++ /dev/null @@ -1,88 +0,0 @@ -module Wizard.Specs.API.Questionnaire.Detail_Revert_Preview_POST ( - detail_revert_preview_POST, -) where - -import Data.Aeson (encode) -import qualified Data.Map.Strict as M -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireContentDTO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireVersions -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.API.Questionnaire.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- POST /wizard-api/questionnaires/{qtnUuid}/revert/preview --- ------------------------------------------------------------------------ -detail_revert_preview_POST :: AppContext -> SpecWith ((), Application) -detail_revert_preview_POST appContext = - describe "POST /wizard-api/questionnaires/{qtnUuid}/revert/preview" $ do - test_200 appContext - test_400 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodPost - -reqUrl = "/wizard-api/questionnaires/af984a75-56e3-49f8-b16f-d6b99599910a/revert/preview" - -reqHeadersT authHeader = authHeader ++ [reqCtHeader] - -reqDto = questionnaireVersion1RevertDto questionnaire1Uuid - -reqBody = encode reqDto - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = do - create_test_200 "HTTP 200 OK (logged user)" appContext True [reqAuthHeader] - create_test_200 "HTTP 200 OK (anonymous)" appContext False [] - -create_test_200 title appContext showComments authHeader = - it title $ - -- GIVEN: Prepare request - do - let reqHeaders = reqHeadersT authHeader - -- AND: Prepare expectation - let expStatus = 200 - let expHeaders = resCtHeader : resCorsHeaders - let expQtn = questionnaire1 {sharing = AnyoneWithLinkViewQuestionnaire} - let expQtnEvents = questionnaire1Events - let expDto = - if showComments - then questionnaire1CtnRevertedDto - else questionnaire1CtnRevertedDto {commentThreadsMap = M.empty} - let expBody = encode expDto - -- AND: Run migrations - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - runInContextIO (updateQuestionnaireByUuid expQtn) appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - -- AND: Find a result in DB - assertExistenceOfQuestionnaireInDB appContext expQtn expQtnEvents - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_400 appContext = createInvalidJsonTest reqMethod reqUrl "name" diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Settings_GET.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Settings_GET.hs deleted file mode 100644 index 495a68629..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Settings_GET.hs +++ /dev/null @@ -1,217 +0,0 @@ -module Wizard.Specs.API.Questionnaire.Detail_Settings_GET ( - detail_settings_GET, -) where - -import Data.Aeson (encode) -import qualified Data.ByteString.Char8 as BS -import Data.Foldable (traverse_) -import qualified Data.Map.Strict as M -import qualified Data.UUID as U -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplateFormats -import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplates -import Shared.DocumentTemplate.Model.DocumentTemplate.DocumentTemplate -import qualified Shared.DocumentTemplate.Service.DocumentTemplate.DocumentTemplateMapper as STM -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.KnowledgeModels -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel hiding (request) -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireDetailSettings -import qualified Wizard.Service.KnowledgeModel.Package.KnowledgeModelPackageMapper as PM -import Wizard.Service.Questionnaire.QuestionnaireMapper -import WizardLib.Public.Localization.Messages.Public - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- GET /wizard-api/questionnaires/{qtnUuid}/settings --- ------------------------------------------------------------------------ -detail_settings_GET :: AppContext -> SpecWith ((), Application) -detail_settings_GET appContext = - describe "GET /wizard-api/questionnaires/{qtnUuid}/settings" $ do - test_200 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodGet - -reqUrlT qtnUuid = BS.pack $ "/wizard-api/questionnaires/" ++ U.toString qtnUuid ++ "/settings" - -reqHeadersT authHeader = authHeader - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = do - create_test_200 - "HTTP 200 OK (Owner, Private)" - appContext - questionnaire1 - [reqAuthHeader] - [qtn1AlbertEditQtnPermDto] - create_test_200 - "HTTP 200 OK (Non-Owner, VisibleView)" - appContext - questionnaire2 - [reqNonAdminAuthHeader] - [qtn2AlbertEditQtnPermDto] - create_test_200 - "HTTP 200 OK (Commenter)" - appContext - (questionnaire13 {visibility = PrivateQuestionnaire}) - [reqNonAdminAuthHeader] - [qtn13NikolaCommentQtnPermDto] - create_test_200 - "HTTP 200 OK (Non-Commenter, VisibleComment)" - appContext - questionnaire13 - [reqIsaacAuthTokenHeader] - [qtn13NikolaCommentQtnPermDto] - create_test_200 - "HTTP 200 OK (Anonymous, VisibleComment, AnyoneWithLinkComment)" - appContext - (questionnaire13 {sharing = AnyoneWithLinkCommentQuestionnaire}) - [] - [qtn13NikolaCommentQtnPermDto] - create_test_200 - "HTTP 200 OK (Anonymous, VisibleView, Sharing)" - appContext - questionnaire7 - [] - [qtn7AlbertEditQtnPermDto] - create_test_200 - "HTTP 200 OK (Non-Owner, VisibleEdit)" - appContext - questionnaire3 - [reqNonAdminAuthHeader] - [] - create_test_200 - "HTTP 200 OK (Anonymous, Public, Sharing)" - appContext - questionnaire10 - [] - [] - -create_test_200 title appContext qtn authHeader permissions = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT qtn.uuid - let reqHeaders = reqHeadersT authHeader - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO (insertPackage germanyKmPackage) appContext - runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - runInContextIO (insertQuestionnaire qtn) appContext - -- AND: Prepare expectation - let expStatus = 200 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = - QuestionnaireDetailSettings - { uuid = qtn.uuid - , name = qtn.name - , description = qtn.description - , visibility = qtn.visibility - , sharing = qtn.sharing - , isTemplate = qtn.isTemplate - , migrationUuid = Nothing - , permissions = permissions - , projectTags = qtn.projectTags - , knowledgeModelPackageId = qtn.knowledgeModelPackageId - , knowledgeModelPackage = PM.toSimpleDTO' [] [] germanyKmPackage - , knowledgeModelTags = M.elems km1WithQ4.entities.tags - , documentTemplate = Just $ STM.toDTO wizardDocumentTemplate wizardDocumentTemplateFormats - , documentTemplateState = toQuestionnaireDetailTemplateState (Just wizardDocumentTemplate) - , documentTemplatePhase = Just wizardDocumentTemplate.phase - , formatUuid = Just formatJson.uuid - , selectedQuestionTagUuids = qtn.selectedQuestionTagUuids - , fileCount = 0 - } - let expBody = encode expDto - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = do - create_test_403 - "HTTP 403 FORBIDDEN (Non-Owner, Private)" - appContext - questionnaire1 - [reqNonAdminAuthHeader] - (_ERROR_VALIDATION__FORBIDDEN "View Questionnaire") - create_test_403 - "HTTP 403 FORBIDDEN (Anonymous, VisibleView)" - appContext - questionnaire2 - [] - _ERROR_SERVICE_USER__MISSING_USER - create_test_403 - "HTTP 403 FORBIDDEN (Anonymous, Public)" - appContext - questionnaire3 - [] - _ERROR_SERVICE_USER__MISSING_USER - -create_test_403 title appContext qtn authHeader errorMessage = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT qtn.uuid - let reqHeaders = reqHeadersT authHeader - -- AND: Prepare expectation - let expStatus = 403 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = ForbiddenError errorMessage - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - "/wizard-api/questionnaires/f08ead5f-746d-411b-aee6-77ea3d24016a/settings" - [reqHeadersT reqAuthHeader] - reqBody - "questionnaire" - [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Settings_PUT.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Settings_PUT.hs deleted file mode 100644 index 03e0fa315..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Settings_PUT.hs +++ /dev/null @@ -1,207 +0,0 @@ -module Wizard.Specs.API.Questionnaire.Detail_Settings_PUT ( - detail_settings_PUT, -) where - -import Data.Aeson (encode) -import qualified Data.ByteString.Char8 as BS -import qualified Data.UUID as U -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Wizard.Api.Resource.Questionnaire.QuestionnaireSettingsChangeDTO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireEventDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.API.Questionnaire.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- PUT /wizard-api/questionnaires/{qtnUuid}/settings --- ------------------------------------------------------------------------ -detail_settings_PUT :: AppContext -> SpecWith ((), Application) -detail_settings_PUT appContext = - describe "PUT /wizard-api/questionnaires/{qtnUuid}/settings" $ do - test_200 appContext - test_400 appContext - test_401 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodPut - -reqUrlT qtnUuid = BS.pack $ "/wizard-api/questionnaires/" ++ U.toString qtnUuid ++ "/settings" - -reqHeadersT authHeader = authHeader ++ [reqCtHeader] - -reqDtoT qtn = - QuestionnaireSettingsChangeDTO - { name = qtn.name - , description = qtn.description - , projectTags = qtn.projectTags - , documentTemplateId = qtn.documentTemplateId - , formatUuid = qtn.formatUuid - , isTemplate = qtn.isTemplate - } - -reqBodyT qtn = encode $ reqDtoT qtn - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = do - create_test_200 - "HTTP 200 OK (Owner, Private)" - appContext - questionnaire1 - questionnaire1SettingsEdited - questionnaire1Events - questionnaire1Ctn - [] - True - [reqAuthHeader] - False - create_test_200 - "HTTP 200 OK (Owner, VisibleView)" - appContext - questionnaire2 - questionnaire2SettingsEdited - questionnaire2Events - questionnaire2Ctn - [] - False - [reqAuthHeader] - False - create_test_200 - "HTTP 200 OK (Non-Owner, Private, Sharing, Anonymous Enabled)" - appContext - questionnaire10 - questionnaire10EditedSettings - questionnaire10Events - questionnaire10Ctn - [qtn10NikolaEditQtnPermDto] - False - [reqNonAdminAuthHeader] - True - -create_test_200 title appContext qtn qtnEdited qtnEvents qtnCtn permissions showComments authHeader anonymousEnabled = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT $ qtn.uuid - let reqHeaders = reqHeadersT authHeader - let reqBody = reqBodyT qtnEdited - -- AND: Prepare expectation - let expStatus = 200 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = reqDtoT qtnEdited - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - runInContextIO (insertQuestionnaire questionnaire10) appContext - runInContextIO (insertQuestionnaireEvents questionnaire10Events) appContext - -- AND: Enabled anonymous sharing - updateAnonymousQuestionnaireSharing appContext anonymousEnabled - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - -- AND: Find a result in DB - assertExistenceOfQuestionnaireInDB appContext qtnEdited qtnEvents - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_400 appContext = createInvalidJsonTest reqMethod (reqUrlT questionnaire3.uuid) "visibility" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = - createAuthTest reqMethod (reqUrlT questionnaire3.uuid) [reqCtHeader] (reqBodyT questionnaire1) - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = do - createNoPermissionTest - appContext - reqMethod - (reqUrlT questionnaire3.uuid) - [reqCtHeader] - (reqBodyT questionnaire1) - "QTN_PERM" - create_test_403 - "HTTP 403 FORBIDDEN (Non-Owner, Private)" - appContext - questionnaire1 - questionnaire1SettingsEdited - "Administrate Questionnaire" - create_test_403 - "HTTP 403 FORBIDDEN (Non-Owner, VisibleView)" - appContext - questionnaire2 - questionnaire2SettingsEdited - "Administrate Questionnaire" - create_test_403 - "HTTP 403 FORBIDDEN (Non-Owner, Private, Sharing, Anonymous Disabled)" - appContext - questionnaire10 - questionnaire10EditedSettings - "Administrate Questionnaire" - -create_test_403 title appContext qtn qtnEdited reason = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT $ qtn.uuid - let reqHeaders = reqHeadersT [reqNonAdminAuthHeader] - let reqBody = reqBodyT qtnEdited - -- AND: Prepare expectation - let expStatus = 403 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN reason - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - runInContextIO (insertQuestionnaire questionnaire10) appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - "/wizard-api/questionnaires/f08ead5f-746d-411b-aee6-77ea3d24016a/settings" - (reqHeadersT [reqAuthHeader]) - (reqBodyT questionnaire1) - "questionnaire" - [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Share_PUT.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Share_PUT.hs deleted file mode 100644 index 175eeeed9..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/Detail_Share_PUT.hs +++ /dev/null @@ -1,205 +0,0 @@ -module Wizard.Specs.API.Questionnaire.Detail_Share_PUT ( - detail_share_PUT, -) where - -import Data.Aeson (encode) -import qualified Data.ByteString.Char8 as BS -import qualified Data.UUID as U -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Wizard.Api.Resource.Questionnaire.QuestionnaireShareChangeDTO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireEventDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Service.Questionnaire.QuestionnaireMapper - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.API.Questionnaire.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- PUT /wizard-api/questionnaires/{qtnUuid}/share --- ------------------------------------------------------------------------ -detail_share_PUT :: AppContext -> SpecWith ((), Application) -detail_share_PUT appContext = - describe "PUT /wizard-api/questionnaires/{qtnUuid}/share" $ do - test_200 appContext - test_400 appContext - test_401 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodPut - -reqUrlT qtnUuid = BS.pack $ "/wizard-api/questionnaires/" ++ U.toString qtnUuid ++ "/share" - -reqHeadersT authHeader = authHeader ++ [reqCtHeader] - -reqDtoT qtn = - QuestionnaireShareChangeDTO - { visibility = qtn.visibility - , sharing = qtn.sharing - , permissions = fmap toQuestionnairePermChangeDTO qtn.permissions - } - -reqBodyT qtn = encode $ reqDtoT qtn - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = do - create_test_200 - "HTTP 200 OK (Owner, Private)" - appContext - questionnaire1 - questionnaire1ShareEdited - questionnaire1Events - questionnaire1Ctn - [] - True - [reqAuthHeader] - False - create_test_200 - "HTTP 200 OK (Owner, VisibleView)" - appContext - questionnaire2 - questionnaire2ShareEdited - questionnaire2Events - questionnaire2Ctn - [] - False - [reqAuthHeader] - False - create_test_200 - "HTTP 200 OK (Non-Owner, Private, Sharing, Anonymous Enabled)" - appContext - questionnaire10 - questionnaire10EditedShare - questionnaire10Events - questionnaire10Ctn - [qtn10NikolaEditQtnPermDto] - False - [reqNonAdminAuthHeader] - True - -create_test_200 title appContext qtn qtnEdited qtnEvents qtnCtn permissions showComments authHeader anonymousEnabled = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT $ qtn.uuid - let reqHeaders = reqHeadersT authHeader - let reqBody = reqBodyT qtnEdited - -- AND: Prepare expectation - let expStatus = 200 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = reqDtoT qtnEdited - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - runInContextIO (insertQuestionnaire questionnaire10) appContext - runInContextIO (insertQuestionnaireEvents questionnaire10Events) appContext - -- AND: Enabled anonymous sharing - updateAnonymousQuestionnaireSharing appContext anonymousEnabled - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - -- AND: Find a result in DB - assertExistenceOfQuestionnaireInDB appContext qtnEdited qtnEvents - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_400 appContext = createInvalidJsonTest reqMethod (reqUrlT questionnaire3.uuid) "visibility" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = - createAuthTest reqMethod (reqUrlT questionnaire3.uuid) [reqCtHeader] (reqBodyT questionnaire1) - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = do - createNoPermissionTest - appContext - reqMethod - (reqUrlT questionnaire3.uuid) - [reqCtHeader] - (reqBodyT questionnaire1) - "QTN_PERM" - create_test_403 - "HTTP 403 FORBIDDEN (Non-Owner, Private)" - appContext - questionnaire1 - questionnaire1ShareEdited - "Administrate Questionnaire" - create_test_403 - "HTTP 403 FORBIDDEN (Non-Owner, VisibleView)" - appContext - questionnaire2 - questionnaire2ShareEdited - "Administrate Questionnaire" - create_test_403 - "HTTP 403 FORBIDDEN (Non-Owner, Private, Sharing, Anonymous Disabled)" - appContext - questionnaire10 - questionnaire10EditedShare - "Administrate Questionnaire" - -create_test_403 title appContext qtn qtnEdited reason = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT $ qtn.uuid - let reqHeaders = reqHeadersT [reqNonAdminAuthHeader] - let reqBody = reqBodyT qtnEdited - -- AND: Prepare expectation - let expStatus = 403 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN reason - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - runInContextIO (insertQuestionnaire questionnaire10) appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - "/wizard-api/questionnaires/f08ead5f-746d-411b-aee6-77ea3d24016a/share" - (reqHeadersT [reqAuthHeader]) - (reqBodyT questionnaire1) - "questionnaire" - [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/Event/APISpec.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/Event/APISpec.hs deleted file mode 100644 index 17e29b286..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/Event/APISpec.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Wizard.Specs.API.Questionnaire.Event.APISpec where - -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) - -import Wizard.Specs.API.Common -import Wizard.Specs.API.Questionnaire.Event.Detail_GET -import Wizard.Specs.API.Questionnaire.Event.List_GET - -questionnaireEventAPI baseContext appContext = - with (startWebApp baseContext appContext) $ - describe "QUESTIONNAIRE EVENT API Spec" $ do - list_GET appContext - detail_GET appContext diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/Event/Detail_GET.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/Event/Detail_GET.hs deleted file mode 100644 index 6d30387ba..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/Event/Detail_GET.hs +++ /dev/null @@ -1,181 +0,0 @@ -module Wizard.Specs.API.Questionnaire.Event.Detail_GET ( - detail_GET, -) where - -import Data.Aeson (encode) -import qualified Data.ByteString.Char8 as BS -import qualified Data.UUID as U -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Common.Lens -import Shared.Common.Model.Error.Error -import Wizard.Database.DAO.Questionnaire.QuestionnaireCommentDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireCommentThreadDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireEventDAO -import Wizard.Database.DAO.Questionnaire.QuestionnairePermDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireVersionDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN -import Wizard.Database.Migration.Development.User.Data.Users -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireEventLenses () -import Wizard.Service.Questionnaire.Event.QuestionnaireEventMapper -import WizardLib.Public.Localization.Messages.Public - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- GET /wizard-api/questionnaires/{qtnUuid}/events/{eventUuid} --- ------------------------------------------------------------------------ -detail_GET :: AppContext -> SpecWith ((), Application) -detail_GET appContext = - describe "GET /wizard-api/questionnaires/{qtnUuid}/events/{eventUuid}" $ do - test_200 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodGet - -reqUrlT qtnUuid qtnEventUuid = - BS.pack $ "/wizard-api/questionnaires/" ++ U.toString qtnUuid ++ "/events/" ++ U.toString qtnEventUuid - -reqHeadersT authHeader = authHeader - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = do - create_test_200 "HTTP 200 OK (Owner, Private)" appContext questionnaire1 questionnaire1Events (sre_rQ1' questionnaire1Uuid) [reqAuthHeader] - create_test_200 "HTTP 200 OK (Non-Owner, VisibleView)" appContext questionnaire2 questionnaire2Events (sre_rQ1' questionnaire2Uuid) [reqNonAdminAuthHeader] - create_test_200 - "HTTP 200 OK (Commenter)" - appContext - (questionnaire13 {visibility = PrivateQuestionnaire}) - questionnaire13Events - (sre_rQ1' questionnaire13Uuid) - [reqNonAdminAuthHeader] - create_test_200 - "HTTP 200 OK (Non-Commenter, VisibleComment)" - appContext - questionnaire13 - questionnaire13Events - (sre_rQ1' questionnaire13Uuid) - [reqIsaacAuthTokenHeader] - create_test_200 - "HTTP 200 OK (Anonymous, VisibleComment, AnyoneWithLinkComment)" - appContext - (questionnaire13 {sharing = AnyoneWithLinkCommentQuestionnaire}) - questionnaire13Events - (sre_rQ1' questionnaire13Uuid) - [] - create_test_200 "HTTP 200 OK (Anonymous, VisibleView, Sharing)" appContext questionnaire7 questionnaire7Events (sre_rQ1' questionnaire7Uuid) [] - create_test_200 "HTTP 200 OK (Non-Owner, VisibleEdit)" appContext questionnaire3 questionnaire3Events (sre_rQ1' questionnaire3Uuid) [reqNonAdminAuthHeader] - create_test_200 "HTTP 200 OK (Anonymous, Public, Sharing)" appContext questionnaire10 questionnaire10Events (sre_rQ1' questionnaire10Uuid) [] - -create_test_200 title appContext qtn qtnEvents qtnEvent authHeader = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT qtn.uuid (getUuid qtnEvent) - let reqHeaders = reqHeadersT authHeader - -- AND: Prepare expectation - let expStatus = 200 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = toEventDTO qtnEvent (Just userAlbert) - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - runInContextIO deleteQuestionnaireVersions appContext - runInContextIO deleteQuestionnaireEvents appContext - runInContextIO deleteQuestionnaireComments appContext - runInContextIO deleteQuestionnaireCommentThreads appContext - runInContextIO deleteQuestionnairePerms appContext - runInContextIO deleteQuestionnaires appContext - runInContextIO (insertQuestionnaire qtn) appContext - runInContextIO (insertQuestionnaireEvents qtnEvents) appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = do - create_test_403 - "HTTP 403 FORBIDDEN (Non-Owner, Private)" - appContext - questionnaire1 - (sre_rQ1' questionnaire1Uuid) - [reqNonAdminAuthHeader] - (_ERROR_VALIDATION__FORBIDDEN "View Questionnaire") - create_test_403 - "HTTP 403 FORBIDDEN (Anonymous, VisibleView)" - appContext - questionnaire2 - (sre_rQ1' questionnaire2Uuid) - [] - _ERROR_SERVICE_USER__MISSING_USER - create_test_403 - "HTTP 403 FORBIDDEN (Anonymous, Public)" - appContext - questionnaire3 - (sre_rQ1' questionnaire3Uuid) - [] - _ERROR_SERVICE_USER__MISSING_USER - -create_test_403 title appContext qtn qtnEvent authHeader errorMessage = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT qtn.uuid (getUuid qtnEvent) - let reqHeaders = reqHeadersT authHeader - -- AND: Prepare expectation - let expStatus = 403 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = ForbiddenError errorMessage - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - "/wizard-api/questionnaires/f08ead5f-746d-411b-aee6-77ea3d24016a/events" - [reqHeadersT reqAuthHeader] - reqBody - "questionnaire" - [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/Event/List_GET.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/Event/List_GET.hs deleted file mode 100644 index 6de08b466..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/Event/List_GET.hs +++ /dev/null @@ -1,167 +0,0 @@ -module Wizard.Specs.API.Questionnaire.Event.List_GET ( - list_GET, -) where - -import Data.Aeson (encode) -import qualified Data.ByteString.Char8 as BS -import qualified Data.UUID as U -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.PageMetadata -import Shared.Common.Model.Error.Error -import Wizard.Database.DAO.Questionnaire.QuestionnaireCommentDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireCommentThreadDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireEventDAO -import Wizard.Database.DAO.Questionnaire.QuestionnairePermDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireVersionDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire -import WizardLib.Public.Localization.Messages.Public - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- GET /wizard-api/questionnaires/{qtnUuid}/events --- ------------------------------------------------------------------------ -list_GET :: AppContext -> SpecWith ((), Application) -list_GET appContext = - describe "GET /wizard-api/questionnaires/{qtnUuid}/events" $ do - test_200 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodGet - -reqUrlT qtnUuid = BS.pack $ "/wizard-api/questionnaires/" ++ U.toString qtnUuid ++ "/events" - -reqHeadersT authHeader = authHeader - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = do - create_test_200 "HTTP 200 OK (Owner, Private)" appContext questionnaire1 questionnaire1Events [reqAuthHeader] - create_test_200 "HTTP 200 OK (Non-Owner, VisibleView)" appContext questionnaire2 questionnaire2Events [reqNonAdminAuthHeader] - create_test_200 - "HTTP 200 OK (Commenter)" - appContext - (questionnaire13 {visibility = PrivateQuestionnaire}) - questionnaire13Events - [reqNonAdminAuthHeader] - create_test_200 "HTTP 200 OK (Non-Commenter, VisibleComment)" appContext questionnaire13 questionnaire13Events [reqIsaacAuthTokenHeader] - create_test_200 - "HTTP 200 OK (Anonymous, VisibleComment, AnyoneWithLinkComment)" - appContext - (questionnaire13 {sharing = AnyoneWithLinkCommentQuestionnaire}) - questionnaire13Events - [] - create_test_200 "HTTP 200 OK (Anonymous, VisibleView, Sharing)" appContext questionnaire7 questionnaire7Events [] - create_test_200 "HTTP 200 OK (Non-Owner, VisibleEdit)" appContext questionnaire3 questionnaire3Events [reqNonAdminAuthHeader] - create_test_200 "HTTP 200 OK (Anonymous, Public, Sharing)" appContext questionnaire10 questionnaire10Events [] - -create_test_200 title appContext qtn qtnEvents authHeader = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT qtn.uuid - let reqHeaders = reqHeadersT authHeader - -- AND: Prepare expectation - let expStatus = 200 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = Page "questionnaireEvents" (PageMetadata 20 16 1 0) (fEventsDto qtn.uuid) - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - runInContextIO deleteQuestionnaireVersions appContext - runInContextIO deleteQuestionnaireEvents appContext - runInContextIO deleteQuestionnaireComments appContext - runInContextIO deleteQuestionnaireCommentThreads appContext - runInContextIO deleteQuestionnairePerms appContext - runInContextIO deleteQuestionnaires appContext - runInContextIO (insertQuestionnaire qtn) appContext - runInContextIO (insertQuestionnaireEvents qtnEvents) appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = do - create_test_403 - "HTTP 403 FORBIDDEN (Non-Owner, Private)" - appContext - questionnaire1 - [reqNonAdminAuthHeader] - (_ERROR_VALIDATION__FORBIDDEN "View Questionnaire") - create_test_403 - "HTTP 403 FORBIDDEN (Anonymous, VisibleView)" - appContext - questionnaire2 - [] - _ERROR_SERVICE_USER__MISSING_USER - create_test_403 - "HTTP 403 FORBIDDEN (Anonymous, Public)" - appContext - questionnaire3 - [] - _ERROR_SERVICE_USER__MISSING_USER - -create_test_403 title appContext qtn authHeader errorMessage = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT qtn.uuid - let reqHeaders = reqHeadersT authHeader - -- AND: Prepare expectation - let expStatus = 403 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = ForbiddenError errorMessage - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - "/wizard-api/questionnaires/f08ead5f-746d-411b-aee6-77ea3d24016a/events" - [reqHeadersT reqAuthHeader] - reqBody - "questionnaire" - [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/List_GET.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/List_GET.hs deleted file mode 100644 index ed83aafd2..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/List_GET.hs +++ /dev/null @@ -1,273 +0,0 @@ -module Wizard.Specs.API.Questionnaire.List_GET ( - list_GET, -) where - -import Data.Aeson (encode) -import qualified Data.ByteString.Char8 as BS -import qualified Data.UUID as U -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.PageMetadata -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Api.Resource.Questionnaire.QuestionnaireDTO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN -import Wizard.Database.Migration.Development.User.Data.Users -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Context.AppContext -import Wizard.Model.User.User - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- GET /wizard-api/questionnaires --- ------------------------------------------------------------------------ -list_GET :: AppContext -> SpecWith ((), Application) -list_GET appContext = - describe "GET /wizard-api/questionnaires" $ do - test_200 appContext - test_401 appContext - test_403 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodGet - -reqUrl = "/wizard-api/questionnaires" - -reqHeadersT reqAuthHeader = [reqAuthHeader] - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = do - create_test_200 - "HTTP 200 OK (Admin - pagination)" - appContext - "/wizard-api/questionnaires?sort=uuid,asc&page=1&size=1" - reqAuthHeader - (Page "questionnaires" (PageMetadata 1 6 6 1) [questionnaire14Dto]) - create_test_200 - "HTTP 200 OK (Admin - query)" - appContext - "/wizard-api/questionnaires?sort=uuid,asc&q=pr" - reqAuthHeader - (Page "questionnaires" (PageMetadata 20 2 1 0) [questionnaire1Dto, questionnaire12Dto]) - create_test_200 - "HTTP 200 OK (Admin - userUuids)" - appContext - (BS.pack $ "/wizard-api/questionnaires?sort=uuid,asc&userUuids=" ++ U.toString userAlbert.uuid) - reqAuthHeader - (Page "questionnaires" (PageMetadata 20 3 1 0) [questionnaire1Dto, questionnaire2Dto, questionnaire12Dto]) - create_test_200 - "HTTP 200 OK (Admin - userUuids, or)" - appContext - ( BS.pack $ - "/wizard-api/questionnaires?sort=uuid,asc&userUuidsOp=or&userUuids=" - ++ U.toString userAlbert.uuid - ++ "," - ++ U.toString userIsaac.uuid - ) - reqAuthHeader - (Page "questionnaires" (PageMetadata 20 3 1 0) [questionnaire1Dto, questionnaire2Dto, questionnaire12Dto]) - create_test_200 - "HTTP 200 OK (Admin - userUuids, and)" - appContext - ( BS.pack $ - "/wizard-api/questionnaires?sort=uuid,asc&userUuidsOp=and&userUuids=" - ++ U.toString userAlbert.uuid - ++ "," - ++ U.toString userIsaac.uuid - ) - reqAuthHeader - (Page "questionnaires" (PageMetadata 20 0 0 0) ([] :: [QuestionnaireDTO])) - create_test_200 - "HTTP 200 OK (Admin - isTemplate - true)" - appContext - "/wizard-api/questionnaires?sort=uuid,asc&isTemplate=true" - reqAuthHeader - (Page "questionnaires" (PageMetadata 20 3 1 0) [questionnaire14Dto, questionnaire1Dto, questionnaire12Dto]) - create_test_200 - "HTTP 200 OK (Admin - isTemplate - false)" - appContext - "/wizard-api/questionnaires?sort=uuid,asc&isTemplate=false" - reqAuthHeader - (Page "questionnaires" (PageMetadata 20 3 1 0) [questionnaire3Dto, questionnaire15Dto, questionnaire2Dto]) - create_test_200 - "HTTP 200 OK (Admin - isMigrating - true)" - appContext - "/wizard-api/questionnaires?sort=uuid,asc&isMigrating=true" - reqAuthHeader - (Page "questionnaires" (PageMetadata 20 0 0 0) ([] :: [QuestionnaireDTO])) - create_test_200 - "HTTP 200 OK (Admin - isMigrating - false)" - appContext - "/wizard-api/questionnaires?sort=uuid,asc&isMigrating=false" - reqAuthHeader - ( Page - "questionnaires" - (PageMetadata 20 6 1 0) - [questionnaire3Dto, questionnaire14Dto, questionnaire1Dto, questionnaire15Dto, questionnaire2Dto, questionnaire12Dto] - ) - create_test_200 - "HTTP 200 OK (Admin - projectTags)" - appContext - "/wizard-api/questionnaires?sort=uuid,asc&projectTags=projectTag1" - reqAuthHeader - ( Page - "questionnaires" - (PageMetadata 20 4 1 0) - [questionnaire14Dto, questionnaire1Dto, questionnaire2Dto, questionnaire12Dto] - ) - create_test_200 - "HTTP 200 OK (Admin - projectTags, or)" - appContext - "/wizard-api/questionnaires?sort=uuid,asc&projectTagsOp=or&projectTags=projectTag1,projectTag2" - reqAuthHeader - ( Page - "questionnaires" - (PageMetadata 20 4 1 0) - [questionnaire14Dto, questionnaire1Dto, questionnaire2Dto, questionnaire12Dto] - ) - create_test_200 - "HTTP 200 OK (Admin - projectTags, and)" - appContext - "/wizard-api/questionnaires?sort=uuid,asc&projectTagsOp=and&projectTags=projectTag1,projectTag2" - reqAuthHeader - (Page "questionnaires" (PageMetadata 20 1 1 0) [questionnaire2Dto]) - create_test_200 - "HTTP 200 OK (Admin - knowledgePackage)" - appContext - "/wizard-api/questionnaires?sort=uuid,asc&knowledgeModelPackageIds=org.nl.amsterdam:core-amsterdam:all" - reqAuthHeader - (Page "questionnaires" (PageMetadata 20 1 1 0) [questionnaire14Dto]) - create_test_200 - "HTTP 200 OK (Admin - sort asc)" - appContext - "/wizard-api/questionnaires?sort=uuid,asc" - reqAuthHeader - ( Page - "questionnaires" - (PageMetadata 20 6 1 0) - [questionnaire3Dto, questionnaire14Dto, questionnaire1Dto, questionnaire15Dto, questionnaire2Dto, questionnaire12Dto] - ) - create_test_200 - "HTTP 200 OK (Admin - sort desc)" - appContext - "/wizard-api/questionnaires?sort=updatedAt,desc" - reqAuthHeader - ( Page - "questionnaires" - (PageMetadata 20 6 1 0) - [questionnaire15Dto, questionnaire3Dto, questionnaire14Dto, questionnaire1Dto, questionnaire12Dto, questionnaire2Dto] - ) - create_test_200 - "HTTP 200 OK (Non-Admin)" - appContext - "/wizard-api/questionnaires?sort=uuid,asc" - reqNonAdminAuthHeader - ( Page - "questionnaires" - (PageMetadata 20 5 1 0) - [questionnaire3Dto, questionnaire14Dto, questionnaire15Dto, questionnaire2Dto, questionnaire12Dto] - ) - create_test_200 - "HTTP 200 OK (Non-Admin - query)" - appContext - "/wizard-api/questionnaires?q=pr" - reqNonAdminAuthHeader - (Page "questionnaires" (PageMetadata 20 1 1 0) [questionnaire12Dto]) - create_test_200 - "HTTP 200 OK (Non-Admin - query users)" - appContext - (BS.pack $ "/wizard-api/questionnaires?sort=uuid,asc&userUuids=" ++ U.toString userAlbert.uuid) - reqNonAdminAuthHeader - (Page "questionnaires" (PageMetadata 20 2 1 0) [questionnaire2Dto, questionnaire12Dto]) - create_test_200 - "HTTP 200 OK (Non-Admin - projectTags)" - appContext - "/wizard-api/questionnaires?sort=uuid,asc&projectTags=projectTag1" - reqNonAdminAuthHeader - (Page "questionnaires" (PageMetadata 20 3 1 0) [questionnaire14Dto, questionnaire2Dto, questionnaire12Dto]) - create_test_200 - "HTTP 200 OK (Non-Admin - knowledgeModelPackage)" - appContext - "/wizard-api/questionnaires?sort=uuid,asc&knowledgeModelPackageIds=org.nl.amsterdam:core-amsterdam:all" - reqNonAdminAuthHeader - (Page "questionnaires" (PageMetadata 20 1 1 0) [questionnaire14Dto]) - create_test_200 - "HTTP 200 OK (Non-Admin - isTemplate - true)" - appContext - "/wizard-api/questionnaires?sort=uuid,asc&isTemplate=true" - reqNonAdminAuthHeader - (Page "questionnaires" (PageMetadata 20 2 1 0) [questionnaire14Dto, questionnaire12Dto]) - create_test_200 - "HTTP 200 OK (Non-Admin - isTemplate - false)" - appContext - "/wizard-api/questionnaires?sort=uuid,asc&isTemplate=false" - reqNonAdminAuthHeader - (Page "questionnaires" (PageMetadata 20 3 1 0) [questionnaire3Dto, questionnaire15Dto, questionnaire2Dto]) - create_test_200 - "HTTP 200 OK (Non-Admin - isMigrating - true)" - appContext - "/wizard-api/questionnaires?sort=uuid,asc&isMigrating=true" - reqNonAdminAuthHeader - (Page "questionnaires" (PageMetadata 20 0 0 0) ([] :: [QuestionnaireDTO])) - create_test_200 - "HTTP 200 OK (Non-Admin - isMigrating - false)" - appContext - "/wizard-api/questionnaires?sort=uuid,asc&isMigrating=false" - reqNonAdminAuthHeader - ( Page - "questionnaires" - (PageMetadata 20 5 1 0) - [questionnaire3Dto, questionnaire14Dto, questionnaire15Dto, questionnaire2Dto, questionnaire12Dto] - ) - -create_test_200 title appContext reqUrl reqAuthHeader expDto = - it title $ - -- GIVEN: Prepare request - do - let reqHeaders = reqHeadersT reqAuthHeader - -- AND: Prepare expectation - let expStatus = 200 - let expHeaders = resCtHeader : resCorsHeaders - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - runInContextIO (insertPackage amsterdamKmPackage) appContext - runInContextIO (insertQuestionnaire questionnaire12) appContext - runInContextIO (insertQuestionnaire questionnaire14) appContext - runInContextIO (insertQuestionnaire questionnaire15) appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod reqUrl [reqCtHeader] reqBody - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [reqCtHeader] reqBody "QTN_PERM" diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/List_POST.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/List_POST.hs deleted file mode 100644 index 2985aaf77..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/List_POST.hs +++ /dev/null @@ -1,142 +0,0 @@ -module Wizard.Specs.API.Questionnaire.List_POST ( - list_POST, -) where - -import Data.Aeson (encode) -import Data.Foldable (traverse_) -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Api.Resource.Questionnaire.QuestionnaireCreateDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireCreateJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireDTO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireEventDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnairePerm - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.API.Questionnaire.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- POST /wizard-api/questionnaires --- ------------------------------------------------------------------------ -list_POST :: AppContext -> SpecWith ((), Application) -list_POST appContext = - describe "POST /wizard-api/questionnaires" $ do - test_201 appContext - test_400 appContext - test_403 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodPost - -reqUrl = "/wizard-api/questionnaires" - -reqHeadersT authHeader = authHeader ++ [reqCtHeader] - -reqDtoT qtn = qtn - -reqBodyT qtn = encode (reqDtoT qtn) - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_201 appContext = do - create_test_201 appContext "HTTP 201 CREATED (with token)" False questionnaire1Create [reqAuthHeader] - create_test_201 - appContext - "HTTP 201 CREATED (without token)" - True - (questionnaire1Create {sharing = AnyoneWithLinkEditQuestionnaire} :: QuestionnaireCreateDTO) - [] - -create_test_201 appContext title anonymousSharingEnabled qtn authHeader = - it title $ - -- GIVEN: Prepare request - do - let reqHeaders = reqHeadersT authHeader - let reqBody = reqBodyT qtn - -- AND: Prepare expectation - let expStatus = 201 - let expHeaders = resCtHeaderPlain : resCorsHeadersPlain - let expDto = - if anonymousSharingEnabled - then questionnaire1Dto {sharing = AnyoneWithLinkEditQuestionnaire} :: QuestionnaireDTO - else questionnaire1Dto - let expBody = encode expDto - -- AND: Run migrations - runInContextIO TML.runMigration appContext - runInContextIO (insertPackage germanyKmPackage) appContext - runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - runInContextIO deleteQuestionnaires appContext - -- AND: Enabled anonymous sharing - updateAnonymousQuestionnaireSharing appContext anonymousSharingEnabled - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let (status, headers, resBody) = destructResponse response :: (Int, ResponseHeaders, QuestionnaireDTO) - assertResStatus status expStatus - assertResHeaders headers expHeaders - compareQuestionnaireCreateDtos resBody expDto - -- AND: Find a result in DB - (Right eventsInDB) <- runInContextIO (findQuestionnaireEventsByQuestionnaireUuid resBody.uuid) appContext - if anonymousSharingEnabled - then - assertExistenceOfQuestionnaireInDB - appContext - ( questionnaire1 - { uuid = resBody.uuid - , description = Nothing - , isTemplate = False - , sharing = AnyoneWithLinkEditQuestionnaire - , projectTags = [] - , permissions = [] - , creatorUuid = Nothing - } - :: Questionnaire - ) - eventsInDB - else do - let aPermissions = - [ (head questionnaire1.permissions) - { questionnaireUuid = resBody.uuid - } - :: QuestionnairePerm - ] - assertExistenceOfQuestionnaireInDB - appContext - ( questionnaire1 - { uuid = resBody.uuid - , description = Nothing - , isTemplate = False - , projectTags = [] - , permissions = aPermissions - } - :: Questionnaire - ) - eventsInDB - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_400 appContext = createInvalidJsonTest reqMethod reqUrl "packageId" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = - createNoPermissionTest appContext reqMethod reqUrl [reqCtHeader] (reqBodyT questionnaire1Create) "QTN_PERM" diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/List_POST_CloneUuid.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/List_POST_CloneUuid.hs deleted file mode 100644 index 66c14283c..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/List_POST_CloneUuid.hs +++ /dev/null @@ -1,134 +0,0 @@ -module Wizard.Specs.API.Questionnaire.List_POST_CloneUuid ( - list_POST_cloneUuid, -) where - -import Data.Aeson (encode) -import qualified Data.ByteString.Char8 as BS -import qualified Data.UUID as U -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Wizard.Api.Resource.Questionnaire.QuestionnaireCreateJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireDTO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.API.Questionnaire.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- POST /wizard-api/questionnaires?cloneUuid={qtnUuid} --- ------------------------------------------------------------------------ -list_POST_cloneUuid :: AppContext -> SpecWith ((), Application) -list_POST_cloneUuid appContext = - describe "POST /wizard-api/questionnaires/{qtnUuid}/clone" $ do - test_201 appContext - test_401 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodPost - -reqUrlT qtnUuid = BS.pack $ "/wizard-api/questionnaires/" ++ U.toString qtnUuid ++ "/clone" - -reqHeadersT authHeader = [authHeader] - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_201 appContext = do - create_test_201 "HTTP 200 OK (Owner, Private)" appContext questionnaire1Dto - create_test_201 "HTTP 200 OK (Owner, VisibleView)" appContext questionnaire2Dto - create_test_201 "HTTP 200 OK (Non-Owner, VisibleEdit)" appContext questionnaire3Dto - -create_test_201 title appContext qtn = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT $ qtn.uuid - let reqHeaders = reqHeadersT reqAuthHeader - -- AND: Prepare expectation - let expStatus = 201 - let expHeaders = resCtHeaderPlain : resCorsHeadersPlain - let expDto = qtn - let expBody = encode expDto - -- AND: Run migrations - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let (status, headers, resBody) = destructResponse response :: (Int, ResponseHeaders, QuestionnaireDTO) - assertResStatus status expStatus - assertResHeaders headers expHeaders - compareQuestionnaireCloneDtos resBody expDto - -- AND: Find a result in DB - assertCountInDB findQuestionnaires appContext 4 - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod (reqUrlT questionnaire3.uuid) [] reqBody - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = - create_test_403 - "HTTP 403 FORBIDDEN (Non-Owner, Private)" - appContext - questionnaire1 - questionnaire1Edited - "View Questionnaire" - -create_test_403 title appContext qtn qtnEdited reason = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT $ qtn.uuid - let reqHeaders = reqHeadersT reqNonAdminAuthHeader - -- AND: Prepare expectation - let expStatus = 403 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN reason - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - "/wizard-api/questionnaires/f08ead5f-746d-411b-aee6-77ea3d24016a/clone" - (reqHeadersT reqAuthHeader) - reqBody - "questionnaire" - [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/List_POST_FromTemplate.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/List_POST_FromTemplate.hs deleted file mode 100644 index 0b0f1ce0a..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/List_POST_FromTemplate.hs +++ /dev/null @@ -1,144 +0,0 @@ -module Wizard.Specs.API.Questionnaire.List_POST_FromTemplate ( - list_POST_fromTemplate, -) where - -import Data.Aeson (encode) -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Wizard.Api.Resource.Questionnaire.QuestionnaireCreateFromTemplateDTO -import Wizard.Api.Resource.Questionnaire.QuestionnaireCreateJM () -import Wizard.Api.Resource.Questionnaire.QuestionnaireDTO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN_Migration -import qualified Wizard.Database.Migration.Development.User.UserMigration as U_Migration -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Tenant.Config.TenantConfig hiding (request) -import Wizard.Service.Tenant.Config.ConfigService - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.API.Questionnaire.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- POST /wizard-api/questionnaires?fromTemplate=true --- ------------------------------------------------------------------------ -list_POST_fromTemplate :: AppContext -> SpecWith ((), Application) -list_POST_fromTemplate appContext = - describe "POST /wizard-api/questionnaires/from-template" $ do - test_201 appContext - test_400 appContext - test_403 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodPost - -reqUrl = "/wizard-api/questionnaires/from-template" - -reqHeadersT authHeader = authHeader ++ [reqCtHeader] - -reqDtoT qtnTmlUuid name = - QuestionnaireCreateFromTemplateDTO - { name = name - , questionnaireUuid = qtnTmlUuid - } - -reqBodyT qtnTmlUuid name = encode (reqDtoT qtnTmlUuid name) - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_201 appContext = - it "HTTP 200 OK" $ - -- GIVEN: Prepare request - do - let reqHeaders = reqHeadersT [reqAuthHeader] - let reqBody = reqBodyT questionnaire1.uuid questionnaire11.name - -- AND: Prepare expectation - let expStatus = 201 - let expHeaders = resCtHeaderPlain : resCorsHeadersPlain - let expDto = questionnaire11Dto - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U_Migration.runMigration appContext - runInContextIO TML_Migration.runMigration appContext - runInContextIO QTN_Migration.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let (status, headers, resBody) = destructResponse response :: (Int, ResponseHeaders, QuestionnaireDTO) - assertResStatus status expStatus - assertResHeaders headers expHeaders - compareQuestionnaireCreateFromTemplateDtos resBody expDto - -- AND: Find a result in DB - assertCountInDB findQuestionnaires appContext 4 - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_400 appContext = - it "HTTP 400 BAD REQUEST (questionnaireCreation: CustomQuestionnaireCreation)" $ - -- GIVEN: Prepare request - do - let reqHeaders = reqHeadersT [reqAuthHeader] - let reqBody = reqBodyT questionnaire2.uuid questionnaire11.name - -- AND: Prepare expectation - let expStatus = 400 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = UserError . _ERROR_SERVICE_COMMON__FEATURE_IS_DISABLED $ "Questionnaire Template" - let expBody = encode expDto - -- AND: Change tenantConfig - (Right tcQuestionnaire) <- runInContextIO getCurrentTenantConfigQuestionnaire appContext - let tcQuestionnaireUpdated = tcQuestionnaire {questionnaireCreation = CustomQuestionnaireCreation} - runInContextIO (modifyTenantConfigQuestionnaire tcQuestionnaireUpdated) appContext - -- AND: Run migrations - runInContextIO U_Migration.runMigration appContext - runInContextIO TML_Migration.runMigration appContext - runInContextIO QTN_Migration.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - -- AND: Find a result in DB - assertCountInDB findQuestionnaires appContext 3 - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = - it "HTTP 403 FORBIDDEN (isTemplate: False)" $ - -- GIVEN: Prepare request - do - let reqHeaders = reqHeadersT [reqAuthHeader] - let reqBody = reqBodyT questionnaire2.uuid questionnaire11.name - -- AND: Prepare expectation - let expStatus = 403 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN "Questionnaire Template" - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U_Migration.runMigration appContext - runInContextIO TML_Migration.runMigration appContext - runInContextIO QTN_Migration.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - -- AND: Find a result in DB - assertCountInDB findQuestionnaires appContext 3 diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/ProjectTag/APISpec.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/ProjectTag/APISpec.hs deleted file mode 100644 index edb656917..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/ProjectTag/APISpec.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Specs.API.Questionnaire.ProjectTag.APISpec where - -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) - -import Wizard.Specs.API.Common -import Wizard.Specs.API.Questionnaire.ProjectTag.List_Suggestions_GET - -questionnaireProjectTagAPI baseContext appContext = - with (startWebApp baseContext appContext) $ - describe "QUESTIONNAIRE PROJECT TAG API Spec" $ - do list_suggestions_GET appContext diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/ProjectTag/List_Suggestions_GET.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/ProjectTag/List_Suggestions_GET.hs deleted file mode 100644 index 4640d9af5..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/ProjectTag/List_Suggestions_GET.hs +++ /dev/null @@ -1,102 +0,0 @@ -module Wizard.Specs.API.Questionnaire.ProjectTag.List_Suggestions_GET ( - list_suggestions_GET, -) where - -import Data.Aeson (encode) -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.PageMetadata -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN_Migration -import Wizard.Database.Migration.Development.Tenant.Data.TenantConfigs -import Wizard.Model.Context.AppContext - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- GET /wizard-api/questionnaires/project-tags/suggestions --- ------------------------------------------------------------------------ -list_suggestions_GET :: AppContext -> SpecWith ((), Application) -list_suggestions_GET appContext = - describe "GET /wizard-api/questionnaires/project-tags/suggestions" $ do - test_200 appContext - test_401 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodGet - -reqUrl = "/wizard-api/questionnaires/project-tags/suggestions" - -reqHeaders = [reqAuthHeader] - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = do - create_test_200 - "HTTP 200 OK (All)" - appContext - "/wizard-api/questionnaires/project-tags/suggestions?sort=projectTag,asc" - ( Page - "projectTags" - (PageMetadata 20 4 1 0) - [_QUESTIONNAIRE_PROJECT_TAG_1, _QUESTIONNAIRE_PROJECT_TAG_2, _SETTINGS_PROJECT_TAG_1, _SETTINGS_PROJECT_TAG_2] - ) - create_test_200 - "HTTP 200 OK (pagination)" - appContext - "/wizard-api/questionnaires/project-tags/suggestions?sort=projectTag,asc&page=1&size=1" - (Page "projectTags" (PageMetadata 1 4 4 1) [_QUESTIONNAIRE_PROJECT_TAG_2]) - create_test_200 - "HTTP 200 OK (query)" - appContext - "/wizard-api/questionnaires/project-tags/suggestions?sort=projectTag,asc&q=settingsProject" - (Page "projectTags" (PageMetadata 20 2 1 0) [_SETTINGS_PROJECT_TAG_1, _SETTINGS_PROJECT_TAG_2]) - create_test_200 - "HTTP 200 OK (exclude)" - appContext - "/wizard-api/questionnaires/project-tags/suggestions?sort=projectTag,asc&exclude=settingsProjectTag2" - ( Page - "projectTags" - (PageMetadata 20 3 1 0) - [_QUESTIONNAIRE_PROJECT_TAG_1, _QUESTIONNAIRE_PROJECT_TAG_2, _SETTINGS_PROJECT_TAG_1] - ) - create_test_200 - "HTTP 200 OK (query, exclude)" - appContext - "/wizard-api/questionnaires/project-tags/suggestions?sort=projectTag,asc&q=settings&exclude=settingsProjectTag2" - (Page "projectTags" (PageMetadata 20 1 1 0) [_SETTINGS_PROJECT_TAG_1]) - -create_test_200 title appContext reqUrl expDto = - it title $ - -- GIVEN: Prepare request - do - let expStatus = 200 - let expHeaders = resCtHeader : resCorsHeaders - let expBody = encode expDto - -- AND: Run migrations - runInContextIO TML_Migration.runMigration appContext - runInContextIO QTN_Migration.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- AND: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod reqUrl [] reqBody diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/User/APISpec.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/User/APISpec.hs deleted file mode 100644 index ce43b1aa7..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/User/APISpec.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Wizard.Specs.API.Questionnaire.User.APISpec where - -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) - -import Wizard.Specs.API.Common -import Wizard.Specs.API.Questionnaire.User.List_Suggestions_GET - -questionnaireUserAPI baseContext appContext = - with (startWebApp baseContext appContext) $ - describe "QUESTIONNAIRE USER API Spec" $ - list_suggestions_GET appContext diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/User/List_Suggestions_GET.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/User/List_Suggestions_GET.hs deleted file mode 100644 index c9c8546ed..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/User/List_Suggestions_GET.hs +++ /dev/null @@ -1,191 +0,0 @@ -module Wizard.Specs.API.Questionnaire.User.List_Suggestions_GET ( - list_suggestions_GET, -) where - -import Data.Aeson (encode) -import qualified Data.ByteString.Char8 as BS -import Data.Foldable (traverse_) -import qualified Data.UUID as U -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.PageMetadata -import Shared.Common.Model.Error.Error -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Database.Migration.Development.User.Data.Users -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Service.User.UserMapper -import WizardLib.Public.Localization.Messages.Public - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- GET /wizard-api/questionnaires/{qtnUuid}/users/suggestions --- ------------------------------------------------------------------------ -list_suggestions_GET :: AppContext -> SpecWith ((), Application) -list_suggestions_GET appContext = - describe "GET /wizard-api/questionnaires/{qtnUuid}/users/suggestions" $ do - test_200 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodGet - -reqUrlT qtnUuid query = BS.pack $ "/wizard-api/questionnaires/" ++ U.toString qtnUuid ++ "/users/suggestions?sort=uuid,asc" ++ query - -reqHeadersT authHeader = authHeader - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = do - create_test_200 - "HTTP 200 OK (Owner, Private)" - appContext - questionnaire1 - [reqAuthHeader] - (Page "users" (PageMetadata 20 1 1 0) (fmap (toSuggestion . toSimple) [userAlbert])) - create_test_200 - "HTTP 200 OK (Commenter)" - appContext - (questionnaire13 {visibility = PrivateQuestionnaire}) - [reqNonAdminAuthHeader] - (Page "users" (PageMetadata 20 1 1 0) (fmap (toSuggestion . toSimple) [userNikola])) - create_test_200 - "HTTP 200 OK (Non-Commenter, VisibleComment)" - appContext - questionnaire13 - [reqIsaacAuthTokenHeader] - (Page "users" (PageMetadata 20 3 1 0) (fmap (toSuggestion . toSimple) [userNikola, userIsaac, userAlbert])) - create_test_200 - "HTTP 200 OK (Anonymous, VisibleComment, AnyoneWithLinkComment)" - appContext - (questionnaire13 {sharing = AnyoneWithLinkCommentQuestionnaire}) - [] - (Page "users" (PageMetadata 20 3 1 0) (fmap (toSuggestion . toSimple) [userNikola, userIsaac, userAlbert])) - create_test_200 - "HTTP 200 OK (Non-Owner, VisibleEdit)" - appContext - questionnaire3 - [reqNonAdminAuthHeader] - (Page "users" (PageMetadata 20 3 1 0) (fmap (toSuggestion . toSimple) [userNikola, userIsaac, userAlbert])) - create_test_200 - "HTTP 200 OK (Anonymous, Public, Sharing)" - appContext - questionnaire10 - [] - (Page "users" (PageMetadata 20 3 1 0) (fmap (toSuggestion . toSimple) [userNikola, userIsaac, userAlbert])) - -create_test_200 title appContext qtn authHeader expDto = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT qtn.uuid "" - let reqHeaders = reqHeadersT authHeader - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO (insertPackage germanyKmPackage) appContext - runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - runInContextIO (insertQuestionnaire qtn) appContext - -- AND: Prepare expectation - let expStatus = 200 - let expHeaders = resCtHeader : resCorsHeaders - let expBody = encode expDto - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = do - create_test_403 - "HTTP 403 FORBIDDEN (Non-Owner, Private)" - appContext - questionnaire1 - [reqNonAdminAuthHeader] - (_ERROR_VALIDATION__FORBIDDEN "Comment Questionnaire") - create_test_403 - "HTTP 200 OK (Non-Owner, VisibleView)" - appContext - questionnaire2 - [reqNonAdminAuthHeader] - (_ERROR_VALIDATION__FORBIDDEN "Comment Questionnaire") - create_test_403 - "HTTP 403 FORBIDDEN (Anonymous, VisibleView)" - appContext - questionnaire2 - [] - _ERROR_SERVICE_USER__MISSING_USER - create_test_403 - "HTTP 200 OK (Anonymous, VisibleView, Sharing)" - appContext - questionnaire7 - [] - _ERROR_SERVICE_USER__MISSING_USER - create_test_403 - "HTTP 403 FORBIDDEN (Anonymous, Public)" - appContext - questionnaire3 - [] - _ERROR_SERVICE_USER__MISSING_USER - -create_test_403 title appContext qtn authHeader errorMessage = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT qtn.uuid "" - let reqHeaders = reqHeadersT authHeader - -- AND: Prepare expectation - let expStatus = 403 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = ForbiddenError errorMessage - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO (insertPackage germanyKmPackage) appContext - runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - runInContextIO (insertQuestionnaire qtn) appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - "/wizard-api/questionnaires/f08ead5f-746d-411b-aee6-77ea3d24016a/users/suggestions" - [reqHeadersT reqAuthHeader] - reqBody - "questionnaire" - [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/Version/APISpec.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/Version/APISpec.hs deleted file mode 100644 index f6c845c0a..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/Version/APISpec.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Wizard.Specs.API.Questionnaire.Version.APISpec where - -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) - -import Wizard.Specs.API.Common -import Wizard.Specs.API.Questionnaire.Version.Detail_DELETE -import Wizard.Specs.API.Questionnaire.Version.Detail_PUT -import Wizard.Specs.API.Questionnaire.Version.List_GET -import Wizard.Specs.API.Questionnaire.Version.List_POST - -questionnaireVersionAPI baseContext appContext = - with (startWebApp baseContext appContext) $ - describe "QUESTIONNAIRE VERSION API Spec" $ do - list_GET appContext - list_POST appContext - detail_PUT appContext - detail_DELETE appContext diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/Version/Common.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/Version/Common.hs deleted file mode 100644 index 79b3032ca..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/Version/Common.hs +++ /dev/null @@ -1,40 +0,0 @@ -module Wizard.Specs.API.Questionnaire.Version.Common where - -import Data.Either (isLeft, isRight) -import qualified Data.UUID as U -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) - -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Wizard.Database.DAO.Questionnaire.QuestionnaireVersionDAO -import Wizard.Database.Migration.Development.Tenant.Data.Tenants -import Wizard.Model.Questionnaire.QuestionnaireVersion -import Wizard.Model.Tenant.Tenant - -import Wizard.Specs.Common - --- -------------------------------- --- ASSERTS --- -------------------------------- -assertExistenceOfQuestionnaireVersionInDB appContext version = do - eVersion <- runInContextIO (findQuestionnaireVersionByUuid version.uuid) appContext - liftIO $ isRight eVersion `shouldBe` True - let (Right versionFromDb) = eVersion - compareQuestionnaireVersionCreateDtos versionFromDb version - -assertAbsenceOfQuestionnaireVersionInDB appContext version = do - eVersion <- runInContextIO (findQuestionnaireVersionByUuid version.uuid) appContext - liftIO $ isLeft eVersion `shouldBe` True - let (Left error) = eVersion - liftIO $ - error - `shouldBe` NotExistsError - (_ERROR_DATABASE__ENTITY_NOT_FOUND "questionnaire_version" [("tenant_uuid", U.toString defaultTenant.uuid), ("uuid", U.toString version.uuid)]) - --- -------------------------------- --- COMPARATORS --- -------------------------------- -compareQuestionnaireVersionCreateDtos resDto expDto = do - liftIO $ resDto.name `shouldBe` expDto.name - liftIO $ resDto.eventUuid `shouldBe` expDto.eventUuid diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/Version/Detail_DELETE.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/Version/Detail_DELETE.hs deleted file mode 100644 index 2329300a1..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/Version/Detail_DELETE.hs +++ /dev/null @@ -1,82 +0,0 @@ -module Wizard.Specs.API.Questionnaire.Version.Detail_DELETE ( - detail_DELETE, -) where - -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Api.Resource.Error.ErrorJM () -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireVersions -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.QuestionnaireVersion - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.API.Questionnaire.Version.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- DELETE /wizard-api/questionnaires/{qtnUuid}/versions/{vUuid} --- ------------------------------------------------------------------------ -detail_DELETE :: AppContext -> SpecWith ((), Application) -detail_DELETE appContext = - describe "DELETE /wizard-api/questionnaires/{qtnUuid}/versions/{vUuid}" $ do - test_204 appContext - test_401 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodDelete - -reqUrl = "/wizard-api/questionnaires/af984a75-56e3-49f8-b16f-d6b99599910a/versions/af984a75-56e3-49f8-b16f-dd016270ce7e" - -reqHeaders = [reqAuthHeader, reqCtHeader] - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_204 appContext = - it "HTTP 204 NO CONTENT" $ - -- GIVEN: Prepare expectation - do - let expStatus = 204 - let expHeaders = resCtHeader : resCorsHeaders - let expBody = "" - -- AND: Run migrations - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - -- AND: Find a result in DB - assertAbsenceOfQuestionnaireVersionInDB appContext (questionnaireVersion1 questionnaire1Uuid) - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod reqUrl [] reqBody - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - "/wizard-api/questionnaires/00084a75-56e3-49f8-b16f-d6b99599910a/versions/00084a75-56e3-49f8-b16f-dd016270ce7e" - reqHeaders - reqBody - "questionnaire" - [("uuid", "00084a75-56e3-49f8-b16f-d6b99599910a")] diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/Version/Detail_PUT.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/Version/Detail_PUT.hs deleted file mode 100644 index 6a06061a5..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/Version/Detail_PUT.hs +++ /dev/null @@ -1,93 +0,0 @@ -module Wizard.Specs.API.Questionnaire.Version.Detail_PUT ( - detail_PUT, -) where - -import Data.Aeson (encode) -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) - -import Shared.Common.Api.Resource.Error.ErrorJM () -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireVersions -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.QuestionnaireVersion -import Wizard.Model.Questionnaire.QuestionnaireVersionList - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.API.Questionnaire.Version.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- PUT /wizard-api/questionnaires/{qtnUuid}/versions/{vUuid} --- ------------------------------------------------------------------------ -detail_PUT :: AppContext -> SpecWith ((), Application) -detail_PUT appContext = - describe "PUT /wizard-api/questionnaires/{qtnUuid}/versions/{vUuid}" $ do - test_200 appContext - test_400 appContext - test_401 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodPut - -reqUrl = "/wizard-api/questionnaires/af984a75-56e3-49f8-b16f-d6b99599910a/versions/af984a75-56e3-49f8-b16f-dd016270ce7e" - -reqHeaders = [reqAuthHeader, reqCtHeader] - -reqDto = questionnaireVersion1EditedChangeDto questionnaire1Uuid - -reqBody = encode reqDto - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = - it "HTTP 20O OK" $ - -- GIVEN: Prepare expectation - do - let expStatus = 200 - let expHeaders = resCtHeaderPlain : resCorsHeadersPlain - let expDto = questionnaireVersion1EditedList questionnaire1Uuid - let expBody = encode expDto - -- AND: Run migrations - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let (status, headers, resBody) = destructResponse response :: (Int, ResponseHeaders, QuestionnaireVersionList) - assertResStatus status expStatus - assertResHeaders headers expHeaders - compareQuestionnaireVersionCreateDtos resBody expDto - -- AND: Find a result in DB - assertExistenceOfQuestionnaireVersionInDB appContext (questionnaireVersion1Edited questionnaire1Uuid) - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_400 appContext = createInvalidJsonTest reqMethod reqUrl "name" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod reqUrl [reqCtHeader] reqBody - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - "/wizard-api/questionnaires/00084a75-56e3-49f8-b16f-d6b99599910a/versions/bd6611c8-ea11-48ab-adaa-3ce51b66aae5" - reqHeaders - reqBody - "questionnaire" - [("uuid", "00084a75-56e3-49f8-b16f-d6b99599910a")] diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/Version/List_GET.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/Version/List_GET.hs deleted file mode 100644 index 0849dc545..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/Version/List_GET.hs +++ /dev/null @@ -1,172 +0,0 @@ -module Wizard.Specs.API.Questionnaire.Version.List_GET ( - list_GET, -) where - -import Data.Aeson (encode) -import qualified Data.ByteString.Char8 as BS -import Data.Foldable (traverse_) -import qualified Data.UUID as U -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireEventDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireVersionDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireVersions -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire -import WizardLib.Public.Localization.Messages.Public - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- GET /wizard-api/questionnaires/{qtnUuid}/versions --- ------------------------------------------------------------------------ -list_GET :: AppContext -> SpecWith ((), Application) -list_GET appContext = - describe "GET /wizard-api/questionnaires/{qtnUuid}/versions" $ do - test_200 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodGet - -reqUrlT qtnUuid = BS.pack $ "/wizard-api/questionnaires/" ++ U.toString qtnUuid ++ "/versions" - -reqHeadersT authHeader = authHeader - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = do - create_test_200 - "HTTP 200 OK (Owner, Private)" - appContext - questionnaire1 - questionnaire1Ctn - [reqAuthHeader] - [qtn1AlbertEditQtnPermDto] - create_test_200 - "HTTP 200 OK (Non-Owner, VisibleView)" - appContext - questionnaire2 - questionnaire2Ctn - [reqNonAdminAuthHeader] - [qtn1AlbertEditQtnPermDto] - create_test_200 - "HTTP 200 OK (Anonymous, VisibleView, Sharing)" - appContext - questionnaire7 - questionnaire7Ctn - [] - [qtn1AlbertEditQtnPermDto] - create_test_200 - "HTTP 200 OK (Non-Owner, VisibleEdit)" - appContext - questionnaire3 - questionnaire3Ctn - [reqNonAdminAuthHeader] - [] - create_test_200 "HTTP 200 OK (Anonymous, Public, Sharing)" appContext questionnaire10 questionnaire10Ctn [] [] - -create_test_200 title appContext qtn qtnCtn authHeader permissions = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT qtn.uuid - let reqHeaders = reqHeadersT authHeader - -- AND: Prepare expectation - let expStatus = 200 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = qVersionsList qtn.uuid - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - runInContextIO (insertQuestionnaire questionnaire7) appContext - runInContextIO (insertQuestionnaireEvents questionnaire7Events) appContext - runInContextIO (traverse_ insertQuestionnaireVersion questionnaire7Versions) appContext - runInContextIO (insertQuestionnaire questionnaire10) appContext - runInContextIO (insertQuestionnaireEvents questionnaire10Events) appContext - runInContextIO (traverse_ insertQuestionnaireVersion questionnaire10Versions) appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = do - create_test_403 - "HTTP 403 FORBIDDEN (Non-Owner, Private)" - appContext - questionnaire1 - [reqNonAdminAuthHeader] - (_ERROR_VALIDATION__FORBIDDEN "View Questionnaire") - create_test_403 - "HTTP 403 FORBIDDEN (Anonymous, VisibleView)" - appContext - questionnaire2 - [] - _ERROR_SERVICE_USER__MISSING_USER - create_test_403 - "HTTP 403 FORBIDDEN (Anonymous, Public)" - appContext - questionnaire3 - [] - _ERROR_SERVICE_USER__MISSING_USER - -create_test_403 title appContext qtn authHeader errorMessage = - it title $ - -- GIVEN: Prepare request - do - let reqUrl = reqUrlT qtn.uuid - let reqHeaders = reqHeadersT authHeader - -- AND: Prepare expectation - let expStatus = 403 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = ForbiddenError errorMessage - let expBody = encode expDto - -- AND: Run migrations - runInContextIO U.runMigration appContext - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - "/wizard-api/questionnaires/f08ead5f-746d-411b-aee6-77ea3d24016a/versions" - [reqHeadersT reqAuthHeader] - reqBody - "questionnaire" - [("uuid", "f08ead5f-746d-411b-aee6-77ea3d24016a")] diff --git a/wizard-server/test/Wizard/Specs/API/Questionnaire/Version/List_POST.hs b/wizard-server/test/Wizard/Specs/API/Questionnaire/Version/List_POST.hs deleted file mode 100644 index c70eea862..000000000 --- a/wizard-server/test/Wizard/Specs/API/Questionnaire/Version/List_POST.hs +++ /dev/null @@ -1,80 +0,0 @@ -module Wizard.Specs.API.Questionnaire.Version.List_POST ( - list_POST, -) where - -import Data.Aeson (encode) -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) - -import Shared.Common.Api.Resource.Error.ErrorJM () -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireVersions -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.QuestionnaireVersion -import Wizard.Model.Questionnaire.QuestionnaireVersionList - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.API.Questionnaire.Version.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- POST /wizard-api/questionnaires/{qtnUuid}/versions --- ------------------------------------------------------------------------ -list_POST :: AppContext -> SpecWith ((), Application) -list_POST appContext = - describe "POST /wizard-api/questionnaires/{qtnUuid}/versions" $ do - test_201 appContext - test_400 appContext - test_401 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodPost - -reqUrl = "/wizard-api/questionnaires/af984a75-56e3-49f8-b16f-d6b99599910a/versions" - -reqHeaders = [reqAuthHeader, reqCtHeader] - -reqDto = questionnaireVersion2ChangeDto questionnaire1Uuid - -reqBody = encode reqDto - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_201 appContext = - it "HTTP 201 CREATED" $ - -- GIVEN: Prepare expectation - do - let expStatus = 201 - let expHeaders = resCtHeaderPlain : resCorsHeadersPlain - let expDto = questionnaireVersion2 questionnaire1Uuid - let expBody = encode expDto - -- AND: Run migrations - runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let (status, headers, resBody) = destructResponse response :: (Int, ResponseHeaders, QuestionnaireVersionList) - assertResStatus status expStatus - assertResHeaders headers expHeaders - compareQuestionnaireVersionCreateDtos resBody expDto - -- AND: Find a result in DB - assertExistenceOfQuestionnaireVersionInDB appContext ((questionnaireVersion2 questionnaire1Uuid) {uuid = resBody.uuid} :: QuestionnaireVersion) - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_400 appContext = createInvalidJsonTest reqMethod reqUrl "name" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod reqUrl [reqCtHeader] reqBody diff --git a/wizard-server/test/Wizard/Specs/API/QuestionnaireAction/APISpec.hs b/wizard-server/test/Wizard/Specs/API/QuestionnaireAction/APISpec.hs deleted file mode 100644 index 034645caa..000000000 --- a/wizard-server/test/Wizard/Specs/API/QuestionnaireAction/APISpec.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Wizard.Specs.API.QuestionnaireAction.APISpec where - -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) - -import Wizard.Specs.API.Common -import Wizard.Specs.API.QuestionnaireAction.Detail_GET -import Wizard.Specs.API.QuestionnaireAction.Detail_PUT -import Wizard.Specs.API.QuestionnaireAction.List_GET -import Wizard.Specs.API.QuestionnaireAction.List_Suggestions_GET - -questionnaireActionAPI baseContext appContext = - with (startWebApp baseContext appContext) $ - describe "QUESTIONNAIRE ACTION API Spec" $ do - list_GET appContext - list_suggestions_GET appContext - detail_GET appContext - detail_PUT appContext diff --git a/wizard-server/test/Wizard/Specs/API/QuestionnaireAction/Common.hs b/wizard-server/test/Wizard/Specs/API/QuestionnaireAction/Common.hs deleted file mode 100644 index f3a10a1ee..000000000 --- a/wizard-server/test/Wizard/Specs/API/QuestionnaireAction/Common.hs +++ /dev/null @@ -1,27 +0,0 @@ -module Wizard.Specs.API.QuestionnaireAction.Common where - -import Data.Either (isRight) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Wizard.Database.DAO.QuestionnaireAction.QuestionnaireActionDAO -import Wizard.Model.QuestionnaireAction.QuestionnaireAction - -import Wizard.Specs.Common - --- -------------------------------- --- ASSERTS --- -------------------------------- -assertExistenceOfQuestionnaireActionInDB appContext action = do - eQuestionnaireAction <- runInContextIO (findQuestionnaireActionById action.qaId) appContext - liftIO $ isRight eQuestionnaireAction `shouldBe` True - let (Right actionFromDB) = eQuestionnaireAction - compareQuestionnaireActionDtos actionFromDB action - --- -------------------------------- --- COMPARATORS --- -------------------------------- -compareQuestionnaireActionDtos resDto expDto = do - liftIO $ resDto.name `shouldBe` expDto.name - liftIO $ resDto.enabled `shouldBe` expDto.enabled diff --git a/wizard-server/test/Wizard/Specs/API/QuestionnaireAction/Detail_GET.hs b/wizard-server/test/Wizard/Specs/API/QuestionnaireAction/Detail_GET.hs deleted file mode 100644 index a8e3e3c7b..000000000 --- a/wizard-server/test/Wizard/Specs/API/QuestionnaireAction/Detail_GET.hs +++ /dev/null @@ -1,86 +0,0 @@ -module Wizard.Specs.API.QuestionnaireAction.Detail_GET ( - detail_GET, -) where - -import Data.Aeson (encode) -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Wizard.Database.Migration.Development.QuestionnaireAction.Data.QuestionnaireActions -import qualified Wizard.Database.Migration.Development.QuestionnaireAction.QuestionnaireActionMigration as QA_Migration -import Wizard.Model.Context.AppContext -import Wizard.Service.QuestionnaireAction.QuestionnaireActionMapper - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- GET /wizard-api/questionnaire-actions/{id} --- ------------------------------------------------------------------------ -detail_GET :: AppContext -> SpecWith ((), Application) -detail_GET appContext = - describe "GET /wizard-api/questionnaire-actions/{id}" $ do - test_200 appContext - test_401 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodGet - -reqUrl = "/wizard-api/questionnaire-actions/global:questionnaire-action-ftp:3.0.0" - -reqHeadersT reqAuthHeader = [reqCtHeader, reqAuthHeader] - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = create_test_200 "HTTP 200 OK" appContext reqAuthHeader - -create_test_200 title appContext reqAuthHeader = - it title $ - -- GIVEN: Prepare request - do - let reqHeaders = reqHeadersT reqAuthHeader - -- AND: Prepare expectation - let expStatus = 200 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = toDTO questionnaireActionFtp3 - let expBody = encode expDto - -- AND: Run migrations - runInContextIO QA_Migration.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod reqUrl [reqCtHeader] reqBody - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [reqCtHeader] reqBody "QTN_PERM" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - "/wizard-api/questionnaire-actions/deab6c38-aeac-4b17-a501-4365a0a70176" - (reqHeadersT reqAuthHeader) - reqBody - "questionnaire_action" - [("id", "deab6c38-aeac-4b17-a501-4365a0a70176")] diff --git a/wizard-server/test/Wizard/Specs/API/QuestionnaireAction/Detail_PUT.hs b/wizard-server/test/Wizard/Specs/API/QuestionnaireAction/Detail_PUT.hs deleted file mode 100644 index 9cdcfdc6e..000000000 --- a/wizard-server/test/Wizard/Specs/API/QuestionnaireAction/Detail_PUT.hs +++ /dev/null @@ -1,94 +0,0 @@ -module Wizard.Specs.API.QuestionnaireAction.Detail_PUT ( - detail_PUT, -) where - -import Data.Aeson (encode) -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) - -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionDTO -import Wizard.Api.Resource.QuestionnaireAction.QuestionnaireActionJM () -import Wizard.Database.Migration.Development.QuestionnaireAction.Data.QuestionnaireActions -import qualified Wizard.Database.Migration.Development.QuestionnaireAction.QuestionnaireActionMigration as QA_Migration -import Wizard.Model.Context.AppContext -import Wizard.Model.QuestionnaireAction.QuestionnaireAction -import Wizard.Service.QuestionnaireAction.QuestionnaireActionMapper - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.API.QuestionnaireAction.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- PUT /wizard-api/questionnaire-actions/{id} --- ------------------------------------------------------------------------ -detail_PUT :: AppContext -> SpecWith ((), Application) -detail_PUT appContext = - describe "PUT /wizard-api/questionnaire-actions/{id}" $ do - test_200 appContext - test_401 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodPut - -reqUrl = "/wizard-api/questionnaire-actions/global:questionnaire-action-ftp:3.0.0" - -reqHeadersT reqAuthHeader = [reqCtHeader, reqAuthHeader] - -reqDto = toChangeDTO questionnaireActionFtp3Edited - -reqBody = encode reqDto - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = create_test_200 "HTTP 200 OK" appContext reqAuthHeader - -create_test_200 title appContext reqAuthHeader = - it title $ - -- GIVEN: Prepare request - do - let reqHeaders = reqHeadersT reqAuthHeader - -- AND: Prepare expectation - let expStatus = 200 - let expHeaders = resCtHeaderPlain : resCorsHeadersPlain - let expDto = toDTO questionnaireActionFtp3Edited - let expBody = encode expDto - let expType (a :: QuestionnaireActionDTO) = a - -- AND: Run migrations - runInContextIO QA_Migration.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let (status, headers, resDto) = destructResponse response :: (Int, ResponseHeaders, QuestionnaireActionDTO) - assertResponseWithoutFields expStatus expHeaders expDto expType response ["updatedAt"] - -- AND: Find result in DB and compare with expectation state - assertExistenceOfQuestionnaireActionInDB appContext questionnaireActionFtp3Edited - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod reqUrl [reqCtHeader] reqBody - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [reqCtHeader] reqBody "QTN_ACTION_PERM" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - "/wizard-api/questionnaire-actions/deab6c38-aeac-4b17-a501-4365a0a70176" - (reqHeadersT reqAuthHeader) - reqBody - "questionnaire_action" - [("id", "deab6c38-aeac-4b17-a501-4365a0a70176")] diff --git a/wizard-server/test/Wizard/Specs/API/QuestionnaireAction/List_GET.hs b/wizard-server/test/Wizard/Specs/API/QuestionnaireAction/List_GET.hs deleted file mode 100644 index 2967d6d85..000000000 --- a/wizard-server/test/Wizard/Specs/API/QuestionnaireAction/List_GET.hs +++ /dev/null @@ -1,93 +0,0 @@ -module Wizard.Specs.API.QuestionnaireAction.List_GET ( - list_GET, -) where - -import Data.Aeson (encode) -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.PageMetadata -import Wizard.Database.Migration.Development.QuestionnaireAction.Data.QuestionnaireActions -import qualified Wizard.Database.Migration.Development.QuestionnaireAction.QuestionnaireActionMigration as QA_Migration -import Wizard.Model.Context.AppContext -import Wizard.Service.QuestionnaireAction.QuestionnaireActionMapper - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- GET /wizard-api/questionnaire-actions --- ------------------------------------------------------------------------ -list_GET :: AppContext -> SpecWith ((), Application) -list_GET appContext = - describe "GET /wizard-api/questionnaire-actions" $ do - test_200 appContext - test_401 appContext - test_403 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodGet - -reqUrl = "/wizard-api/questionnaire-actions" - -reqHeadersT reqAuthHeader = [reqAuthHeader] - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = do - create_test_200 - "HTTP 200 OK" - appContext - "/wizard-api/questionnaire-actions" - reqAuthHeader - (Page "questionnaireActions" (PageMetadata 20 3 1 0) [questionnaireActionFtp3, questionnaireActionMail1, questionnaireActionScp1]) - create_test_200 - "HTTP 200 OK (query 'q')" - appContext - "/wizard-api/questionnaire-actions?q=FTP" - reqAuthHeader - (Page "questionnaireActions" (PageMetadata 20 1 1 0) [questionnaireActionFtp3]) - create_test_200 - "HTTP 200 OK (query 'q' for non-existing)" - appContext - "/wizard-api/questionnaire-actions?q=Non-existing Questionnaire Report" - reqAuthHeader - (Page "questionnaireActions" (PageMetadata 20 0 0 0) []) - -create_test_200 title appContext reqUrl reqAuthHeader expEntities = - it title $ - -- GIVEN: Prepare request - do - let reqHeaders = reqHeadersT reqAuthHeader - -- AND: Prepare expectation - let expStatus = 200 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = fmap toDTO expEntities - let expBody = encode expDto - -- AND: Run migrations - runInContextIO QA_Migration.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod reqUrl [] reqBody - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [] reqBody "QTN_PERM" diff --git a/wizard-server/test/Wizard/Specs/API/QuestionnaireAction/List_Suggestions_GET.hs b/wizard-server/test/Wizard/Specs/API/QuestionnaireAction/List_Suggestions_GET.hs deleted file mode 100644 index 82338c969..000000000 --- a/wizard-server/test/Wizard/Specs/API/QuestionnaireAction/List_Suggestions_GET.hs +++ /dev/null @@ -1,103 +0,0 @@ -module Wizard.Specs.API.QuestionnaireAction.List_Suggestions_GET ( - list_suggestions_GET, -) where - -import Data.Aeson (encode) -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.PageMetadata -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN_Migration -import Wizard.Database.Migration.Development.QuestionnaireAction.Data.QuestionnaireActions -import qualified Wizard.Database.Migration.Development.QuestionnaireAction.QuestionnaireActionMigration as QA_Migration -import Wizard.Model.Context.AppContext -import Wizard.Service.QuestionnaireAction.QuestionnaireActionMapper - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- GET /wizard-api/questionnaire-actions/suggestions --- ------------------------------------------------------------------------ -list_suggestions_GET :: AppContext -> SpecWith ((), Application) -list_suggestions_GET appContext = - describe "GET /wizard-api/questionnaire-actions/suggestions" $ do - test_200 appContext - test_401 appContext - test_403 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodGet - -reqUrl = "/wizard-api/questionnaire-actions/suggestions" - -reqHeadersT reqAuthHeader = [reqAuthHeader] - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = do - create_test_200 - "HTTP 200 OK" - appContext - "/wizard-api/questionnaire-actions/suggestions?enabled=true" - reqAuthHeader - (Page "questionnaireActions" (PageMetadata 20 2 1 0) [questionnaireActionFtp2, questionnaireActionMail1]) - create_test_200 - "HTTP 200 OK (query 'q')" - appContext - "/wizard-api/questionnaire-actions/suggestions?enabled=true&q=FTP" - reqAuthHeader - (Page "questionnaireActions" (PageMetadata 20 1 1 0) [questionnaireActionFtp2]) - create_test_200 - "HTTP 200 OK (query 'q' for non-existing)" - appContext - "/wizard-api/questionnaire-actions/suggestions?enabled=true&q=Non-existing Questionnaire Report" - reqAuthHeader - (Page "questionnaireActions" (PageMetadata 20 0 0 0) []) - create_test_200 - "HTTP 200 OK (query 'questionnaireUuid')" - appContext - "/wizard-api/questionnaire-actions/suggestions?enabled=true&questionnaireUuid=af984a75-56e3-49f8-b16f-d6b99599910a" - reqAuthHeader - (Page "questionnaireActions" (PageMetadata 20 1 1 0) [questionnaireActionFtp2]) - -create_test_200 title appContext reqUrl reqAuthHeader expEntities = - it title $ - -- GIVEN: Prepare request - do - let reqHeaders = reqHeadersT reqAuthHeader - -- AND: Prepare expectation - let expStatus = 200 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = fmap toDTO expEntities - let expBody = encode expDto - -- AND: Run migrations - runInContextIO TML_Migration.runMigration appContext - runInContextIO QTN_Migration.runMigration appContext - runInContextIO QA_Migration.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod reqUrl [] reqBody - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [] reqBody "QTN_PERM" diff --git a/wizard-server/test/Wizard/Specs/API/QuestionnaireImporter/APISpec.hs b/wizard-server/test/Wizard/Specs/API/QuestionnaireImporter/APISpec.hs deleted file mode 100644 index a15d8be3d..000000000 --- a/wizard-server/test/Wizard/Specs/API/QuestionnaireImporter/APISpec.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Wizard.Specs.API.QuestionnaireImporter.APISpec where - -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) - -import Wizard.Specs.API.Common -import Wizard.Specs.API.QuestionnaireImporter.Detail_GET -import Wizard.Specs.API.QuestionnaireImporter.Detail_PUT -import Wizard.Specs.API.QuestionnaireImporter.List_GET -import Wizard.Specs.API.QuestionnaireImporter.List_Suggestions_GET - -questionnaireImporterAPI baseContext appContext = - with (startWebApp baseContext appContext) $ - describe "QUESTIONNAIRE IMPORTER API Spec" $ do - list_GET appContext - list_suggestions_GET appContext - detail_GET appContext - detail_PUT appContext diff --git a/wizard-server/test/Wizard/Specs/API/QuestionnaireImporter/Common.hs b/wizard-server/test/Wizard/Specs/API/QuestionnaireImporter/Common.hs deleted file mode 100644 index 66b282ef7..000000000 --- a/wizard-server/test/Wizard/Specs/API/QuestionnaireImporter/Common.hs +++ /dev/null @@ -1,27 +0,0 @@ -module Wizard.Specs.API.QuestionnaireImporter.Common where - -import Data.Either (isRight) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) - -import Shared.Common.Api.Resource.Error.ErrorJM () -import Wizard.Database.DAO.QuestionnaireImporter.QuestionnaireImporterDAO -import Wizard.Model.QuestionnaireImporter.QuestionnaireImporter - -import Wizard.Specs.Common - --- -------------------------------- --- ASSERTS --- -------------------------------- -assertExistenceOfQuestionnaireImporterInDB appContext importer = do - eQuestionnaireImporter <- runInContextIO (findQuestionnaireImporterById importer.qiId) appContext - liftIO $ isRight eQuestionnaireImporter `shouldBe` True - let (Right importerFromDB) = eQuestionnaireImporter - compareQuestionnaireImporterDtos importerFromDB importer - --- -------------------------------- --- COMPARATORS --- -------------------------------- -compareQuestionnaireImporterDtos resDto expDto = do - liftIO $ resDto.name `shouldBe` expDto.name - liftIO $ resDto.enabled `shouldBe` expDto.enabled diff --git a/wizard-server/test/Wizard/Specs/API/QuestionnaireImporter/Detail_GET.hs b/wizard-server/test/Wizard/Specs/API/QuestionnaireImporter/Detail_GET.hs deleted file mode 100644 index ac0e6418e..000000000 --- a/wizard-server/test/Wizard/Specs/API/QuestionnaireImporter/Detail_GET.hs +++ /dev/null @@ -1,87 +0,0 @@ -module Wizard.Specs.API.QuestionnaireImporter.Detail_GET ( - detail_GET, -) where - -import Data.Aeson (encode) -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Wizard.Database.Migration.Development.QuestionnaireImporter.Data.QuestionnaireImporters -import qualified Wizard.Database.Migration.Development.QuestionnaireImporter.QuestionnaireImporterMigration as QI_Migration -import Wizard.Model.Context.AppContext -import Wizard.Service.QuestionnaireImporter.QuestionnaireImporterMapper - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- GET /wizard-api/questionnaire-importers/{qi-id} --- ------------------------------------------------------------------------ -detail_GET :: AppContext -> SpecWith ((), Application) -detail_GET appContext = - describe "GET /wizard-api/questionnaire-importers/{qi-id}" $ do - test_200 appContext - test_401 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodGet - -reqUrl = "/wizard-api/questionnaire-importers/global:questionnaire-importer-bio:3.0.0" - -reqHeadersT reqAuthHeader = [reqCtHeader, reqAuthHeader] - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = create_test_200 "HTTP 200 OK" appContext reqAuthHeader - -create_test_200 title appContext reqAuthHeader = - it title $ - -- GIVEN: Prepare request - do - let reqHeaders = reqHeadersT reqAuthHeader - -- AND: Prepare expectation - let expStatus = 200 - let expHeaders = resCtHeader : resCorsHeaders - let expDto = toDTO questionnaireImporterBio3 - let expBody = encode expDto - -- AND: Run migrations - runInContextIO QI_Migration.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod reqUrl [reqCtHeader] reqBody - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [reqCtHeader] reqBody "QTN_PERM" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - "/wizard-api/questionnaire-importers/deab6c38-aeac-4b17-a501-4365a0a70176" - (reqHeadersT reqAuthHeader) - reqBody - "questionnaire_importer" - [("id", "deab6c38-aeac-4b17-a501-4365a0a70176")] diff --git a/wizard-server/test/Wizard/Specs/API/QuestionnaireImporter/Detail_PUT.hs b/wizard-server/test/Wizard/Specs/API/QuestionnaireImporter/Detail_PUT.hs deleted file mode 100644 index 7e9bd58a4..000000000 --- a/wizard-server/test/Wizard/Specs/API/QuestionnaireImporter/Detail_PUT.hs +++ /dev/null @@ -1,94 +0,0 @@ -module Wizard.Specs.API.QuestionnaireImporter.Detail_PUT ( - detail_PUT, -) where - -import Data.Aeson (encode) -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) - -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterDTO -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterJM () -import Wizard.Database.Migration.Development.QuestionnaireImporter.Data.QuestionnaireImporters -import qualified Wizard.Database.Migration.Development.QuestionnaireImporter.QuestionnaireImporterMigration as QI_Migration -import Wizard.Model.Context.AppContext -import Wizard.Model.QuestionnaireImporter.QuestionnaireImporter -import Wizard.Service.QuestionnaireImporter.QuestionnaireImporterMapper - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.API.QuestionnaireImporter.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- PUT /wizard-api/questionnaire-importers/{qi-id} --- ------------------------------------------------------------------------ -detail_PUT :: AppContext -> SpecWith ((), Application) -detail_PUT appContext = - describe "PUT /wizard-api/questionnaire-importers/{qi-id}" $ do - test_200 appContext - test_401 appContext - test_403 appContext - test_404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodPut - -reqUrl = "/wizard-api/questionnaire-importers/global:questionnaire-importer-bio:3.0.0" - -reqHeadersT reqAuthHeader = [reqCtHeader, reqAuthHeader] - -reqDto = toChangeDTO questionnaireImporterBio3Edited - -reqBody = encode reqDto - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = create_test_200 "HTTP 200 OK" appContext reqAuthHeader - -create_test_200 title appContext reqAuthHeader = - it title $ - -- GIVEN: Prepare request - do - let reqHeaders = reqHeadersT reqAuthHeader - -- AND: Prepare expectation - let expStatus = 200 - let expHeaders = resCtHeaderPlain : resCorsHeadersPlain - let expDto = toDTO questionnaireImporterBio3Edited - let expBody = encode expDto - let expType (a :: QuestionnaireImporterDTO) = a - -- AND: Run migrations - runInContextIO QI_Migration.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let (status, headers, resDto) = destructResponse response :: (Int, ResponseHeaders, QuestionnaireImporterDTO) - assertResponseWithoutFields expStatus expHeaders expDto expType response ["updatedAt"] - -- AND: Find result in DB and compare with expectation state - assertExistenceOfQuestionnaireImporterInDB appContext questionnaireImporterBio3Edited - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod reqUrl [reqCtHeader] reqBody - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [reqCtHeader] reqBody "QTN_IMPORTER_PERM" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_404 appContext = - createNotFoundTest' - reqMethod - "/wizard-api/questionnaire-importers/deab6c38-aeac-4b17-a501-4365a0a70176" - (reqHeadersT reqAuthHeader) - reqBody - "questionnaire_importer" - [("id", "deab6c38-aeac-4b17-a501-4365a0a70176")] diff --git a/wizard-server/test/Wizard/Specs/API/QuestionnaireImporter/List_GET.hs b/wizard-server/test/Wizard/Specs/API/QuestionnaireImporter/List_GET.hs deleted file mode 100644 index b450328f3..000000000 --- a/wizard-server/test/Wizard/Specs/API/QuestionnaireImporter/List_GET.hs +++ /dev/null @@ -1,99 +0,0 @@ -module Wizard.Specs.API.QuestionnaireImporter.List_GET ( - list_GET, -) where - -import Data.Aeson (encode) -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.PageMetadata -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterDTO -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterJM () -import Wizard.Database.Migration.Development.QuestionnaireImporter.Data.QuestionnaireImporters -import qualified Wizard.Database.Migration.Development.QuestionnaireImporter.QuestionnaireImporterMigration as QI_Migration -import Wizard.Model.Context.AppContext -import Wizard.Service.QuestionnaireImporter.QuestionnaireImporterMapper - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- GET /wizard-api/questionnaire-importers --- ------------------------------------------------------------------------ -list_GET :: AppContext -> SpecWith ((), Application) -list_GET appContext = - describe "GET /wizard-api/questionnaire-importers" $ do - test_200 appContext - test_401 appContext - test_403 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodGet - -reqUrl = "/wizard-api/questionnaire-importers" - -reqHeadersT reqAuthHeader = [reqAuthHeader] - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = do - create_test_200 - "HTTP 200 OK" - appContext - "/wizard-api/questionnaire-importers" - reqAuthHeader - ( Page - "questionnaireImporters" - (PageMetadata 20 3 1 0) - (fmap toDTO [questionnaireImporterBio3, questionnaireImporterExt1, questionnaireImporterOnto1]) - ) - create_test_200 - "HTTP 200 OK (query 'q')" - appContext - "/wizard-api/questionnaire-importers?q=QuestionnaireImporterBio" - reqAuthHeader - (Page "questionnaireImporters" (PageMetadata 20 1 1 0) (fmap toDTO [questionnaireImporterBio3])) - create_test_200 - "HTTP 200 OK (query 'q' for non-existing)" - appContext - "/wizard-api/questionnaire-importers?q=Non-existing Questionnaire Report" - reqAuthHeader - (Page "questionnaireImporters" (PageMetadata 20 0 0 0) ([] :: [QuestionnaireImporterDTO])) - -create_test_200 title appContext reqUrl reqAuthHeader expDto = - it title $ - -- GIVEN: Prepare request - do - let reqHeaders = reqHeadersT reqAuthHeader - -- AND: Prepare expectation - let expStatus = 200 - let expHeaders = resCtHeader : resCorsHeaders - let expBody = encode expDto - -- AND: Run migrations - runInContextIO QI_Migration.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod reqUrl [] reqBody - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [] reqBody "QTN_PERM" diff --git a/wizard-server/test/Wizard/Specs/API/QuestionnaireImporter/List_Suggestions_GET.hs b/wizard-server/test/Wizard/Specs/API/QuestionnaireImporter/List_Suggestions_GET.hs deleted file mode 100644 index 28db9c6dc..000000000 --- a/wizard-server/test/Wizard/Specs/API/QuestionnaireImporter/List_Suggestions_GET.hs +++ /dev/null @@ -1,109 +0,0 @@ -module Wizard.Specs.API.QuestionnaireImporter.List_Suggestions_GET ( - list_suggestions_GET, -) where - -import Data.Aeson (encode) -import Network.HTTP.Types -import Network.Wai (Application) -import Test.Hspec -import Test.Hspec.Wai hiding (shouldRespondWith) -import Test.Hspec.Wai.Matcher - -import Shared.Common.Model.Common.Page -import Shared.Common.Model.Common.PageMetadata -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterDTO -import Wizard.Api.Resource.QuestionnaireImporter.QuestionnaireImporterJM () -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN_Migration -import Wizard.Database.Migration.Development.QuestionnaireImporter.Data.QuestionnaireImporters -import qualified Wizard.Database.Migration.Development.QuestionnaireImporter.QuestionnaireImporterMigration as QI_Migration -import Wizard.Model.Context.AppContext -import Wizard.Service.QuestionnaireImporter.QuestionnaireImporterMapper - -import SharedTest.Specs.API.Common -import Wizard.Specs.API.Common -import Wizard.Specs.Common - --- ------------------------------------------------------------------------ --- GET /wizard-api/questionnaire-importers/suggestions --- ------------------------------------------------------------------------ -list_suggestions_GET :: AppContext -> SpecWith ((), Application) -list_suggestions_GET appContext = - describe "GET /wizard-api/questionnaire-importers/suggestions" $ do - test_200 appContext - test_401 appContext - test_403 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -reqMethod = methodGet - -reqUrl = "/wizard-api/questionnaire-importers/suggestions" - -reqHeadersT reqAuthHeader = [reqAuthHeader] - -reqBody = "" - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_200 appContext = do - create_test_200 - "HTTP 200 OK" - appContext - "/wizard-api/questionnaire-importers/suggestions?enabled=true" - reqAuthHeader - ( Page - "questionnaireImporters" - (PageMetadata 20 2 1 0) - (fmap toDTO [questionnaireImporterBio2, questionnaireImporterExt1]) - ) - create_test_200 - "HTTP 200 OK (query 'q')" - appContext - "/wizard-api/questionnaire-importers/suggestions?enabled=true&q=QuestionnaireImporterBio" - reqAuthHeader - (Page "questionnaireImporters" (PageMetadata 20 1 1 0) (fmap toDTO [questionnaireImporterBio2])) - create_test_200 - "HTTP 200 OK (query 'q' for non-existing)" - appContext - "/wizard-api/questionnaire-importers/suggestions?enabled=true&q=Non-existing Questionnaire Report" - reqAuthHeader - (Page "questionnaireImporters" (PageMetadata 20 0 0 0) ([] :: [QuestionnaireImporterDTO])) - create_test_200 - "HTTP 200 OK (query 'questionnaireUuid')" - appContext - "/wizard-api/questionnaire-importers/suggestions?enabled=true&questionnaireUuid=af984a75-56e3-49f8-b16f-d6b99599910a" - reqAuthHeader - (Page "questionnaireImporters" (PageMetadata 20 1 1 0) (fmap toDTO [questionnaireImporterBio2])) - -create_test_200 title appContext reqUrl reqAuthHeader expDto = - it title $ - -- GIVEN: Prepare request - do - let reqHeaders = reqHeadersT reqAuthHeader - -- AND: Prepare expectation - let expStatus = 200 - let expHeaders = resCtHeader : resCorsHeaders - let expBody = encode expDto - -- AND: Run migrations - runInContextIO TML_Migration.runMigration appContext - runInContextIO QTN_Migration.runMigration appContext - runInContextIO QI_Migration.runMigration appContext - -- WHEN: Call API - response <- request reqMethod reqUrl reqHeaders reqBody - -- THEN: Compare response with expectation - let responseMatcher = - ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals expBody} - response `shouldRespondWith` responseMatcher - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_401 appContext = createAuthTest reqMethod reqUrl [] reqBody - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [] reqBody "QTN_PERM" diff --git a/wizard-server/test/Wizard/Specs/API/Submission/List_GET.hs b/wizard-server/test/Wizard/Specs/API/Submission/List_GET.hs index eece3968a..8b2424878 100644 --- a/wizard-server/test/Wizard/Specs/API/Submission/List_GET.hs +++ b/wizard-server/test/Wizard/Specs/API/Submission/List_GET.hs @@ -14,18 +14,18 @@ import Shared.Common.Localization.Messages.Public import Shared.Common.Model.Error.Error import Wizard.Api.Resource.Submission.SubmissionJM () import Wizard.Database.DAO.Document.DocumentDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO +import Wizard.Database.DAO.Project.ProjectDAO import Wizard.Database.Migration.Development.Document.Data.Documents import qualified Wizard.Database.Migration.Development.Document.DocumentMigration as DOC_Migration import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN_Migration +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ_Migration import Wizard.Database.Migration.Development.Submission.Data.Submissions import qualified Wizard.Database.Migration.Development.Submission.SubmissionMigration as SUB_Migration import qualified Wizard.Database.Migration.Development.User.UserMigration as U_Migration import Wizard.Model.Context.AppContext import Wizard.Model.Document.Document -import Wizard.Model.Questionnaire.Questionnaire +import Wizard.Model.Project.Project import SharedTest.Specs.API.Common import Wizard.Specs.API.Common @@ -56,11 +56,11 @@ reqBody = "" -- ---------------------------------------------------- -- ---------------------------------------------------- test_200 appContext = do - create_test_200 "HTTP 200 OK (Owner, Private)" appContext questionnaire1 [reqAuthHeader] - create_test_200 "HTTP 200 OK (Non-Owner, VisibleEdit)" appContext questionnaire3 [reqNonAdminAuthHeader] - create_test_200 "HTTP 200 OK (Non-Owner, VisibleView)" appContext questionnaire2 [reqNonAdminAuthHeader] + create_test_200 "HTTP 200 OK (Owner, Private)" appContext project1 [reqAuthHeader] + create_test_200 "HTTP 200 OK (Non-Owner, VisibleEdit)" appContext project3 [reqNonAdminAuthHeader] + create_test_200 "HTTP 200 OK (Non-Owner, VisibleView)" appContext project2 [reqNonAdminAuthHeader] -create_test_200 title appContext qtn authHeader = +create_test_200 title appContext project authHeader = it title $ -- GIVEN: Prepare request do @@ -73,11 +73,11 @@ create_test_200 title appContext qtn authHeader = -- AND: Run migrations runInContextIO U_Migration.runMigration appContext runInContextIO TML_Migration.runMigration appContext - runInContextIO QTN_Migration.runMigration appContext - runInContextIO (insertQuestionnaire questionnaire10) appContext + runInContextIO PRJ_Migration.runMigration appContext + runInContextIO (insertProject project10) appContext runInContextIO DOC_Migration.runMigration appContext runInContextIO (deleteDocumentByUuid doc1.uuid) appContext - runInContextIO (insertDocument (doc1 {questionnaireUuid = Just qtn.uuid})) appContext + runInContextIO (insertDocument (doc1 {projectUuid = Just project.uuid})) appContext runInContextIO SUB_Migration.runMigration appContext -- WHEN: Call API response <- request reqMethod reqUrl reqHeaders reqBody @@ -98,11 +98,11 @@ test_403 appContext = create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, Private)" appContext - questionnaire1 + project1 [reqNonAdminAuthHeader] - (_ERROR_VALIDATION__FORBIDDEN "View Questionnaire") + (_ERROR_VALIDATION__FORBIDDEN "View Project") -create_test_403 title appContext qtn authHeader errorMessage = +create_test_403 title appContext project authHeader errorMessage = it title $ -- GIVEN: Prepare request do @@ -115,11 +115,11 @@ create_test_403 title appContext qtn authHeader errorMessage = -- AND: Run migrations runInContextIO U_Migration.runMigration appContext runInContextIO TML_Migration.runMigration appContext - runInContextIO QTN_Migration.runMigration appContext - runInContextIO (insertQuestionnaire questionnaire7) appContext + runInContextIO PRJ_Migration.runMigration appContext + runInContextIO (insertProject project7) appContext runInContextIO DOC_Migration.runMigration appContext runInContextIO (deleteDocumentByUuid doc1.uuid) appContext - runInContextIO (insertDocument (doc1 {questionnaireUuid = Just qtn.uuid})) appContext + runInContextIO (insertDocument (doc1 {projectUuid = Just project.uuid})) appContext -- WHEN: Call API response <- request reqMethod reqUrl reqHeaders reqBody -- THEN: Compare response with expectation diff --git a/wizard-server/test/Wizard/Specs/API/Submission/List_POST.hs b/wizard-server/test/Wizard/Specs/API/Submission/List_POST.hs index 782e9c08d..d43ca8d54 100644 --- a/wizard-server/test/Wizard/Specs/API/Submission/List_POST.hs +++ b/wizard-server/test/Wizard/Specs/API/Submission/List_POST.hs @@ -15,21 +15,21 @@ import Shared.Common.Model.Error.Error import Wizard.Api.Resource.Submission.SubmissionCreateJM () import Wizard.Api.Resource.Submission.SubmissionJM () import Wizard.Database.DAO.Document.DocumentDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO +import Wizard.Database.DAO.Project.ProjectDAO import Wizard.Database.DAO.Submission.SubmissionDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigSubmissionDAO import Wizard.Database.Migration.Development.Document.Data.Documents import qualified Wizard.Database.Migration.Development.Document.DocumentMigration as DOC_Migration import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN_Migration +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ_Migration import Wizard.Database.Migration.Development.Submission.Data.Submissions import Wizard.Database.Migration.Development.Tenant.Data.TenantConfigs import Wizard.Database.Migration.Development.User.Data.Users import qualified Wizard.Database.Migration.Development.User.UserMigration as U_Migration import Wizard.Model.Context.AppContext import Wizard.Model.Document.Document -import Wizard.Model.Questionnaire.Questionnaire +import Wizard.Model.Project.Project import Wizard.Model.Submission.SubmissionList import Wizard.Service.Submission.SubmissionMapper @@ -64,15 +64,15 @@ reqBody = encode reqDto -- ---------------------------------------------------- -- ---------------------------------------------------- test_201 appContext = do - create_test_201 "HTTP 201 CREATED (Owner, Private)" appContext questionnaire1 [reqAuthHeader] userAlbertSuggestion + create_test_201 "HTTP 201 CREATED (Owner, Private)" appContext project1 [reqAuthHeader] userAlbertSuggestion create_test_201 "HTTP 201 CREATED (Non-Owner, VisibleEdit)" appContext - questionnaire3 + project3 [reqNonAdminAuthHeader] userNikolaSuggestionDto -create_test_201 title appContext qtn authHeader user = +create_test_201 title appContext project authHeader user = it title $ -- GIVEN: Prepare request do @@ -86,11 +86,11 @@ create_test_201 title appContext qtn authHeader user = -- AND: Run migrations runInContextIO U_Migration.runMigration appContext runInContextIO TML_Migration.runMigration appContext - runInContextIO QTN_Migration.runMigration appContext - runInContextIO (insertQuestionnaire questionnaire10) appContext + runInContextIO PRJ_Migration.runMigration appContext + runInContextIO (insertProject project10) appContext runInContextIO DOC_Migration.runMigration appContext runInContextIO (deleteDocumentByUuid doc1.uuid) appContext - runInContextIO (insertDocument (doc1 {questionnaireUuid = Just qtn.uuid})) appContext + runInContextIO (insertDocument (doc1 {projectUuid = Just project.uuid})) appContext runInContextIO (insertOrUpdateConfigSubmissionService defaultSubmissionService) appContext -- WHEN: Call API response <- request reqMethod reqUrl reqHeaders reqBody @@ -111,17 +111,17 @@ test_403 appContext = do create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, Private)" appContext - questionnaire1 + project1 [reqNonAdminAuthHeader] - (_ERROR_VALIDATION__FORBIDDEN "Edit Questionnaire") + (_ERROR_VALIDATION__FORBIDDEN "Edit Project") create_test_403 "HTTP 403 FORBIDDEN (Non-Owner, VisibleView)" appContext - questionnaire2 + project2 [reqNonAdminAuthHeader] - (_ERROR_VALIDATION__FORBIDDEN "Edit Questionnaire") + (_ERROR_VALIDATION__FORBIDDEN "Edit Project") -create_test_403 title appContext qtn authHeader errorMessage = +create_test_403 title appContext project authHeader errorMessage = it title $ -- GIVEN: Prepare request do @@ -134,11 +134,11 @@ create_test_403 title appContext qtn authHeader errorMessage = -- AND: Run migrations runInContextIO U_Migration.runMigration appContext runInContextIO TML_Migration.runMigration appContext - runInContextIO QTN_Migration.runMigration appContext - runInContextIO (insertQuestionnaire questionnaire7) appContext + runInContextIO PRJ_Migration.runMigration appContext + runInContextIO (insertProject project7) appContext runInContextIO DOC_Migration.runMigration appContext runInContextIO (deleteDocumentByUuid doc1.uuid) appContext - runInContextIO (insertDocument (doc1 {questionnaireUuid = Just qtn.uuid})) appContext + runInContextIO (insertDocument (doc1 {projectUuid = Just project.uuid})) appContext -- WHEN: Call API response <- request reqMethod reqUrl reqHeaders reqBody -- THEN: Compare response with expectation diff --git a/wizard-server/test/Wizard/Specs/API/Tenant/Config/List_PUT.hs b/wizard-server/test/Wizard/Specs/API/Tenant/Config/List_PUT.hs index 4b4838392..fe608f5f9 100644 --- a/wizard-server/test/Wizard/Specs/API/Tenant/Config/List_PUT.hs +++ b/wizard-server/test/Wizard/Specs/API/Tenant/Config/List_PUT.hs @@ -42,7 +42,7 @@ reqUrl = "/wizard-api/tenants/current/config" reqHeaders = [reqAuthHeader, reqCtHeader] -reqDto = defaultTenantConfigChangeDto {questionnaire = editedQuestionnaireChangeDto} :: TenantConfigChangeDTO +reqDto = defaultTenantConfigChangeDto {project = editedProjectChangeDto} :: TenantConfigChangeDTO reqBody = encode reqDto @@ -55,7 +55,7 @@ test_200 appContext = do let expStatus = 200 let expHeaders = resCtHeaderPlain : resCorsHeadersPlain - let expDto = defaultTenantConfig {questionnaire = editedQuestionnaire} :: TenantConfig + let expDto = defaultTenantConfig {project = editedProject} :: TenantConfig -- AND: Run migrations runInContextIO TML_Migration.runMigration appContext runInContextIO (insertOrUpdateConfigSubmissionService defaultSubmissionService) appContext @@ -67,7 +67,7 @@ test_200 appContext = assertResHeaders headers expHeaders compareDtos resBody expDto -- AND: Find result in DB and compare with expectation state - assertExistenceOfTenantConfigQuestionnaireInDB appContext editedQuestionnaire + assertExistenceOfTenantConfigProjectInDB appContext editedProject -- ---------------------------------------------------- -- ---------------------------------------------------- diff --git a/wizard-server/test/Wizard/Specs/API/TypeHint/List_POST.hs b/wizard-server/test/Wizard/Specs/API/TypeHint/List_POST.hs index 910be36e7..80c273542 100644 --- a/wizard-server/test/Wizard/Specs/API/TypeHint/List_POST.hs +++ b/wizard-server/test/Wizard/Specs/API/TypeHint/List_POST.hs @@ -16,12 +16,12 @@ import Shared.Common.Model.Error.Error import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO +import Wizard.Database.DAO.Project.ProjectDAO import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeModelEditorMigration as KnowledgeModelEditor import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeModelPackageMigration as KnowledgeModelPackage -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ import Wizard.Database.Migration.Development.TypeHint.Data.TypeHints import qualified Wizard.Database.Migration.Development.User.UserMigration as U import Wizard.Model.Context.AppContext @@ -54,13 +54,13 @@ reqHeadersT authHeader = reqCtHeader : authHeader -- ---------------------------------------------------- -- ---------------------------------------------------- test_200 appContext = do - create_test_200 "HTTP 200 OK (Questionnaire, Owner)" appContext questionnaireTypeHintRequest questionnaire15 [reqAuthHeader] - create_test_200 "HTTP 200 OK (Questionnaire, Editor)" appContext questionnaireTypeHintRequest questionnaire15 [reqNonAdminAuthHeader] - create_test_200 "HTTP 200 OK (Questionnaire, Anonymous)" appContext questionnaireTypeHintRequest questionnaire15AnonymousEdit [] - create_test_200 "HTTP 200 OK (KM Editor-Integration)" appContext kmEditorIntegrationTypeHintRequest questionnaire15 [reqAuthHeader] - create_test_200 "HTTP 200 OK (KM Editor-Question)" appContext kmEditorQuestionTypeHintRequest questionnaire15 [reqAuthHeader] + create_test_200 "HTTP 200 OK (Project, Owner)" appContext projectTypeHintRequest project15 [reqAuthHeader] + create_test_200 "HTTP 200 OK (Project, Editor)" appContext projectTypeHintRequest project15 [reqNonAdminAuthHeader] + create_test_200 "HTTP 200 OK (Project, Anonymous)" appContext projectTypeHintRequest project15AnonymousEdit [] + create_test_200 "HTTP 200 OK (KM Editor-Integration)" appContext kmEditorIntegrationTypeHintRequest project15 [reqAuthHeader] + create_test_200 "HTTP 200 OK (KM Editor-Question)" appContext kmEditorQuestionTypeHintRequest project15 [reqAuthHeader] -create_test_200 title appContext reqDto qtn authHeader = +create_test_200 title appContext reqDto project authHeader = it title $ do -- GIVEN: Prepare request let reqBody = encode reqDto @@ -74,11 +74,11 @@ create_test_200 title appContext reqDto qtn authHeader = runInContextIO U.runMigration appContext runInContextIO TML.runMigration appContext runInContextIO KnowledgeModelPackage.runMigration appContext - runInContextIO QTN.runMigration appContext + runInContextIO PRJ.runMigration appContext runInContextIO KnowledgeModelEditor.runMigration appContext runInContextIO (insertPackage germanyKmPackage) appContext runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - runInContextIO (insertQuestionnaire qtn) appContext + runInContextIO (insertProject project) appContext -- WHEN: Call API response <- request reqMethod reqUrl reqHeaders reqBody -- THEN: Compare response with expectation @@ -100,38 +100,38 @@ create_test_401 appContext reqDto = -- ---------------------------------------------------- -- ---------------------------------------------------- test_403 appContext = do - create_test_403_questionnaire - "HTTP 403 FORBIDDEN (Questionnaire, Non-Owner)" + create_test_403_project + "HTTP 403 FORBIDDEN (Project, Non-Owner)" appContext - questionnaireTypeHintRequest - questionnaire15NoPerms + projectTypeHintRequest + project15NoPerms [reqNonAdminAuthHeader] - (_ERROR_VALIDATION__FORBIDDEN "Edit Questionnaire") - create_test_403_questionnaire - "HTTP 403 FORBIDDEN (Questionnaire, Viewer)" + (_ERROR_VALIDATION__FORBIDDEN "Edit Project") + create_test_403_project + "HTTP 403 FORBIDDEN (Project, Viewer)" appContext - questionnaireTypeHintRequest - questionnaire15 + projectTypeHintRequest + project15 [reqIsaacAuthTokenHeader] - (_ERROR_VALIDATION__FORBIDDEN "Edit Questionnaire") - create_test_403_questionnaire - "HTTP 403 FORBIDDEN (Questionnaire, Anonymous)" + (_ERROR_VALIDATION__FORBIDDEN "Edit Project") + create_test_403_project + "HTTP 403 FORBIDDEN (Project, Anonymous)" appContext - questionnaireTypeHintRequest - questionnaire15 + projectTypeHintRequest + project15 [] _ERROR_SERVICE_USER__MISSING_USER - create_test_403_questionnaire - "HTTP 403 FORBIDDEN (Questionnaire, Anonymous Commenter)" + create_test_403_project + "HTTP 403 FORBIDDEN (Project, Anonymous Commenter)" appContext - questionnaireTypeHintRequest - questionnaire15AnonymousComment + projectTypeHintRequest + project15AnonymousComment [] _ERROR_SERVICE_USER__MISSING_USER create_test_403_knowledge_model_editor appContext kmEditorIntegrationTypeHintRequest create_test_403_knowledge_model_editor appContext kmEditorQuestionTypeHintRequest -create_test_403_questionnaire title appContext reqDto qtn authHeader reason = +create_test_403_project title appContext reqDto project authHeader reason = it title $ do -- GIVEN: Prepare request let reqBody = encode reqDto @@ -145,8 +145,8 @@ create_test_403_questionnaire title appContext reqDto qtn authHeader reason = runInContextIO U.runMigration appContext runInContextIO TML.runMigration appContext runInContextIO KnowledgeModelPackage.runMigration appContext - runInContextIO QTN.runMigration appContext - runInContextIO (insertQuestionnaire qtn) appContext + runInContextIO PRJ.runMigration appContext + runInContextIO (insertProject project) appContext -- WHEN: Call API response <- request reqMethod reqUrl reqHeaders reqBody -- THEN: Compare response with expectation diff --git a/wizard-server/test/Wizard/Specs/API/User/Detail_DELETE.hs b/wizard-server/test/Wizard/Specs/API/User/Detail_DELETE.hs index 68c99e9f7..0d8480a37 100644 --- a/wizard-server/test/Wizard/Specs/API/User/Detail_DELETE.hs +++ b/wizard-server/test/Wizard/Specs/API/User/Detail_DELETE.hs @@ -12,20 +12,20 @@ import Shared.Common.Api.Resource.Error.ErrorJM () import Wizard.Database.Migration.Development.Document.Data.Documents import qualified Wizard.Database.Migration.Development.Document.DocumentMigration as DOC import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ import Wizard.Database.Migration.Development.User.Data.Users import qualified Wizard.Database.Migration.Development.User.UserMigration as U import Wizard.Model.Context.AppContext import Wizard.Model.Document.Document -import Wizard.Model.Questionnaire.Questionnaire +import Wizard.Model.Project.Project import Wizard.Model.User.User -import Wizard.Service.Questionnaire.QuestionnaireService +import Wizard.Service.Project.ProjectService import SharedTest.Specs.API.Common import Wizard.Specs.API.Common import Wizard.Specs.API.Document.Common -import Wizard.Specs.API.Questionnaire.Common +import Wizard.Specs.API.Project.Common import Wizard.Specs.API.User.Common import Wizard.Specs.Common @@ -63,7 +63,7 @@ test_204 appContext = -- AND: Run migrations runInContextIO U.runMigration appContext runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext + runInContextIO PRJ.runMigration appContext runInContextIO DOC.runMigration appContext -- WHEN: Call API response <- request reqMethod reqUrl reqHeaders reqBody @@ -72,10 +72,10 @@ test_204 appContext = ResponseMatcher {matchHeaders = expHeaders, matchStatus = expStatus, matchBody = bodyEquals ""} response `shouldRespondWith` responseMatcher -- AND: Compare state in DB with expectation - runInContextIO cleanQuestionnaires appContext + runInContextIO cleanProjects appContext assertAbsenceOfUserInDB appContext userAlbert - assertAbsenceOfQuestionnaireInDB appContext questionnaire1 - assertAbsenceOfQuestionnaireInDB appContext questionnaire2 + assertAbsenceOfProjectInDB appContext project1 + assertAbsenceOfProjectInDB appContext project2 assertAbsenceOfDocumentInDB appContext doc3 -- ---------------------------------------------------- diff --git a/wizard-server/test/Wizard/Specs/Service/Document/Common.hs b/wizard-server/test/Wizard/Specs/Service/Document/Common.hs index 24c3cfc0a..0b67d2f3a 100644 --- a/wizard-server/test/Wizard/Specs/Service/Document/Common.hs +++ b/wizard-server/test/Wizard/Specs/Service/Document/Common.hs @@ -8,10 +8,10 @@ import Test.Hspec.Expectations.Pretty compareDocumentContexts resDto expDto = do resDto.document.uuid `shouldBe` expDto.document.uuid resDto.document.name `shouldBe` expDto.document.name - resDto.questionnaire.uuid `shouldBe` expDto.questionnaire.uuid - resDto.questionnaire.name `shouldBe` expDto.questionnaire.name - resDto.questionnaire.replies `shouldBe` expDto.questionnaire.replies - resDto.questionnaire.phaseUuid `shouldBe` expDto.questionnaire.phaseUuid + resDto.project.uuid `shouldBe` expDto.project.uuid + resDto.project.name `shouldBe` expDto.project.name + resDto.project.replies `shouldBe` expDto.project.replies + resDto.project.phaseUuid `shouldBe` expDto.project.phaseUuid resDto.knowledgeModel `shouldBe` expDto.knowledgeModel resDto.report.chapterReports `shouldBe` expDto.report.chapterReports resDto.package `shouldBe` expDto.package diff --git a/wizard-server/test/Wizard/Specs/Service/Document/DocumentServiceSpec.hs b/wizard-server/test/Wizard/Specs/Service/Document/DocumentServiceSpec.hs index efd6056a9..8995b8f9c 100644 --- a/wizard-server/test/Wizard/Specs/Service/Document/DocumentServiceSpec.hs +++ b/wizard-server/test/Wizard/Specs/Service/Document/DocumentServiceSpec.hs @@ -8,8 +8,8 @@ import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages import Wizard.Database.Migration.Development.Document.Data.Documents import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ import qualified Wizard.Database.Migration.Development.User.UserMigration as USR import Wizard.Model.Document.DocumentContext import Wizard.Model.Report.Report @@ -28,10 +28,10 @@ documentIntegrationSpec appContext = -- AND: Run migrations runInContextIO USR.runMigration appContext runInContextIO TML.runMigration appContext - runInContextIO QTN.runMigration appContext + runInContextIO PRJ.runMigration appContext runInContextIO (insertPackage germanyKmPackage) appContext runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext -- WHEN: - (Right result) <- runInContext (createDocumentContext doc1 germanyKmPackage [] questionnaire1 Nothing) appContext + (Right result) <- runInContext (createDocumentContext doc1 germanyKmPackage [] project1 Nothing) appContext -- THEN: compareDocumentContexts result expectation diff --git a/wizard-server/test/Wizard/Specs/Service/KnowledgeModel/Editor/KnowledgeModelEditorServiceSpec.hs b/wizard-server/test/Wizard/Specs/Service/KnowledgeModel/Editor/KnowledgeModelEditorServiceSpec.hs index 788e1fb64..aa16d06d3 100644 --- a/wizard-server/test/Wizard/Specs/Service/KnowledgeModel/Editor/KnowledgeModelEditorServiceSpec.hs +++ b/wizard-server/test/Wizard/Specs/Service/KnowledgeModel/Editor/KnowledgeModelEditorServiceSpec.hs @@ -20,7 +20,7 @@ import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditor import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditorState import Wizard.Model.KnowledgeModel.Migration.KnowledgeModelMigration import Wizard.Service.KnowledgeModel.Editor.EditorUtil -import Wizard.Service.KnowledgeModel.Migration.MigrationService +import Wizard.Service.KnowledgeModel.Migration.KnowledgeModelMigrationService import Wizard.Specs.Common diff --git a/wizard-server/test/Wizard/Specs/Service/Project/Collaboration/ProjectCollaborationAclSpec.hs b/wizard-server/test/Wizard/Specs/Service/Project/Collaboration/ProjectCollaborationAclSpec.hs new file mode 100644 index 000000000..df85c5750 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/Service/Project/Collaboration/ProjectCollaborationAclSpec.hs @@ -0,0 +1,190 @@ +module Wizard.Specs.Service.Project.Collaboration.ProjectCollaborationAclSpec where + +import Test.Hspec + +import Shared.Common.Util.Uuid +import Wizard.Database.Migration.Development.User.Data.Users +import Wizard.Model.Project.Acl.ProjectPerm +import Wizard.Model.Project.Project +import Wizard.Model.User.User +import Wizard.Model.Websocket.WebsocketRecord +import Wizard.Service.Project.Collaboration.ProjectCollaborationAcl +import Wizard.Service.Project.ProjectMapper +import WizardLib.Public.Database.Migration.Development.User.Data.UserGroups +import WizardLib.Public.Model.User.UserGroup +import WizardLib.Public.Model.User.UserGroupMembership + +import Wizard.Specs.Common + +projectCollaborationAclSpec appContext = + describe "Project Collaboration ACL" $ do + let permissions = + [ toUserProjectPerm + (u' "808d4770-0d38-45b0-a028-0a3ffaafc617") + userNikola.uuid + ownerPermissions + userNikola.tenantUuid + , toUserProjectPerm + (u' "52e74b8b-ca73-4d6a-a7e1-5c0f34a1819a") + userNicolaus.uuid + editorPermissions + userNicolaus.tenantUuid + , toUserProjectPerm + (u' "3d60a813-5e54-4fd2-8fe8-5cf3c076bd50") + userGalileo.uuid + viewerPermissions + userGalileo.tenantUuid + , toUserGroupProjectPerm + (u' "b90b17f4-06a2-40dc-b364-88d8f195c8a0") + bioGroup.uuid + ownerPermissions + bioGroup.tenantUuid + , toUserGroupProjectPerm + (u' "fcead22d-e453-47a3-84bc-5c29698ab990") + plantGroup.uuid + editorPermissions + plantGroup.tenantUuid + , toUserGroupProjectPerm + (u' "4e0765e8-f25c-4091-8531-aed2eef161f6") + animalGroup.uuid + viewerPermissions + animalGroup.tenantUuid + ] + let (admin, adminRole, adminGroups) = (Just userAlbert.uuid, Just _USER_ROLE_ADMIN, []) + let (owner, ownerRole, ownerGroups) = (Just userNikola.uuid, Just _USER_ROLE_RESEARCHER, []) + let (editor, editorRole, editorGroups) = (Just userNicolaus.uuid, Just _USER_ROLE_RESEARCHER, []) + let (viewer, viewerRole, viewerGroups) = (Just userGalileo.uuid, Just _USER_ROLE_RESEARCHER, []) + let (userInOwnerGroup, userInOwnerGroupRole, userInOwnerGroupGroups) = + ( Just userIsaac.uuid + , Just _USER_ROLE_RESEARCHER + , [userIsaacBioGroupMembership.userGroupUuid, userIsaacPlantGroupMembership.userGroupUuid, userIsaacAnimalGroupMembership.userGroupUuid] + ) + let (userInEditorGroup, userInEditorGroupRole, userInEditorGroupGroups) = + ( Just userIsaac.uuid + , Just _USER_ROLE_RESEARCHER + , [userIsaacPlantGroupMembership.userGroupUuid, userIsaacAnimalGroupMembership.userGroupUuid] + ) + let (userInViewerGroup, userInViewerGroupRole, userInViewerGroupGroups) = + ( Just userIsaac.uuid + , Just _USER_ROLE_RESEARCHER + , [userIsaacAnimalGroupMembership.userGroupUuid] + ) + let (userWithoutPerm, userWithoutPermRole, userWithoutPermGroups) = + (Just userIsaac.uuid, Just _USER_ROLE_RESEARCHER, []) + let (anonymous, anonymousRole, anonymousGroups) = (Nothing, Nothing, []) + describe "getPermission" $ do + it "PrivateProjectVisibility RestrictedProjectSharing" $ do + let fn = getPermission PrivateProjectVisibility RestrictedProjectSharing permissions + fn admin adminRole adminGroups `shouldBe` EditorWebsocketPerm + fn owner ownerRole ownerGroups `shouldBe` EditorWebsocketPerm + fn editor editorRole editorGroups `shouldBe` EditorWebsocketPerm + fn viewer viewerRole viewerGroups `shouldBe` ViewerWebsocketPerm + fn userInOwnerGroup userInOwnerGroupRole userInOwnerGroupGroups `shouldBe` EditorWebsocketPerm + fn userInEditorGroup userInEditorGroupRole userInEditorGroupGroups `shouldBe` EditorWebsocketPerm + fn userInViewerGroup userInViewerGroupRole userInViewerGroupGroups `shouldBe` ViewerWebsocketPerm + fn userWithoutPerm userWithoutPermRole userWithoutPermGroups `shouldBe` NoWebsocketPerm + fn anonymous anonymousRole anonymousGroups `shouldBe` NoWebsocketPerm + it "VisibleViewProjectVisibility RestrictedProjectSharing" $ do + let fn = getPermission VisibleViewProjectVisibility RestrictedProjectSharing permissions + fn admin adminRole adminGroups `shouldBe` EditorWebsocketPerm + fn owner ownerRole ownerGroups `shouldBe` EditorWebsocketPerm + fn editor editorRole editorGroups `shouldBe` EditorWebsocketPerm + fn viewer viewerRole viewerGroups `shouldBe` ViewerWebsocketPerm + fn userInOwnerGroup userInOwnerGroupRole userInOwnerGroupGroups `shouldBe` EditorWebsocketPerm + fn userInEditorGroup userInEditorGroupRole userInEditorGroupGroups `shouldBe` EditorWebsocketPerm + fn userInViewerGroup userInViewerGroupRole userInViewerGroupGroups `shouldBe` ViewerWebsocketPerm + fn userWithoutPerm userWithoutPermRole userWithoutPermGroups `shouldBe` ViewerWebsocketPerm + fn anonymous anonymousRole anonymousGroups `shouldBe` NoWebsocketPerm + it "VisibleEditProjectVisibility AnyoneWithLinkViewProjectSharing" $ do + let fn = getPermission VisibleEditProjectVisibility AnyoneWithLinkViewProjectSharing permissions + fn admin adminRole adminGroups `shouldBe` EditorWebsocketPerm + fn owner ownerRole ownerGroups `shouldBe` EditorWebsocketPerm + fn editor editorRole editorGroups `shouldBe` EditorWebsocketPerm + fn viewer viewerRole viewerGroups `shouldBe` EditorWebsocketPerm + fn userWithoutPerm userWithoutPermRole userWithoutPermGroups `shouldBe` EditorWebsocketPerm + fn anonymous anonymousRole anonymousGroups `shouldBe` ViewerWebsocketPerm + -- -------------------- + it "PrivateProjectVisibility AnyoneWithLinkViewProjectSharing" $ do + let fn = getPermission PrivateProjectVisibility AnyoneWithLinkViewProjectSharing permissions + fn admin adminRole adminGroups `shouldBe` EditorWebsocketPerm + fn owner ownerRole ownerGroups `shouldBe` EditorWebsocketPerm + fn editor editorRole editorGroups `shouldBe` EditorWebsocketPerm + fn viewer viewerRole viewerGroups `shouldBe` ViewerWebsocketPerm + fn userInOwnerGroup userInOwnerGroupRole userInOwnerGroupGroups `shouldBe` EditorWebsocketPerm + fn userInEditorGroup userInEditorGroupRole userInEditorGroupGroups `shouldBe` EditorWebsocketPerm + fn userInViewerGroup userInViewerGroupRole userInViewerGroupGroups `shouldBe` ViewerWebsocketPerm + fn userWithoutPerm userWithoutPermRole userWithoutPermGroups `shouldBe` ViewerWebsocketPerm + fn anonymous anonymousRole anonymousGroups `shouldBe` ViewerWebsocketPerm + it "VisibleViewProjectVisibility AnyoneWithLinkViewProjectSharing" $ do + let fn = getPermission VisibleViewProjectVisibility AnyoneWithLinkViewProjectSharing permissions + fn admin adminRole adminGroups `shouldBe` EditorWebsocketPerm + fn owner ownerRole ownerGroups `shouldBe` EditorWebsocketPerm + fn editor editorRole editorGroups `shouldBe` EditorWebsocketPerm + fn viewer viewerRole viewerGroups `shouldBe` ViewerWebsocketPerm + fn userInOwnerGroup userInOwnerGroupRole userInOwnerGroupGroups `shouldBe` EditorWebsocketPerm + fn userInEditorGroup userInEditorGroupRole userInEditorGroupGroups `shouldBe` EditorWebsocketPerm + fn userInViewerGroup userInViewerGroupRole userInViewerGroupGroups `shouldBe` ViewerWebsocketPerm + fn userWithoutPerm userWithoutPermRole userWithoutPermGroups `shouldBe` ViewerWebsocketPerm + fn anonymous anonymousRole anonymousGroups `shouldBe` ViewerWebsocketPerm + it "VisibleEditProjectVisibility AnyoneWithLinkViewProjectSharing" $ do + let fn = getPermission VisibleEditProjectVisibility AnyoneWithLinkViewProjectSharing permissions + fn admin adminRole adminGroups `shouldBe` EditorWebsocketPerm + fn owner ownerRole ownerGroups `shouldBe` EditorWebsocketPerm + fn editor editorRole editorGroups `shouldBe` EditorWebsocketPerm + fn viewer viewerRole viewerGroups `shouldBe` EditorWebsocketPerm + fn userInOwnerGroup userInOwnerGroupRole userInOwnerGroupGroups `shouldBe` EditorWebsocketPerm + fn userInEditorGroup userInEditorGroupRole userInEditorGroupGroups `shouldBe` EditorWebsocketPerm + fn userInViewerGroup userInViewerGroupRole userInViewerGroupGroups `shouldBe` EditorWebsocketPerm + fn userWithoutPerm userWithoutPermRole userWithoutPermGroups `shouldBe` EditorWebsocketPerm + fn anonymous anonymousRole anonymousGroups `shouldBe` ViewerWebsocketPerm + -- -------------------- + it "PrivateProjectVisibility AnyoneWithLinkEditProjectSharing" $ do + let fn = getPermission PrivateProjectVisibility AnyoneWithLinkEditProjectSharing permissions + fn admin adminRole adminGroups `shouldBe` EditorWebsocketPerm + fn owner ownerRole ownerGroups `shouldBe` EditorWebsocketPerm + fn editor editorRole editorGroups `shouldBe` EditorWebsocketPerm + fn viewer viewerRole viewerGroups `shouldBe` EditorWebsocketPerm + fn userInOwnerGroup userInOwnerGroupRole userInOwnerGroupGroups `shouldBe` EditorWebsocketPerm + fn userInEditorGroup userInEditorGroupRole userInEditorGroupGroups `shouldBe` EditorWebsocketPerm + fn userInViewerGroup userInViewerGroupRole userInViewerGroupGroups `shouldBe` EditorWebsocketPerm + fn userWithoutPerm userWithoutPermRole userWithoutPermGroups `shouldBe` EditorWebsocketPerm + fn anonymous anonymousRole anonymousGroups `shouldBe` EditorWebsocketPerm + it "VisibleViewProjectVisibility AnyoneWithLinkEditProjectSharing" $ do + let fn = getPermission VisibleViewProjectVisibility AnyoneWithLinkEditProjectSharing permissions + fn admin adminRole adminGroups `shouldBe` EditorWebsocketPerm + fn owner ownerRole ownerGroups `shouldBe` EditorWebsocketPerm + fn editor editorRole editorGroups `shouldBe` EditorWebsocketPerm + fn viewer viewerRole viewerGroups `shouldBe` EditorWebsocketPerm + fn userInOwnerGroup userInOwnerGroupRole userInOwnerGroupGroups `shouldBe` EditorWebsocketPerm + fn userInEditorGroup userInEditorGroupRole userInEditorGroupGroups `shouldBe` EditorWebsocketPerm + fn userInViewerGroup userInViewerGroupRole userInViewerGroupGroups `shouldBe` EditorWebsocketPerm + fn userWithoutPerm userWithoutPermRole userWithoutPermGroups `shouldBe` EditorWebsocketPerm + fn anonymous anonymousRole anonymousGroups `shouldBe` EditorWebsocketPerm + it "VisibleEditProjectVisibility AnyoneWithLinkEditProjectSharing" $ do + let fn = getPermission VisibleEditProjectVisibility AnyoneWithLinkEditProjectSharing permissions + fn admin adminRole adminGroups `shouldBe` EditorWebsocketPerm + fn owner ownerRole ownerGroups `shouldBe` EditorWebsocketPerm + fn editor editorRole editorGroups `shouldBe` EditorWebsocketPerm + fn viewer viewerRole viewerGroups `shouldBe` EditorWebsocketPerm + fn userInOwnerGroup userInOwnerGroupRole userInOwnerGroupGroups `shouldBe` EditorWebsocketPerm + fn userInEditorGroup userInEditorGroupRole userInEditorGroupGroups `shouldBe` EditorWebsocketPerm + fn userInViewerGroup userInViewerGroupRole userInViewerGroupGroups `shouldBe` EditorWebsocketPerm + fn userWithoutPerm userWithoutPermRole userWithoutPermGroups `shouldBe` EditorWebsocketPerm + fn anonymous anonymousRole anonymousGroups `shouldBe` EditorWebsocketPerm + describe "check permissions" $ do + let record perm = + WebsocketRecord + { connectionUuid = undefined + , connection = undefined + , entityId = undefined + , entityPerm = perm + , user = undefined + } + it "checkViewPermission" $ do + shouldSucceed appContext (checkViewPermission (record EditorWebsocketPerm)) + shouldSucceed appContext (checkViewPermission (record ViewerWebsocketPerm)) + shouldFailed appContext (checkViewPermission (record NoWebsocketPerm)) + it "checkEditPermission" $ do + shouldSucceed appContext (checkEditPermission (record EditorWebsocketPerm)) + shouldFailed appContext (checkEditPermission (record ViewerWebsocketPerm)) + shouldFailed appContext (checkEditPermission (record NoWebsocketPerm)) diff --git a/wizard-server/test/Wizard/Specs/Service/Project/Compiler/ProjectCompilerServiceSpec.hs b/wizard-server/test/Wizard/Specs/Service/Project/Compiler/ProjectCompilerServiceSpec.hs new file mode 100644 index 000000000..f5b498e28 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/Service/Project/Compiler/ProjectCompilerServiceSpec.hs @@ -0,0 +1,49 @@ +module Wizard.Specs.Service.Project.Compiler.ProjectCompilerServiceSpec where + +import Test.Hspec + +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.Project.Data.ProjectLabels +import Wizard.Database.Migration.Development.Project.Data.ProjectReplies +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Database.Migration.Development.User.Data.Users +import Wizard.Model.Project.Event.ProjectEvent +import Wizard.Model.Project.ProjectContent +import Wizard.Service.Project.Compiler.ProjectCompilerService +import Wizard.Service.Project.Event.ProjectEventMapper + +projectCompilerServiceSpec = + describe "Project Compiler Service" $ + describe "applyEvent" $ do + it "SetReplyEvent" $ + -- GIVEN: + do + let event = toEventList (sre_rQ1Updated' project1Uuid) (Just userAlbert) + -- WHEN: + let updatedProjectCtn = applyEvent project1Ctn event + -- THEN: + updatedProjectCtn.replies `shouldBe` fRepliesWithUpdated + it "ClearReplyEvent" $ + -- GIVEN: + do + let event = toEventList (cre_rQ1' project1Uuid) (Just userAlbert) + -- WHEN: + let updatedProjectCtn = applyEvent project1Ctn event + -- THEN: + updatedProjectCtn.replies `shouldBe` fRepliesWithDeleted + it "SetPhaseEvent" $ + -- GIVEN: + do + let event = toEventList (sphse_2' project1Uuid) (Just userAlbert) + -- WHEN: + let updatedProjectCtn = applyEvent project1Ctn event + -- THEN: + updatedProjectCtn.phaseUuid `shouldBe` (sphse_2 project1Uuid).phaseUuid + it "SetLabelsEvent" $ + -- GIVEN: + do + let event = toEventList (slble_rQ2' project1Uuid) (Just userAlbert) + -- WHEN: + let updatedProjectCtn = applyEvent project1Ctn event + -- THEN: + updatedProjectCtn.labels `shouldBe` fLabelsEdited diff --git a/wizard-server/test/Wizard/Specs/Service/Project/Event/ProjectEventServiceSpec.hs b/wizard-server/test/Wizard/Specs/Service/Project/Event/ProjectEventServiceSpec.hs new file mode 100644 index 000000000..76e446384 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/Service/Project/Event/ProjectEventServiceSpec.hs @@ -0,0 +1,208 @@ +module Wizard.Specs.Service.Project.Event.ProjectEventServiceSpec where + +import Data.Maybe (fromJust) +import Data.Time +import qualified Data.UUID as U +import Test.Hspec + +import Shared.Common.Constant.Tenant +import Shared.Common.Model.Common.Lens +import Shared.Common.Util.Date +import Shared.Common.Util.Uuid +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.Project.Data.ProjectVersions +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Model.Project.Event.ProjectEvent +import Wizard.Model.Project.Event.ProjectEventLenses () +import Wizard.Model.Project.ProjectReply +import Wizard.Model.Project.Version.ProjectVersion +import Wizard.Service.Project.Event.ProjectEventService + +-- --------------------------- +-- TESTS +-- --------------------------- +projectEventServiceSpec = + describe "ProjectEventService" $ + it "squash" $ + -- GIVEN: prepare data + do + let versions = [version1] + let events = + [ setCreatedAt q1_event1 (dt'' 2018 1 21 1) + , setCreatedAt (cre_rQ1' project1Uuid) (dt'' 2018 1 21 2) + , setCreatedAt q1_event2 (dt'' 2018 1 21 3) + , setCreatedAt (sphse_1' project1Uuid) (dt'' 2018 1 21 4) + , setCreatedAt q1_event3 (dt'' 2018 1 21 5) + , setCreatedAt (slble_rQ1' project1Uuid) (dt'' 2018 1 21 6) + , setCreatedAt q2_event1 (dt'' 2018 1 21 7) + , setCreatedAt q1_event4 (dt'' 2018 1 21 8) + , setCreatedAt q1_event5_nikola (dt'' 2018 1 21 9) + , setCreatedAt q1_event6_anonymous1 (dt'' 2018 1 21 10) + , setCreatedAt q1_event7_nikola (dt'' 2018 1 21 11) + , setCreatedAt q1_event8_nikola (dt'' 2018 1 21 12) + , setCreatedAt q2_event2 (dt'' 2018 1 22 0) + ] + -- AND: prepare expectation + let expEvents = + [ setCreatedAt (cre_rQ1' project1Uuid) (dt'' 2018 1 21 2) + , setCreatedAt (sphse_1' project1Uuid) (dt'' 2018 1 21 4) + , setCreatedAt (slble_rQ1' project1Uuid) (dt'' 2018 1 21 6) + , setCreatedAt q2_event1 (dt'' 2018 1 21 7) + , setCreatedAt q1_event4 (dt'' 2018 1 21 8) + , setCreatedAt q1_event5_nikola (dt'' 2018 1 21 9) + , setCreatedAt q1_event6_anonymous1 (dt'' 2018 1 21 10) + , setCreatedAt q1_event7_nikola (dt'' 2018 1 21 11) + , setCreatedAt q1_event8_nikola (dt'' 2018 1 21 12) + , setCreatedAt q2_event2 (dt'' 2018 1 22 0) + ] + -- WHEN: + let resultEvents = squash versions events + -- THEN: + resultEvents `shouldBe` expEvents + +-- --------------------------- +-- EVENTS +-- --------------------------- +q1_event1 :: ProjectEvent +q1_event1 = + SetReplyEvent' $ + SetReplyEvent + { uuid = createEventUuid project1Uuid "4b2a1d62f725" + , path = "question1" + , value = StringReply "question1_value_1" + , projectUuid = project1Uuid + , tenantUuid = defaultTenantUuid + , createdBy = albert + , createdAt = dt'' 2018 1 21 0 + } + +q1_event2 :: ProjectEvent +q1_event2 = + SetReplyEvent' $ + SetReplyEvent + { uuid = createEventUuid project1Uuid "0d2b486b3231" + , path = "question1" + , value = StringReply "question1_value_2" + , projectUuid = project1Uuid + , tenantUuid = defaultTenantUuid + , createdBy = albert + , createdAt = dt'' 2018 1 21 1 + } + +q1_event3 :: ProjectEvent +q1_event3 = + SetReplyEvent' $ + SetReplyEvent + { uuid = createEventUuid project1Uuid "04702766ab48" + , path = "question1" + , value = StringReply "question1_value_3" + , projectUuid = project1Uuid + , tenantUuid = defaultTenantUuid + , createdBy = albert + , createdAt = dt'' 2018 1 21 2 + } + +q2_event1 :: ProjectEvent +q2_event1 = + SetReplyEvent' $ + SetReplyEvent + { uuid = createEventUuid project1Uuid "b2eb9e2aacc7" + , path = "question2" + , value = StringReply "question2_value_1" + , projectUuid = project1Uuid + , tenantUuid = defaultTenantUuid + , createdBy = albert + , createdAt = dt'' 2018 1 21 3 + } + +q1_event4 :: ProjectEvent +q1_event4 = + SetReplyEvent' $ + SetReplyEvent + { uuid = createEventUuid project1Uuid "4db8b2bd8345" + , path = "question1" + , value = StringReply "question1_value_4" + , projectUuid = project1Uuid + , tenantUuid = defaultTenantUuid + , createdBy = albert + , createdAt = dt'' 2018 1 21 4 + } + +q1_event5_nikola :: ProjectEvent +q1_event5_nikola = + SetReplyEvent' $ + SetReplyEvent + { uuid = createEventUuid project1Uuid "3fa10bf8bc47" + , path = "question1" + , value = StringReply "question1_value_5" + , projectUuid = project1Uuid + , tenantUuid = defaultTenantUuid + , createdBy = nikola + , createdAt = dt'' 2018 1 21 5 + } + +q1_event6_anonymous1 :: ProjectEvent +q1_event6_anonymous1 = + SetReplyEvent' $ + SetReplyEvent + { uuid = createEventUuid project1Uuid "fbbb6cc6d91c" + , path = "question1" + , value = StringReply "question1_value_6" + , projectUuid = project1Uuid + , tenantUuid = defaultTenantUuid + , createdBy = Nothing + , createdAt = dt'' 2018 1 21 6 + } + +q1_event7_nikola :: ProjectEvent +q1_event7_nikola = + SetReplyEvent' $ + SetReplyEvent + { uuid = createEventUuid project1Uuid "fe7cfccc9c50" + , path = "question1" + , value = StringReply "question1_value_7" + , projectUuid = project1Uuid + , tenantUuid = defaultTenantUuid + , createdBy = nikola + , createdAt = dt'' 2018 1 21 7 + } + +q1_event8_nikola :: ProjectEvent +q1_event8_nikola = + SetReplyEvent' $ + SetReplyEvent + { uuid = createEventUuid project1Uuid "b9c6b1dd31f8" + , path = "question1" + , value = StringReply "question1_value_8" + , projectUuid = project1Uuid + , tenantUuid = defaultTenantUuid + , createdBy = nikola + , createdAt = dt'' 2018 1 21 8 + } + +q2_event2 :: ProjectEvent +q2_event2 = + SetReplyEvent' $ + SetReplyEvent + { uuid = createEventUuid project1Uuid "a023f5ef76f7" + , path = "question2" + , value = StringReply "question2_value_2" + , projectUuid = project1Uuid + , tenantUuid = defaultTenantUuid + , createdBy = albert + , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 22) 0 + } + +-- --------------------------- +-- VERSIONS +-- --------------------------- +version1 = (projectVersion1 project1Uuid) {eventUuid = getUuid q1_event7_nikola} + +-- --------------------------- +-- USERS +-- --------------------------- +albert :: Maybe U.UUID +albert = Just $ u' "3e9da440-0a4f-43dc-86b0-0fe9009ae6f3" + +nikola :: Maybe U.UUID +nikola = Just $ u' "dbcc9ac4-7e63-4d12-9a14-f2f918fd0a78" diff --git a/wizard-server/test/Wizard/Specs/Service/Questionnaire/Migration/Migrator/ChangeQTypeSanitizerSpec.hs b/wizard-server/test/Wizard/Specs/Service/Project/Migration/Migrator/ChangeQTypeSanitizerSpec.hs similarity index 94% rename from wizard-server/test/Wizard/Specs/Service/Questionnaire/Migration/Migrator/ChangeQTypeSanitizerSpec.hs rename to wizard-server/test/Wizard/Specs/Service/Project/Migration/Migrator/ChangeQTypeSanitizerSpec.hs index 73427cbbd..0af519925 100644 --- a/wizard-server/test/Wizard/Specs/Service/Questionnaire/Migration/Migrator/ChangeQTypeSanitizerSpec.hs +++ b/wizard-server/test/Wizard/Specs/Service/Project/Migration/Migrator/ChangeQTypeSanitizerSpec.hs @@ -1,4 +1,4 @@ -module Wizard.Specs.Service.Questionnaire.Migration.Migrator.ChangeQTypeSanitizerSpec where +module Wizard.Specs.Service.Project.Migration.Migrator.ChangeQTypeSanitizerSpec where import Data.Maybe (fromJust) import Data.Time @@ -9,10 +9,10 @@ import Shared.Common.Util.Uuid import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.AnswersAndFollowUpQuestions import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.KnowledgeModels import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireReplies +import Wizard.Database.Migration.Development.Project.Data.ProjectReplies import Wizard.Database.Migration.Development.User.Data.Users -import Wizard.Model.Questionnaire.QuestionnaireReply -import Wizard.Service.Questionnaire.Migration.Migrator.ChangeQTypeSanitizer +import Wizard.Model.Project.ProjectReply +import Wizard.Service.Project.Migration.Migrator.ChangeQTypeSanitizer import qualified Wizard.Service.User.UserMapper as UM sanitizerSpec = diff --git a/wizard-server/test/Wizard/Specs/Service/Questionnaire/Migration/Migrator/MoveSanitizerSpec.hs b/wizard-server/test/Wizard/Specs/Service/Project/Migration/Migrator/MoveSanitizerSpec.hs similarity index 96% rename from wizard-server/test/Wizard/Specs/Service/Questionnaire/Migration/Migrator/MoveSanitizerSpec.hs rename to wizard-server/test/Wizard/Specs/Service/Project/Migration/Migrator/MoveSanitizerSpec.hs index 6b6ab58bc..9e2f422e7 100644 --- a/wizard-server/test/Wizard/Specs/Service/Questionnaire/Migration/Migrator/MoveSanitizerSpec.hs +++ b/wizard-server/test/Wizard/Specs/Service/Project/Migration/Migrator/MoveSanitizerSpec.hs @@ -1,4 +1,4 @@ -module Wizard.Specs.Service.Questionnaire.Migration.Migrator.MoveSanitizerSpec where +module Wizard.Specs.Service.Project.Migration.Migrator.MoveSanitizerSpec where import qualified Data.Map.Strict as M import qualified Data.UUID as U @@ -16,11 +16,11 @@ import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data. import Shared.KnowledgeModel.Model.KnowledgeModel.Event.KnowledgeModelEvent import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModelUtil -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireReplies -import Wizard.Model.Questionnaire.QuestionnaireUtil +import Wizard.Database.Migration.Development.Project.Data.ProjectReplies +import Wizard.Model.Project.ProjectUtil import Wizard.Service.KnowledgeModel.Compiler.Compiler -import Wizard.Service.Questionnaire.Migration.Migrator.MoveEventGenerator -import Wizard.Service.Questionnaire.Migration.Migrator.MoveSanitizer +import Wizard.Service.Project.Migration.Migrator.MoveEventGenerator +import Wizard.Service.Project.Migration.Migrator.MoveSanitizer sanitizerSpec = describe "MoveSanitizer" $ do diff --git a/wizard-server/test/Wizard/Specs/Service/Project/Migration/Migrator/SanitizerSpec.hs b/wizard-server/test/Wizard/Specs/Service/Project/Migration/Migrator/SanitizerSpec.hs new file mode 100644 index 000000000..c86c09965 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/Service/Project/Migration/Migrator/SanitizerSpec.hs @@ -0,0 +1,45 @@ +module Wizard.Specs.Service.Project.Migration.Migrator.SanitizerSpec where + +import Test.Hspec hiding (shouldBe, shouldNotBe) +import Test.Hspec.Expectations.Pretty + +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.KnowledgeModels +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Questions +import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel +import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModelLenses +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.Project.Data.ProjectReplies +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Model.Project.Event.ProjectEventList +import Wizard.Model.Project.ProjectReply +import Wizard.Service.Project.Migration.Migrator.Sanitizer + +import Wizard.Specs.Common + +sanitizerIntegrationSpec appContext = + describe "Sanitizer" $ + describe "sanitizeProjectEvents" $ + it "Succeed" $ + -- GIVEN: + do + let oldKm = km1WithQ4 + let newKm = + putInQuestionsM question1.uuid question1WithNewType' + . putInQuestionsM question9.uuid question9WithNewType' + $ km1WithQ4 + let projectEvents = fEventsList project1Uuid + -- WHEN: + (Right result) <- runInContext (sanitizeProjectEvents project1Uuid oldKm newKm projectEvents) appContext + -- THEN: + extractEventPath (result !! 16) `shouldBe` fst rQ1 + extractEventPath (result !! 17) `shouldBe` fst rQ9 + extractSetEventValue (result !! 17) `shouldBe` (snd rQ9WithNewType).value + +extractEventPath :: ProjectEventList -> String +extractEventPath (ClearReplyEventList' event) = event.path +extractEventPath (SetReplyEventList' event) = event.path +extractEventPath _ = error "Expected ClearReplyEventList' or SetReplyEventList'" + +extractSetEventValue :: ProjectEventList -> ReplyValue +extractSetEventValue (SetReplyEventList' event) = event.value +extractSetEventValue _ = error "Expected SetReplyEventList'" diff --git a/wizard-server/test/Wizard/Specs/Service/Project/ProjectAclSpec.hs b/wizard-server/test/Wizard/Specs/Service/Project/ProjectAclSpec.hs new file mode 100644 index 000000000..dddfc6316 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/Service/Project/ProjectAclSpec.hs @@ -0,0 +1,408 @@ +module Wizard.Specs.Service.Project.ProjectAclSpec where + +import Data.Foldable (traverse_) +import Test.Hspec + +import Shared.Common.Util.Uuid +import Shared.DocumentTemplate.Database.DAO.DocumentTemplate.DocumentTemplateDAO +import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplates +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectPermDAO +import Wizard.Database.DAO.User.UserDAO +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Database.Migration.Development.User.Data.Users +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Acl.ProjectPerm +import Wizard.Model.Project.Project +import Wizard.Model.User.User +import Wizard.Service.Project.ProjectAcl +import Wizard.Service.Project.ProjectMapper +import qualified Wizard.Service.User.UserMapper as U_Mapper +import WizardLib.Public.Database.DAO.User.UserGroupDAO +import WizardLib.Public.Database.DAO.User.UserGroupMembershipDAO +import WizardLib.Public.Database.Migration.Development.User.Data.UserGroups +import WizardLib.Public.Model.User.UserGroup + +import Wizard.Specs.Common + +projectAclSpec appContext = + describe "Project ACL" $ do + let permissions = + [ toUserProjectPerm + (u' "808d4770-0d38-45b0-a028-0a3ffaafc617") + userNikola.uuid + ownerPermissions + userNikola.tenantUuid + , toUserProjectPerm + (u' "52e74b8b-ca73-4d6a-a7e1-5c0f34a1819a") + userNicolaus.uuid + editorPermissions + userNicolaus.tenantUuid + , toUserProjectPerm + (u' "3d60a813-5e54-4fd2-8fe8-5cf3c076bd50") + userGalileo.uuid + viewerPermissions + userGalileo.tenantUuid + , toUserGroupProjectPerm + (u' "b90b17f4-06a2-40dc-b364-88d8f195c8a0") + bioGroup.uuid + ownerPermissions + bioGroup.tenantUuid + , toUserGroupProjectPerm + (u' "fcead22d-e453-47a3-84bc-5c29698ab990") + plantGroup.uuid + editorPermissions + plantGroup.tenantUuid + , toUserGroupProjectPerm + (u' "4e0765e8-f25c-4091-8531-aed2eef161f6") + animalGroup.uuid + viewerPermissions + animalGroup.tenantUuid + ] + let makeContext user = appContext {currentUser = Just . U_Mapper.toDTO $ user} + let adminCtx = makeContext userAlbert + let ownerCtx = makeContext userNikola + let editorCtx = makeContext userNicolaus + let viewerCtx = makeContext userGalileo + let userInOwnerGroupCtx = makeContext userIsaac + let userInEditorGroupCtx = makeContext userIsaac + let userInViewerGroupCtx = makeContext userIsaac + let userWithoutPermCtx = makeContext userIsaac + let anonymousCtx = appContext {currentUser = Nothing} + it "checkViewPermissionToProject" $ do + runLocalTestMigration appContext + let fn1 memberships = do + deleteUserGroupMemberships + traverse_ insertUserGroupMembership memberships + checkViewPermissionToProject PrivateProjectVisibility RestrictedProjectSharing permissions + shouldSucceed adminCtx (fn1 []) + shouldSucceed ownerCtx (fn1 []) + shouldSucceed editorCtx (fn1 []) + shouldSucceed viewerCtx (fn1 []) + shouldSucceed userInOwnerGroupCtx (fn1 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInEditorGroupCtx (fn1 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInViewerGroupCtx (fn1 [userIsaacAnimalGroupMembership]) + shouldFailed userWithoutPermCtx (fn1 []) + shouldFailed anonymousCtx (fn1 []) + let fn2 memberships = do + deleteUserGroupMemberships + traverse_ insertUserGroupMembership memberships + checkViewPermissionToProject VisibleViewProjectVisibility RestrictedProjectSharing permissions + shouldSucceed adminCtx (fn2 []) + shouldSucceed ownerCtx (fn2 []) + shouldSucceed editorCtx (fn2 []) + shouldSucceed viewerCtx (fn2 []) + shouldSucceed userInOwnerGroupCtx (fn2 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInEditorGroupCtx (fn2 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInViewerGroupCtx (fn2 [userIsaacAnimalGroupMembership]) + shouldSucceed userWithoutPermCtx (fn2 []) + shouldFailed anonymousCtx (fn2 []) + let fn3 memberships = do + deleteUserGroupMemberships + traverse_ insertUserGroupMembership memberships + checkViewPermissionToProject VisibleEditProjectVisibility RestrictedProjectSharing permissions + shouldSucceed adminCtx (fn3 []) + shouldSucceed ownerCtx (fn3 []) + shouldSucceed editorCtx (fn3 []) + shouldSucceed viewerCtx (fn3 []) + shouldSucceed userInOwnerGroupCtx (fn3 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInEditorGroupCtx (fn3 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInViewerGroupCtx (fn3 [userIsaacAnimalGroupMembership]) + shouldSucceed userWithoutPermCtx (fn3 []) + shouldFailed anonymousCtx (fn3 []) + -- -------------------- + let fn4 memberships = do + deleteUserGroupMemberships + traverse_ insertUserGroupMembership memberships + checkViewPermissionToProject PrivateProjectVisibility AnyoneWithLinkViewProjectSharing permissions + shouldSucceed adminCtx (fn4 []) + shouldSucceed ownerCtx (fn4 []) + shouldSucceed editorCtx (fn4 []) + shouldSucceed viewerCtx (fn4 []) + shouldSucceed userInOwnerGroupCtx (fn4 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInEditorGroupCtx (fn4 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInViewerGroupCtx (fn4 [userIsaacAnimalGroupMembership]) + shouldSucceed userWithoutPermCtx (fn4 []) + shouldSucceed anonymousCtx (fn4 []) + let fn5 memberships = do + deleteUserGroupMemberships + traverse_ insertUserGroupMembership memberships + checkViewPermissionToProject VisibleViewProjectVisibility AnyoneWithLinkViewProjectSharing permissions + shouldSucceed adminCtx (fn5 []) + shouldSucceed ownerCtx (fn5 []) + shouldSucceed editorCtx (fn5 []) + shouldSucceed viewerCtx (fn5 []) + shouldSucceed userInOwnerGroupCtx (fn5 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInEditorGroupCtx (fn5 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInViewerGroupCtx (fn5 [userIsaacAnimalGroupMembership]) + shouldSucceed userWithoutPermCtx (fn5 []) + shouldSucceed anonymousCtx (fn5 []) + let fn6 memberships = do + deleteUserGroupMemberships + traverse_ insertUserGroupMembership memberships + checkViewPermissionToProject VisibleEditProjectVisibility AnyoneWithLinkViewProjectSharing permissions + shouldSucceed adminCtx (fn6 []) + shouldSucceed ownerCtx (fn6 []) + shouldSucceed editorCtx (fn6 []) + shouldSucceed viewerCtx (fn6 []) + shouldSucceed userInOwnerGroupCtx (fn6 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInEditorGroupCtx (fn6 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInViewerGroupCtx (fn6 [userIsaacAnimalGroupMembership]) + shouldSucceed userWithoutPermCtx (fn6 []) + shouldSucceed anonymousCtx (fn6 []) + -- -------------------- + let fn7 memberships = do + deleteUserGroupMemberships + traverse_ insertUserGroupMembership memberships + checkViewPermissionToProject PrivateProjectVisibility AnyoneWithLinkEditProjectSharing permissions + shouldSucceed adminCtx (fn7 []) + shouldSucceed ownerCtx (fn7 []) + shouldSucceed editorCtx (fn7 []) + shouldSucceed viewerCtx (fn7 []) + shouldSucceed userInOwnerGroupCtx (fn7 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInEditorGroupCtx (fn7 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInViewerGroupCtx (fn7 [userIsaacAnimalGroupMembership]) + shouldSucceed userWithoutPermCtx (fn7 []) + shouldSucceed anonymousCtx (fn7 []) + let fn8 memberships = do + deleteUserGroupMemberships + traverse_ insertUserGroupMembership memberships + checkViewPermissionToProject VisibleViewProjectVisibility AnyoneWithLinkEditProjectSharing permissions + shouldSucceed adminCtx (fn8 []) + shouldSucceed ownerCtx (fn8 []) + shouldSucceed editorCtx (fn8 []) + shouldSucceed viewerCtx (fn8 []) + shouldSucceed userInOwnerGroupCtx (fn8 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInEditorGroupCtx (fn8 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInViewerGroupCtx (fn8 [userIsaacAnimalGroupMembership]) + shouldSucceed userWithoutPermCtx (fn8 []) + shouldSucceed anonymousCtx (fn8 []) + let fn9 memberships = do + deleteUserGroupMemberships + traverse_ insertUserGroupMembership memberships + checkViewPermissionToProject VisibleEditProjectVisibility AnyoneWithLinkEditProjectSharing permissions + shouldSucceed adminCtx (fn9 []) + shouldSucceed ownerCtx (fn9 []) + shouldSucceed editorCtx (fn9 []) + shouldSucceed viewerCtx (fn9 []) + shouldSucceed userInOwnerGroupCtx (fn9 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInEditorGroupCtx (fn9 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInViewerGroupCtx (fn9 [userIsaacAnimalGroupMembership]) + shouldSucceed userWithoutPermCtx (fn9 []) + shouldSucceed anonymousCtx (fn9 []) + it "checkOwnerPermissionToProject" $ do + runLocalTestMigration appContext + let fn1 memberships = do + deleteUserGroupMemberships + traverse_ insertUserGroupMembership memberships + checkOwnerPermissionToProject PrivateProjectVisibility permissions + shouldSucceed adminCtx (fn1 []) + shouldSucceed ownerCtx (fn1 []) + shouldFailed editorCtx (fn1 []) + shouldFailed viewerCtx (fn1 []) + shouldSucceed userInOwnerGroupCtx (fn1 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldFailed userInEditorGroupCtx (fn1 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldFailed userInViewerGroupCtx (fn1 [userIsaacAnimalGroupMembership]) + shouldFailed userWithoutPermCtx (fn1 []) + shouldFailed anonymousCtx (fn1 []) + let fn2 memberships = do + deleteUserGroupMemberships + traverse_ insertUserGroupMembership memberships + checkOwnerPermissionToProject VisibleViewProjectVisibility permissions + shouldSucceed adminCtx (fn2 []) + shouldSucceed ownerCtx (fn2 []) + shouldFailed editorCtx (fn2 []) + shouldFailed viewerCtx (fn2 []) + shouldSucceed userInOwnerGroupCtx (fn2 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldFailed userInEditorGroupCtx (fn2 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldFailed userInViewerGroupCtx (fn2 [userIsaacAnimalGroupMembership]) + shouldFailed userWithoutPermCtx (fn2 []) + shouldFailed anonymousCtx (fn2 []) + let fn3 memberships = do + deleteUserGroupMemberships + traverse_ insertUserGroupMembership memberships + checkOwnerPermissionToProject VisibleEditProjectVisibility permissions + shouldSucceed adminCtx (fn3 []) + shouldSucceed ownerCtx (fn3 []) + shouldFailed editorCtx (fn3 []) + shouldFailed viewerCtx (fn3 []) + shouldSucceed userInOwnerGroupCtx (fn3 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldFailed userInEditorGroupCtx (fn3 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldFailed userInViewerGroupCtx (fn3 [userIsaacAnimalGroupMembership]) + shouldFailed userWithoutPermCtx (fn3 []) + shouldFailed anonymousCtx (fn3 []) + it "checkEditPermissionToProject" $ do + runLocalTestMigration appContext + let fn1 memberships = do + deleteUserGroupMemberships + traverse_ insertUserGroupMembership memberships + checkEditPermissionToProject PrivateProjectVisibility RestrictedProjectSharing permissions + shouldSucceed adminCtx (fn1 []) + shouldSucceed ownerCtx (fn1 []) + shouldSucceed editorCtx (fn1 []) + shouldFailed viewerCtx (fn1 []) + shouldSucceed userInOwnerGroupCtx (fn1 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInEditorGroupCtx (fn1 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldFailed userInViewerGroupCtx (fn1 [userIsaacAnimalGroupMembership]) + shouldFailed userWithoutPermCtx (fn1 []) + shouldFailed anonymousCtx (fn1 []) + let fn2 memberships = do + deleteUserGroupMemberships + traverse_ insertUserGroupMembership memberships + checkEditPermissionToProject VisibleViewProjectVisibility RestrictedProjectSharing permissions + shouldSucceed adminCtx (fn2 []) + shouldSucceed ownerCtx (fn2 []) + shouldSucceed editorCtx (fn2 []) + shouldFailed viewerCtx (fn2 []) + shouldSucceed userInOwnerGroupCtx (fn2 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInEditorGroupCtx (fn2 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldFailed userInViewerGroupCtx (fn2 [userIsaacAnimalGroupMembership]) + shouldFailed userWithoutPermCtx (fn2 []) + shouldFailed anonymousCtx (fn2 []) + let fn3 memberships = do + deleteUserGroupMemberships + traverse_ insertUserGroupMembership memberships + checkEditPermissionToProject VisibleEditProjectVisibility RestrictedProjectSharing permissions + shouldSucceed adminCtx (fn3 []) + shouldSucceed ownerCtx (fn3 []) + shouldSucceed editorCtx (fn3 []) + shouldSucceed viewerCtx (fn3 []) + shouldSucceed userInOwnerGroupCtx (fn3 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInEditorGroupCtx (fn3 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInViewerGroupCtx (fn3 [userIsaacAnimalGroupMembership]) + shouldSucceed userWithoutPermCtx (fn3 []) + shouldFailed anonymousCtx (fn3 []) + -- -------------------- + let fn4 memberships = do + deleteUserGroupMemberships + traverse_ insertUserGroupMembership memberships + checkEditPermissionToProject PrivateProjectVisibility AnyoneWithLinkViewProjectSharing permissions + shouldSucceed adminCtx (fn4 []) + shouldSucceed ownerCtx (fn4 []) + shouldSucceed editorCtx (fn4 []) + shouldFailed viewerCtx (fn4 []) + shouldSucceed userInOwnerGroupCtx (fn4 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInEditorGroupCtx (fn4 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldFailed userInViewerGroupCtx (fn4 [userIsaacAnimalGroupMembership]) + shouldFailed userWithoutPermCtx (fn4 []) + shouldFailed anonymousCtx (fn4 []) + let fn5 memberships = do + deleteUserGroupMemberships + traverse_ insertUserGroupMembership memberships + checkEditPermissionToProject VisibleViewProjectVisibility AnyoneWithLinkViewProjectSharing permissions + shouldSucceed adminCtx (fn5 []) + shouldSucceed ownerCtx (fn5 []) + shouldSucceed editorCtx (fn5 []) + shouldFailed viewerCtx (fn5 []) + shouldSucceed userInOwnerGroupCtx (fn5 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInEditorGroupCtx (fn5 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldFailed userInViewerGroupCtx (fn5 [userIsaacAnimalGroupMembership]) + shouldFailed userWithoutPermCtx (fn5 []) + shouldFailed anonymousCtx (fn5 []) + let fn6 memberships = do + deleteUserGroupMemberships + traverse_ insertUserGroupMembership memberships + checkEditPermissionToProject VisibleEditProjectVisibility AnyoneWithLinkViewProjectSharing permissions + shouldSucceed adminCtx (fn6 []) + shouldSucceed ownerCtx (fn6 []) + shouldSucceed editorCtx (fn6 []) + shouldSucceed viewerCtx (fn6 []) + shouldSucceed userInOwnerGroupCtx (fn6 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInEditorGroupCtx (fn6 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInViewerGroupCtx (fn6 [userIsaacAnimalGroupMembership]) + shouldSucceed userWithoutPermCtx (fn6 []) + shouldFailed anonymousCtx (fn6 []) + -- -------------------- + let fn7 memberships = do + deleteUserGroupMemberships + traverse_ insertUserGroupMembership memberships + checkEditPermissionToProject PrivateProjectVisibility AnyoneWithLinkEditProjectSharing permissions + shouldSucceed adminCtx (fn7 []) + shouldSucceed ownerCtx (fn7 []) + shouldSucceed editorCtx (fn7 []) + shouldSucceed viewerCtx (fn7 []) + shouldSucceed userInOwnerGroupCtx (fn7 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInEditorGroupCtx (fn7 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInViewerGroupCtx (fn7 [userIsaacAnimalGroupMembership]) + shouldSucceed userWithoutPermCtx (fn7 []) + shouldSucceed anonymousCtx (fn7 []) + let fn8 memberships = do + deleteUserGroupMemberships + traverse_ insertUserGroupMembership memberships + checkEditPermissionToProject VisibleViewProjectVisibility AnyoneWithLinkEditProjectSharing permissions + shouldSucceed adminCtx (fn8 []) + shouldSucceed ownerCtx (fn8 []) + shouldSucceed editorCtx (fn8 []) + shouldSucceed viewerCtx (fn8 []) + shouldSucceed userInOwnerGroupCtx (fn8 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInEditorGroupCtx (fn8 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInViewerGroupCtx (fn8 [userIsaacAnimalGroupMembership]) + shouldSucceed userWithoutPermCtx (fn8 []) + shouldSucceed anonymousCtx (fn8 []) + let fn9 memberships = do + deleteUserGroupMemberships + traverse_ insertUserGroupMembership memberships + checkEditPermissionToProject VisibleEditProjectVisibility AnyoneWithLinkEditProjectSharing permissions + shouldSucceed adminCtx (fn9 []) + shouldSucceed ownerCtx (fn9 []) + shouldSucceed editorCtx (fn9 []) + shouldSucceed viewerCtx (fn9 []) + shouldSucceed userInOwnerGroupCtx (fn9 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInEditorGroupCtx (fn9 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInViewerGroupCtx (fn9 [userIsaacAnimalGroupMembership]) + shouldSucceed userWithoutPermCtx (fn9 []) + shouldSucceed anonymousCtx (fn9 []) + it "checkMigrationPermissionToProject" $ do + runLocalTestMigration appContext + let fn1 memberships = do + deleteUserGroupMemberships + traverse_ insertUserGroupMembership memberships + checkMigrationPermissionToProject PrivateProjectVisibility permissions + shouldSucceed adminCtx (fn1 []) + shouldSucceed ownerCtx (fn1 []) + shouldSucceed editorCtx (fn1 []) + shouldSucceed userInOwnerGroupCtx (fn1 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInEditorGroupCtx (fn1 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldFailed userInViewerGroupCtx (fn1 [userIsaacAnimalGroupMembership]) + shouldFailed viewerCtx (fn1 []) + shouldFailed userWithoutPermCtx (fn1 []) + shouldFailed anonymousCtx (fn1 []) + let fn2 memberships = do + deleteUserGroupMemberships + traverse_ insertUserGroupMembership memberships + checkMigrationPermissionToProject VisibleViewProjectVisibility permissions + shouldSucceed adminCtx (fn2 []) + shouldSucceed ownerCtx (fn2 []) + shouldSucceed editorCtx (fn2 []) + shouldFailed viewerCtx (fn2 []) + shouldSucceed userInOwnerGroupCtx (fn2 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInEditorGroupCtx (fn2 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldFailed userInViewerGroupCtx (fn2 [userIsaacAnimalGroupMembership]) + shouldFailed userWithoutPermCtx (fn2 []) + shouldFailed anonymousCtx (fn2 []) + let fn3 memberships = do + deleteUserGroupMemberships + traverse_ insertUserGroupMembership memberships + checkMigrationPermissionToProject VisibleEditProjectVisibility permissions + shouldSucceed adminCtx (fn3 []) + shouldSucceed ownerCtx (fn3 []) + shouldSucceed editorCtx (fn3 []) + shouldSucceed viewerCtx (fn3 []) + shouldSucceed userInOwnerGroupCtx (fn3 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInEditorGroupCtx (fn3 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) + shouldSucceed userInViewerGroupCtx (fn3 [userIsaacAnimalGroupMembership]) + shouldSucceed userWithoutPermCtx (fn3 []) + shouldFailed anonymousCtx (fn3 []) + +runLocalTestMigration appContext = do + runInContext deleteProjectPerms appContext + runInContext deleteProjects appContext + runInContext (insertPackage germanyKmPackage) appContext + runInContext (insertDocumentTemplate wizardDocumentTemplate) appContext + runInContext (insertProject project1) appContext + runInContext (insertUser userIsaac) appContext + runInContext (insertUserGroup bioGroup) appContext + runInContext (insertUserGroup plantGroup) appContext + runInContext (insertUserGroup animalGroup) appContext diff --git a/wizard-server/test/Wizard/Specs/Service/Project/ProjectServiceSpec.hs b/wizard-server/test/Wizard/Specs/Service/Project/ProjectServiceSpec.hs new file mode 100644 index 000000000..c7b7dc00e --- /dev/null +++ b/wizard-server/test/Wizard/Specs/Service/Project/ProjectServiceSpec.hs @@ -0,0 +1,51 @@ +module Wizard.Specs.Service.Project.ProjectServiceSpec where + +import Control.Monad.Reader (liftIO) +import Test.Hspec + +import Wizard.Database.DAO.Project.ProjectDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration +import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeModelPackageMigration as PKG_Migration +import Wizard.Database.Migration.Development.Project.Data.ProjectCommands +import qualified Wizard.Database.Migration.Development.Project.ProjectMigration as PRJ_Migration +import qualified Wizard.Database.Migration.Development.User.UserMigration as U_Migration +import Wizard.Model.Project.Project +import Wizard.Service.Project.ProjectService +import WizardLib.Public.Model.PersistentCommand.Project.CreateProjectCommand + +import Wizard.Specs.API.Common +import Wizard.Specs.Common + +projectServiceSpec appContext = + describe "Project Service" $ do + it "createProjectsFromCommands" $ + -- GIVEN: + do + runInContextIO U_Migration.runMigration appContext + runInContextIO PKG_Migration.runMigration appContext + runInContextIO TML_Migration.runMigration appContext + -- WHEN: + (Right ()) <- runInContext (createProjectsFromCommands [command1, command2]) appContext + -- THEN: + (Right projects) <- runInContext findProjects appContext + length projects `shouldBe` 2 + compareProject (head projects) command1 + compareProject (projects !! 1) command2 + + it "cleanProjects works" $ + -- GIVEN: + do + runInContextIO TML_Migration.runMigration appContext + runInContextIO PRJ_Migration.runMigration appContext + assertCountInDB findProjects appContext 3 + -- WHEN: + (Right ()) <- runInContext cleanProjects appContext + -- THEN: + assertCountInDB findProjects appContext 2 + +compareProject :: Project -> CreateProjectCommand -> IO () +compareProject project command = liftIO $ do + project.name `shouldBe` command.name + project.knowledgeModelPackageId `shouldBe` command.knowledgeModelPackageId + project.documentTemplateId `shouldBe` command.documentTemplateId + length project.permissions `shouldBe` length command.emails diff --git a/wizard-server/test/Wizard/Specs/Service/Project/ProjectValidationSpec.hs b/wizard-server/test/Wizard/Specs/Service/Project/ProjectValidationSpec.hs new file mode 100644 index 000000000..84fcaaffe --- /dev/null +++ b/wizard-server/test/Wizard/Specs/Service/Project/ProjectValidationSpec.hs @@ -0,0 +1,21 @@ +module Wizard.Specs.Service.Project.ProjectValidationSpec where + +import qualified Data.Map.Strict as M +import Test.Hspec + +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Wizard.Service.Project.ProjectValidation + +projectValidationSpec = + describe "ProjectValidation" $ do + it "isValidProjectTag" $ do + let validationError word = + Just $ ValidationError [] (M.singleton "tags" [_ERROR_VALIDATION__FORBIDDEN_CHARACTERS word]) + isValidProjectTag "a" `shouldBe` Nothing + isValidProjectTag "ab" `shouldBe` Nothing + isValidProjectTag "aB" `shouldBe` Nothing + isValidProjectTag "ab c" `shouldBe` Nothing + isValidProjectTag "ab_c" `shouldBe` Nothing + isValidProjectTag "ab-c" `shouldBe` Nothing + isValidProjectTag "ab-,c" `shouldBe` validationError "ab-,c" diff --git a/wizard-server/test/Wizard/Specs/Service/Questionnaire/Collaboration/CollaborationAclSpec.hs b/wizard-server/test/Wizard/Specs/Service/Questionnaire/Collaboration/CollaborationAclSpec.hs deleted file mode 100644 index 7a8e5dafb..000000000 --- a/wizard-server/test/Wizard/Specs/Service/Questionnaire/Collaboration/CollaborationAclSpec.hs +++ /dev/null @@ -1,190 +0,0 @@ -module Wizard.Specs.Service.Questionnaire.Collaboration.CollaborationAclSpec where - -import Test.Hspec - -import Shared.Common.Util.Uuid -import Wizard.Database.Migration.Development.User.Data.Users -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnairePerm -import Wizard.Model.User.User -import Wizard.Model.Websocket.WebsocketRecord -import Wizard.Service.Questionnaire.Collaboration.CollaborationAcl -import Wizard.Service.Questionnaire.QuestionnaireMapper -import WizardLib.Public.Database.Migration.Development.User.Data.UserGroups -import WizardLib.Public.Model.User.UserGroup -import WizardLib.Public.Model.User.UserGroupMembership - -import Wizard.Specs.Common - -questionnaireCollaborationAclSpec appContext = - describe "Questionnaire Collaboration ACL" $ do - let permissions = - [ toUserQuestionnairePerm - (u' "808d4770-0d38-45b0-a028-0a3ffaafc617") - userNikola.uuid - ownerPermissions - userNikola.tenantUuid - , toUserQuestionnairePerm - (u' "52e74b8b-ca73-4d6a-a7e1-5c0f34a1819a") - userNicolaus.uuid - editorPermissions - userNicolaus.tenantUuid - , toUserQuestionnairePerm - (u' "3d60a813-5e54-4fd2-8fe8-5cf3c076bd50") - userGalileo.uuid - viewerPermissions - userGalileo.tenantUuid - , toUserGroupQuestionnairePerm - (u' "b90b17f4-06a2-40dc-b364-88d8f195c8a0") - bioGroup.uuid - ownerPermissions - bioGroup.tenantUuid - , toUserGroupQuestionnairePerm - (u' "fcead22d-e453-47a3-84bc-5c29698ab990") - plantGroup.uuid - editorPermissions - plantGroup.tenantUuid - , toUserGroupQuestionnairePerm - (u' "4e0765e8-f25c-4091-8531-aed2eef161f6") - animalGroup.uuid - viewerPermissions - animalGroup.tenantUuid - ] - let (admin, adminRole, adminGroups) = (Just userAlbert.uuid, Just _USER_ROLE_ADMIN, []) - let (owner, ownerRole, ownerGroups) = (Just userNikola.uuid, Just _USER_ROLE_RESEARCHER, []) - let (editor, editorRole, editorGroups) = (Just userNicolaus.uuid, Just _USER_ROLE_RESEARCHER, []) - let (viewer, viewerRole, viewerGroups) = (Just userGalileo.uuid, Just _USER_ROLE_RESEARCHER, []) - let (userInOwnerGroup, userInOwnerGroupRole, userInOwnerGroupGroups) = - ( Just userIsaac.uuid - , Just _USER_ROLE_RESEARCHER - , [userIsaacBioGroupMembership.userGroupUuid, userIsaacPlantGroupMembership.userGroupUuid, userIsaacAnimalGroupMembership.userGroupUuid] - ) - let (userInEditorGroup, userInEditorGroupRole, userInEditorGroupGroups) = - ( Just userIsaac.uuid - , Just _USER_ROLE_RESEARCHER - , [userIsaacPlantGroupMembership.userGroupUuid, userIsaacAnimalGroupMembership.userGroupUuid] - ) - let (userInViewerGroup, userInViewerGroupRole, userInViewerGroupGroups) = - ( Just userIsaac.uuid - , Just _USER_ROLE_RESEARCHER - , [userIsaacAnimalGroupMembership.userGroupUuid] - ) - let (userWithoutPerm, userWithoutPermRole, userWithoutPermGroups) = - (Just userIsaac.uuid, Just _USER_ROLE_RESEARCHER, []) - let (anonymous, anonymousRole, anonymousGroups) = (Nothing, Nothing, []) - describe "getPermission" $ do - it "PrivateQuestionnaire RestrictedQuestionnaire" $ do - let fn = getPermission PrivateQuestionnaire RestrictedQuestionnaire permissions - fn admin adminRole adminGroups `shouldBe` EditorWebsocketPerm - fn owner ownerRole ownerGroups `shouldBe` EditorWebsocketPerm - fn editor editorRole editorGroups `shouldBe` EditorWebsocketPerm - fn viewer viewerRole viewerGroups `shouldBe` ViewerWebsocketPerm - fn userInOwnerGroup userInOwnerGroupRole userInOwnerGroupGroups `shouldBe` EditorWebsocketPerm - fn userInEditorGroup userInEditorGroupRole userInEditorGroupGroups `shouldBe` EditorWebsocketPerm - fn userInViewerGroup userInViewerGroupRole userInViewerGroupGroups `shouldBe` ViewerWebsocketPerm - fn userWithoutPerm userWithoutPermRole userWithoutPermGroups `shouldBe` NoWebsocketPerm - fn anonymous anonymousRole anonymousGroups `shouldBe` NoWebsocketPerm - it "VisibleViewQuestionnaire RestrictedQuestionnaire" $ do - let fn = getPermission VisibleViewQuestionnaire RestrictedQuestionnaire permissions - fn admin adminRole adminGroups `shouldBe` EditorWebsocketPerm - fn owner ownerRole ownerGroups `shouldBe` EditorWebsocketPerm - fn editor editorRole editorGroups `shouldBe` EditorWebsocketPerm - fn viewer viewerRole viewerGroups `shouldBe` ViewerWebsocketPerm - fn userInOwnerGroup userInOwnerGroupRole userInOwnerGroupGroups `shouldBe` EditorWebsocketPerm - fn userInEditorGroup userInEditorGroupRole userInEditorGroupGroups `shouldBe` EditorWebsocketPerm - fn userInViewerGroup userInViewerGroupRole userInViewerGroupGroups `shouldBe` ViewerWebsocketPerm - fn userWithoutPerm userWithoutPermRole userWithoutPermGroups `shouldBe` ViewerWebsocketPerm - fn anonymous anonymousRole anonymousGroups `shouldBe` NoWebsocketPerm - it "VisibleEditQuestionnaire AnyoneWithLinkViewQuestionnaire" $ do - let fn = getPermission VisibleEditQuestionnaire AnyoneWithLinkViewQuestionnaire permissions - fn admin adminRole adminGroups `shouldBe` EditorWebsocketPerm - fn owner ownerRole ownerGroups `shouldBe` EditorWebsocketPerm - fn editor editorRole editorGroups `shouldBe` EditorWebsocketPerm - fn viewer viewerRole viewerGroups `shouldBe` EditorWebsocketPerm - fn userWithoutPerm userWithoutPermRole userWithoutPermGroups `shouldBe` EditorWebsocketPerm - fn anonymous anonymousRole anonymousGroups `shouldBe` ViewerWebsocketPerm - -- -------------------- - it "PrivateQuestionnaire AnyoneWithLinkViewQuestionnaire" $ do - let fn = getPermission PrivateQuestionnaire AnyoneWithLinkViewQuestionnaire permissions - fn admin adminRole adminGroups `shouldBe` EditorWebsocketPerm - fn owner ownerRole ownerGroups `shouldBe` EditorWebsocketPerm - fn editor editorRole editorGroups `shouldBe` EditorWebsocketPerm - fn viewer viewerRole viewerGroups `shouldBe` ViewerWebsocketPerm - fn userInOwnerGroup userInOwnerGroupRole userInOwnerGroupGroups `shouldBe` EditorWebsocketPerm - fn userInEditorGroup userInEditorGroupRole userInEditorGroupGroups `shouldBe` EditorWebsocketPerm - fn userInViewerGroup userInViewerGroupRole userInViewerGroupGroups `shouldBe` ViewerWebsocketPerm - fn userWithoutPerm userWithoutPermRole userWithoutPermGroups `shouldBe` ViewerWebsocketPerm - fn anonymous anonymousRole anonymousGroups `shouldBe` ViewerWebsocketPerm - it "VisibleViewQuestionnaire AnyoneWithLinkViewQuestionnaire" $ do - let fn = getPermission VisibleViewQuestionnaire AnyoneWithLinkViewQuestionnaire permissions - fn admin adminRole adminGroups `shouldBe` EditorWebsocketPerm - fn owner ownerRole ownerGroups `shouldBe` EditorWebsocketPerm - fn editor editorRole editorGroups `shouldBe` EditorWebsocketPerm - fn viewer viewerRole viewerGroups `shouldBe` ViewerWebsocketPerm - fn userInOwnerGroup userInOwnerGroupRole userInOwnerGroupGroups `shouldBe` EditorWebsocketPerm - fn userInEditorGroup userInEditorGroupRole userInEditorGroupGroups `shouldBe` EditorWebsocketPerm - fn userInViewerGroup userInViewerGroupRole userInViewerGroupGroups `shouldBe` ViewerWebsocketPerm - fn userWithoutPerm userWithoutPermRole userWithoutPermGroups `shouldBe` ViewerWebsocketPerm - fn anonymous anonymousRole anonymousGroups `shouldBe` ViewerWebsocketPerm - it "VisibleEditQuestionnaire AnyoneWithLinkViewQuestionnaire" $ do - let fn = getPermission VisibleEditQuestionnaire AnyoneWithLinkViewQuestionnaire permissions - fn admin adminRole adminGroups `shouldBe` EditorWebsocketPerm - fn owner ownerRole ownerGroups `shouldBe` EditorWebsocketPerm - fn editor editorRole editorGroups `shouldBe` EditorWebsocketPerm - fn viewer viewerRole viewerGroups `shouldBe` EditorWebsocketPerm - fn userInOwnerGroup userInOwnerGroupRole userInOwnerGroupGroups `shouldBe` EditorWebsocketPerm - fn userInEditorGroup userInEditorGroupRole userInEditorGroupGroups `shouldBe` EditorWebsocketPerm - fn userInViewerGroup userInViewerGroupRole userInViewerGroupGroups `shouldBe` EditorWebsocketPerm - fn userWithoutPerm userWithoutPermRole userWithoutPermGroups `shouldBe` EditorWebsocketPerm - fn anonymous anonymousRole anonymousGroups `shouldBe` ViewerWebsocketPerm - -- -------------------- - it "PrivateQuestionnaire AnyoneWithLinkEditQuestionnaire" $ do - let fn = getPermission PrivateQuestionnaire AnyoneWithLinkEditQuestionnaire permissions - fn admin adminRole adminGroups `shouldBe` EditorWebsocketPerm - fn owner ownerRole ownerGroups `shouldBe` EditorWebsocketPerm - fn editor editorRole editorGroups `shouldBe` EditorWebsocketPerm - fn viewer viewerRole viewerGroups `shouldBe` EditorWebsocketPerm - fn userInOwnerGroup userInOwnerGroupRole userInOwnerGroupGroups `shouldBe` EditorWebsocketPerm - fn userInEditorGroup userInEditorGroupRole userInEditorGroupGroups `shouldBe` EditorWebsocketPerm - fn userInViewerGroup userInViewerGroupRole userInViewerGroupGroups `shouldBe` EditorWebsocketPerm - fn userWithoutPerm userWithoutPermRole userWithoutPermGroups `shouldBe` EditorWebsocketPerm - fn anonymous anonymousRole anonymousGroups `shouldBe` EditorWebsocketPerm - it "VisibleViewQuestionnaire AnyoneWithLinkEditQuestionnaire" $ do - let fn = getPermission VisibleViewQuestionnaire AnyoneWithLinkEditQuestionnaire permissions - fn admin adminRole adminGroups `shouldBe` EditorWebsocketPerm - fn owner ownerRole ownerGroups `shouldBe` EditorWebsocketPerm - fn editor editorRole editorGroups `shouldBe` EditorWebsocketPerm - fn viewer viewerRole viewerGroups `shouldBe` EditorWebsocketPerm - fn userInOwnerGroup userInOwnerGroupRole userInOwnerGroupGroups `shouldBe` EditorWebsocketPerm - fn userInEditorGroup userInEditorGroupRole userInEditorGroupGroups `shouldBe` EditorWebsocketPerm - fn userInViewerGroup userInViewerGroupRole userInViewerGroupGroups `shouldBe` EditorWebsocketPerm - fn userWithoutPerm userWithoutPermRole userWithoutPermGroups `shouldBe` EditorWebsocketPerm - fn anonymous anonymousRole anonymousGroups `shouldBe` EditorWebsocketPerm - it "VisibleEditQuestionnaire AnyoneWithLinkEditQuestionnaire" $ do - let fn = getPermission VisibleEditQuestionnaire AnyoneWithLinkEditQuestionnaire permissions - fn admin adminRole adminGroups `shouldBe` EditorWebsocketPerm - fn owner ownerRole ownerGroups `shouldBe` EditorWebsocketPerm - fn editor editorRole editorGroups `shouldBe` EditorWebsocketPerm - fn viewer viewerRole viewerGroups `shouldBe` EditorWebsocketPerm - fn userInOwnerGroup userInOwnerGroupRole userInOwnerGroupGroups `shouldBe` EditorWebsocketPerm - fn userInEditorGroup userInEditorGroupRole userInEditorGroupGroups `shouldBe` EditorWebsocketPerm - fn userInViewerGroup userInViewerGroupRole userInViewerGroupGroups `shouldBe` EditorWebsocketPerm - fn userWithoutPerm userWithoutPermRole userWithoutPermGroups `shouldBe` EditorWebsocketPerm - fn anonymous anonymousRole anonymousGroups `shouldBe` EditorWebsocketPerm - describe "check permissions" $ do - let record perm = - WebsocketRecord - { connectionUuid = undefined - , connection = undefined - , entityId = undefined - , entityPerm = perm - , user = undefined - } - it "checkViewPermission" $ do - shouldSucceed appContext (checkViewPermission (record EditorWebsocketPerm)) - shouldSucceed appContext (checkViewPermission (record ViewerWebsocketPerm)) - shouldFailed appContext (checkViewPermission (record NoWebsocketPerm)) - it "checkEditPermission" $ do - shouldSucceed appContext (checkEditPermission (record EditorWebsocketPerm)) - shouldFailed appContext (checkEditPermission (record ViewerWebsocketPerm)) - shouldFailed appContext (checkEditPermission (record NoWebsocketPerm)) diff --git a/wizard-server/test/Wizard/Specs/Service/Questionnaire/Compiler/CompilerServiceSpec.hs b/wizard-server/test/Wizard/Specs/Service/Questionnaire/Compiler/CompilerServiceSpec.hs deleted file mode 100644 index b896ec5d8..000000000 --- a/wizard-server/test/Wizard/Specs/Service/Questionnaire/Compiler/CompilerServiceSpec.hs +++ /dev/null @@ -1,49 +0,0 @@ -module Wizard.Specs.Service.Questionnaire.Compiler.CompilerServiceSpec where - -import Test.Hspec - -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireLabels -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireReplies -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Database.Migration.Development.User.Data.Users -import Wizard.Model.Questionnaire.QuestionnaireContent -import Wizard.Model.Questionnaire.QuestionnaireEvent -import Wizard.Service.Questionnaire.Compiler.CompilerService -import Wizard.Service.Questionnaire.Event.QuestionnaireEventMapper - -questionnaireCompilerServiceSpec = - describe "Questionnaire Compiler Service" $ - describe "applyEvent" $ do - it "SetReplyEvent" $ - -- GIVEN: - do - let event = toEventList (sre_rQ1Updated' questionnaire1Uuid) (Just userAlbert) - -- WHEN: - let updatedQtnCtn = applyEvent questionnaire1Ctn event - -- THEN: - updatedQtnCtn.replies `shouldBe` fRepliesWithUpdated - it "ClearReplyEvent" $ - -- GIVEN: - do - let event = toEventList (cre_rQ1' questionnaire1Uuid) (Just userAlbert) - -- WHEN: - let updatedQtnCtn = applyEvent questionnaire1Ctn event - -- THEN: - updatedQtnCtn.replies `shouldBe` fRepliesWithDeleted - it "SetPhaseEvent" $ - -- GIVEN: - do - let event = toEventList (sphse_2' questionnaire1Uuid) (Just userAlbert) - -- WHEN: - let updatedQtnCtn = applyEvent questionnaire1Ctn event - -- THEN: - updatedQtnCtn.phaseUuid `shouldBe` (sphse_2 questionnaire1Uuid).phaseUuid - it "SetLabelsEvent" $ - -- GIVEN: - do - let event = toEventList (slble_rQ2' questionnaire1Uuid) (Just userAlbert) - -- WHEN: - let updatedQtnCtn = applyEvent questionnaire1Ctn event - -- THEN: - updatedQtnCtn.labels `shouldBe` fLabelsEdited diff --git a/wizard-server/test/Wizard/Specs/Service/Questionnaire/Event/QuestionnaireEventServiceSpec.hs b/wizard-server/test/Wizard/Specs/Service/Questionnaire/Event/QuestionnaireEventServiceSpec.hs deleted file mode 100644 index 5f70a8ad8..000000000 --- a/wizard-server/test/Wizard/Specs/Service/Questionnaire/Event/QuestionnaireEventServiceSpec.hs +++ /dev/null @@ -1,208 +0,0 @@ -module Wizard.Specs.Service.Questionnaire.Event.QuestionnaireEventServiceSpec where - -import Data.Maybe (fromJust) -import Data.Time -import qualified Data.UUID as U -import Test.Hspec - -import Shared.Common.Constant.Tenant -import Shared.Common.Model.Common.Lens -import Shared.Common.Util.Date -import Shared.Common.Util.Uuid -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireVersions -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Model.Questionnaire.QuestionnaireEvent -import Wizard.Model.Questionnaire.QuestionnaireEventLenses () -import Wizard.Model.Questionnaire.QuestionnaireReply -import Wizard.Model.Questionnaire.QuestionnaireVersion -import Wizard.Service.Questionnaire.Event.QuestionnaireEventService - --- --------------------------- --- TESTS --- --------------------------- -questionnaireEventServiceSpec = - describe "QuestionnaireEventService" $ - it "squash" $ - -- GIVEN: prepare data - do - let versions = [version1] - let events = - [ setCreatedAt q1_event1 (dt'' 2018 1 21 1) - , setCreatedAt (cre_rQ1' questionnaire1Uuid) (dt'' 2018 1 21 2) - , setCreatedAt q1_event2 (dt'' 2018 1 21 3) - , setCreatedAt (sphse_1' questionnaire1Uuid) (dt'' 2018 1 21 4) - , setCreatedAt q1_event3 (dt'' 2018 1 21 5) - , setCreatedAt (slble_rQ1' questionnaire1Uuid) (dt'' 2018 1 21 6) - , setCreatedAt q2_event1 (dt'' 2018 1 21 7) - , setCreatedAt q1_event4 (dt'' 2018 1 21 8) - , setCreatedAt q1_event5_nikola (dt'' 2018 1 21 9) - , setCreatedAt q1_event6_anonymous1 (dt'' 2018 1 21 10) - , setCreatedAt q1_event7_nikola (dt'' 2018 1 21 11) - , setCreatedAt q1_event8_nikola (dt'' 2018 1 21 12) - , setCreatedAt q2_event2 (dt'' 2018 1 22 0) - ] - -- AND: prepare expectation - let expEvents = - [ setCreatedAt (cre_rQ1' questionnaire1Uuid) (dt'' 2018 1 21 2) - , setCreatedAt (sphse_1' questionnaire1Uuid) (dt'' 2018 1 21 4) - , setCreatedAt (slble_rQ1' questionnaire1Uuid) (dt'' 2018 1 21 6) - , setCreatedAt q2_event1 (dt'' 2018 1 21 7) - , setCreatedAt q1_event4 (dt'' 2018 1 21 8) - , setCreatedAt q1_event5_nikola (dt'' 2018 1 21 9) - , setCreatedAt q1_event6_anonymous1 (dt'' 2018 1 21 10) - , setCreatedAt q1_event7_nikola (dt'' 2018 1 21 11) - , setCreatedAt q1_event8_nikola (dt'' 2018 1 21 12) - , setCreatedAt q2_event2 (dt'' 2018 1 22 0) - ] - -- WHEN: - let resultEvents = squash versions events - -- THEN: - resultEvents `shouldBe` expEvents - --- --------------------------- --- EVENTS --- --------------------------- -q1_event1 :: QuestionnaireEvent -q1_event1 = - SetReplyEvent' $ - SetReplyEvent - { uuid = createEventUuid questionnaire1Uuid "4b2a1d62f725" - , path = "question1" - , value = StringReply "question1_value_1" - , questionnaireUuid = questionnaire1Uuid - , tenantUuid = defaultTenantUuid - , createdBy = albert - , createdAt = dt'' 2018 1 21 0 - } - -q1_event2 :: QuestionnaireEvent -q1_event2 = - SetReplyEvent' $ - SetReplyEvent - { uuid = createEventUuid questionnaire1Uuid "0d2b486b3231" - , path = "question1" - , value = StringReply "question1_value_2" - , questionnaireUuid = questionnaire1Uuid - , tenantUuid = defaultTenantUuid - , createdBy = albert - , createdAt = dt'' 2018 1 21 1 - } - -q1_event3 :: QuestionnaireEvent -q1_event3 = - SetReplyEvent' $ - SetReplyEvent - { uuid = createEventUuid questionnaire1Uuid "04702766ab48" - , path = "question1" - , value = StringReply "question1_value_3" - , questionnaireUuid = questionnaire1Uuid - , tenantUuid = defaultTenantUuid - , createdBy = albert - , createdAt = dt'' 2018 1 21 2 - } - -q2_event1 :: QuestionnaireEvent -q2_event1 = - SetReplyEvent' $ - SetReplyEvent - { uuid = createEventUuid questionnaire1Uuid "b2eb9e2aacc7" - , path = "question2" - , value = StringReply "question2_value_1" - , questionnaireUuid = questionnaire1Uuid - , tenantUuid = defaultTenantUuid - , createdBy = albert - , createdAt = dt'' 2018 1 21 3 - } - -q1_event4 :: QuestionnaireEvent -q1_event4 = - SetReplyEvent' $ - SetReplyEvent - { uuid = createEventUuid questionnaire1Uuid "4db8b2bd8345" - , path = "question1" - , value = StringReply "question1_value_4" - , questionnaireUuid = questionnaire1Uuid - , tenantUuid = defaultTenantUuid - , createdBy = albert - , createdAt = dt'' 2018 1 21 4 - } - -q1_event5_nikola :: QuestionnaireEvent -q1_event5_nikola = - SetReplyEvent' $ - SetReplyEvent - { uuid = createEventUuid questionnaire1Uuid "3fa10bf8bc47" - , path = "question1" - , value = StringReply "question1_value_5" - , questionnaireUuid = questionnaire1Uuid - , tenantUuid = defaultTenantUuid - , createdBy = nikola - , createdAt = dt'' 2018 1 21 5 - } - -q1_event6_anonymous1 :: QuestionnaireEvent -q1_event6_anonymous1 = - SetReplyEvent' $ - SetReplyEvent - { uuid = createEventUuid questionnaire1Uuid "fbbb6cc6d91c" - , path = "question1" - , value = StringReply "question1_value_6" - , questionnaireUuid = questionnaire1Uuid - , tenantUuid = defaultTenantUuid - , createdBy = Nothing - , createdAt = dt'' 2018 1 21 6 - } - -q1_event7_nikola :: QuestionnaireEvent -q1_event7_nikola = - SetReplyEvent' $ - SetReplyEvent - { uuid = createEventUuid questionnaire1Uuid "fe7cfccc9c50" - , path = "question1" - , value = StringReply "question1_value_7" - , questionnaireUuid = questionnaire1Uuid - , tenantUuid = defaultTenantUuid - , createdBy = nikola - , createdAt = dt'' 2018 1 21 7 - } - -q1_event8_nikola :: QuestionnaireEvent -q1_event8_nikola = - SetReplyEvent' $ - SetReplyEvent - { uuid = createEventUuid questionnaire1Uuid "b9c6b1dd31f8" - , path = "question1" - , value = StringReply "question1_value_8" - , questionnaireUuid = questionnaire1Uuid - , tenantUuid = defaultTenantUuid - , createdBy = nikola - , createdAt = dt'' 2018 1 21 8 - } - -q2_event2 :: QuestionnaireEvent -q2_event2 = - SetReplyEvent' $ - SetReplyEvent - { uuid = createEventUuid questionnaire1Uuid "a023f5ef76f7" - , path = "question2" - , value = StringReply "question2_value_2" - , questionnaireUuid = questionnaire1Uuid - , tenantUuid = defaultTenantUuid - , createdBy = albert - , createdAt = UTCTime (fromJust $ fromGregorianValid 2018 1 22) 0 - } - --- --------------------------- --- VERSIONS --- --------------------------- -version1 = (questionnaireVersion1 questionnaire1Uuid) {eventUuid = getUuid q1_event7_nikola} - --- --------------------------- --- USERS --- --------------------------- -albert :: Maybe U.UUID -albert = Just $ u' "3e9da440-0a4f-43dc-86b0-0fe9009ae6f3" - -nikola :: Maybe U.UUID -nikola = Just $ u' "dbcc9ac4-7e63-4d12-9a14-f2f918fd0a78" diff --git a/wizard-server/test/Wizard/Specs/Service/Questionnaire/Migration/Migrator/SanitizerSpec.hs b/wizard-server/test/Wizard/Specs/Service/Questionnaire/Migration/Migrator/SanitizerSpec.hs deleted file mode 100644 index 648491178..000000000 --- a/wizard-server/test/Wizard/Specs/Service/Questionnaire/Migration/Migrator/SanitizerSpec.hs +++ /dev/null @@ -1,45 +0,0 @@ -module Wizard.Specs.Service.Questionnaire.Migration.Migrator.SanitizerSpec where - -import Test.Hspec hiding (shouldBe, shouldNotBe) -import Test.Hspec.Expectations.Pretty - -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.KnowledgeModels -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Questions -import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel -import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModelLenses -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireReplies -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Model.Questionnaire.QuestionnaireEventList -import Wizard.Model.Questionnaire.QuestionnaireReply -import Wizard.Service.Questionnaire.Migration.Migrator.Sanitizer - -import Wizard.Specs.Common - -sanitizerIntegrationSpec appContext = - describe "Sanitizer" $ - describe "sanitizeQuestionnaireEvents" $ - it "Succeed" $ - -- GIVEN: - do - let oldKm = km1WithQ4 - let newKm = - putInQuestionsM question1.uuid question1WithNewType' - . putInQuestionsM question9.uuid question9WithNewType' - $ km1WithQ4 - let qtnEvents = fEventsList questionnaire1Uuid - -- WHEN: - (Right result) <- runInContext (sanitizeQuestionnaireEvents questionnaire1Uuid oldKm newKm qtnEvents) appContext - -- THEN: - extractEventPath (result !! 16) `shouldBe` fst rQ1 - extractEventPath (result !! 17) `shouldBe` fst rQ9 - extractSetEventValue (result !! 17) `shouldBe` (snd rQ9WithNewType).value - -extractEventPath :: QuestionnaireEventList -> String -extractEventPath (ClearReplyEventList' event) = event.path -extractEventPath (SetReplyEventList' event) = event.path -extractEventPath _ = error "Expected ClearReplyEventList' or SetReplyEventList'" - -extractSetEventValue :: QuestionnaireEventList -> ReplyValue -extractSetEventValue (SetReplyEventList' event) = event.value -extractSetEventValue _ = error "Expected SetReplyEventList'" diff --git a/wizard-server/test/Wizard/Specs/Service/Questionnaire/QuestionnaireAclSpec.hs b/wizard-server/test/Wizard/Specs/Service/Questionnaire/QuestionnaireAclSpec.hs deleted file mode 100644 index dad3c89b8..000000000 --- a/wizard-server/test/Wizard/Specs/Service/Questionnaire/QuestionnaireAclSpec.hs +++ /dev/null @@ -1,408 +0,0 @@ -module Wizard.Specs.Service.Questionnaire.QuestionnaireAclSpec where - -import Data.Foldable (traverse_) -import Test.Hspec - -import Shared.Common.Util.Uuid -import Shared.DocumentTemplate.Database.DAO.DocumentTemplate.DocumentTemplateDAO -import Shared.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplates -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnairePermDAO -import Wizard.Database.DAO.User.UserDAO -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Database.Migration.Development.User.Data.Users -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnairePerm -import Wizard.Model.User.User -import Wizard.Service.Questionnaire.QuestionnaireAcl -import Wizard.Service.Questionnaire.QuestionnaireMapper -import qualified Wizard.Service.User.UserMapper as U_Mapper -import WizardLib.Public.Database.DAO.User.UserGroupDAO -import WizardLib.Public.Database.DAO.User.UserGroupMembershipDAO -import WizardLib.Public.Database.Migration.Development.User.Data.UserGroups -import WizardLib.Public.Model.User.UserGroup - -import Wizard.Specs.Common - -questionnaireAclSpec appContext = - describe "Questionnaire ACL" $ do - let permissions = - [ toUserQuestionnairePerm - (u' "808d4770-0d38-45b0-a028-0a3ffaafc617") - userNikola.uuid - ownerPermissions - userNikola.tenantUuid - , toUserQuestionnairePerm - (u' "52e74b8b-ca73-4d6a-a7e1-5c0f34a1819a") - userNicolaus.uuid - editorPermissions - userNicolaus.tenantUuid - , toUserQuestionnairePerm - (u' "3d60a813-5e54-4fd2-8fe8-5cf3c076bd50") - userGalileo.uuid - viewerPermissions - userGalileo.tenantUuid - , toUserGroupQuestionnairePerm - (u' "b90b17f4-06a2-40dc-b364-88d8f195c8a0") - bioGroup.uuid - ownerPermissions - bioGroup.tenantUuid - , toUserGroupQuestionnairePerm - (u' "fcead22d-e453-47a3-84bc-5c29698ab990") - plantGroup.uuid - editorPermissions - plantGroup.tenantUuid - , toUserGroupQuestionnairePerm - (u' "4e0765e8-f25c-4091-8531-aed2eef161f6") - animalGroup.uuid - viewerPermissions - animalGroup.tenantUuid - ] - let makeContext user = appContext {currentUser = Just . U_Mapper.toDTO $ user} - let adminCtx = makeContext userAlbert - let ownerCtx = makeContext userNikola - let editorCtx = makeContext userNicolaus - let viewerCtx = makeContext userGalileo - let userInOwnerGroupCtx = makeContext userIsaac - let userInEditorGroupCtx = makeContext userIsaac - let userInViewerGroupCtx = makeContext userIsaac - let userWithoutPermCtx = makeContext userIsaac - let anonymousCtx = appContext {currentUser = Nothing} - it "checkViewPermissionToQtn" $ do - runLocalTestMigration appContext - let fn1 memberships = do - deleteUserGroupMemberships - traverse_ insertUserGroupMembership memberships - checkViewPermissionToQtn PrivateQuestionnaire RestrictedQuestionnaire permissions - shouldSucceed adminCtx (fn1 []) - shouldSucceed ownerCtx (fn1 []) - shouldSucceed editorCtx (fn1 []) - shouldSucceed viewerCtx (fn1 []) - shouldSucceed userInOwnerGroupCtx (fn1 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInEditorGroupCtx (fn1 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInViewerGroupCtx (fn1 [userIsaacAnimalGroupMembership]) - shouldFailed userWithoutPermCtx (fn1 []) - shouldFailed anonymousCtx (fn1 []) - let fn2 memberships = do - deleteUserGroupMemberships - traverse_ insertUserGroupMembership memberships - checkViewPermissionToQtn VisibleViewQuestionnaire RestrictedQuestionnaire permissions - shouldSucceed adminCtx (fn2 []) - shouldSucceed ownerCtx (fn2 []) - shouldSucceed editorCtx (fn2 []) - shouldSucceed viewerCtx (fn2 []) - shouldSucceed userInOwnerGroupCtx (fn2 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInEditorGroupCtx (fn2 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInViewerGroupCtx (fn2 [userIsaacAnimalGroupMembership]) - shouldSucceed userWithoutPermCtx (fn2 []) - shouldFailed anonymousCtx (fn2 []) - let fn3 memberships = do - deleteUserGroupMemberships - traverse_ insertUserGroupMembership memberships - checkViewPermissionToQtn VisibleEditQuestionnaire RestrictedQuestionnaire permissions - shouldSucceed adminCtx (fn3 []) - shouldSucceed ownerCtx (fn3 []) - shouldSucceed editorCtx (fn3 []) - shouldSucceed viewerCtx (fn3 []) - shouldSucceed userInOwnerGroupCtx (fn3 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInEditorGroupCtx (fn3 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInViewerGroupCtx (fn3 [userIsaacAnimalGroupMembership]) - shouldSucceed userWithoutPermCtx (fn3 []) - shouldFailed anonymousCtx (fn3 []) - -- -------------------- - let fn4 memberships = do - deleteUserGroupMemberships - traverse_ insertUserGroupMembership memberships - checkViewPermissionToQtn PrivateQuestionnaire AnyoneWithLinkViewQuestionnaire permissions - shouldSucceed adminCtx (fn4 []) - shouldSucceed ownerCtx (fn4 []) - shouldSucceed editorCtx (fn4 []) - shouldSucceed viewerCtx (fn4 []) - shouldSucceed userInOwnerGroupCtx (fn4 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInEditorGroupCtx (fn4 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInViewerGroupCtx (fn4 [userIsaacAnimalGroupMembership]) - shouldSucceed userWithoutPermCtx (fn4 []) - shouldSucceed anonymousCtx (fn4 []) - let fn5 memberships = do - deleteUserGroupMemberships - traverse_ insertUserGroupMembership memberships - checkViewPermissionToQtn VisibleViewQuestionnaire AnyoneWithLinkViewQuestionnaire permissions - shouldSucceed adminCtx (fn5 []) - shouldSucceed ownerCtx (fn5 []) - shouldSucceed editorCtx (fn5 []) - shouldSucceed viewerCtx (fn5 []) - shouldSucceed userInOwnerGroupCtx (fn5 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInEditorGroupCtx (fn5 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInViewerGroupCtx (fn5 [userIsaacAnimalGroupMembership]) - shouldSucceed userWithoutPermCtx (fn5 []) - shouldSucceed anonymousCtx (fn5 []) - let fn6 memberships = do - deleteUserGroupMemberships - traverse_ insertUserGroupMembership memberships - checkViewPermissionToQtn VisibleEditQuestionnaire AnyoneWithLinkViewQuestionnaire permissions - shouldSucceed adminCtx (fn6 []) - shouldSucceed ownerCtx (fn6 []) - shouldSucceed editorCtx (fn6 []) - shouldSucceed viewerCtx (fn6 []) - shouldSucceed userInOwnerGroupCtx (fn6 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInEditorGroupCtx (fn6 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInViewerGroupCtx (fn6 [userIsaacAnimalGroupMembership]) - shouldSucceed userWithoutPermCtx (fn6 []) - shouldSucceed anonymousCtx (fn6 []) - -- -------------------- - let fn7 memberships = do - deleteUserGroupMemberships - traverse_ insertUserGroupMembership memberships - checkViewPermissionToQtn PrivateQuestionnaire AnyoneWithLinkEditQuestionnaire permissions - shouldSucceed adminCtx (fn7 []) - shouldSucceed ownerCtx (fn7 []) - shouldSucceed editorCtx (fn7 []) - shouldSucceed viewerCtx (fn7 []) - shouldSucceed userInOwnerGroupCtx (fn7 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInEditorGroupCtx (fn7 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInViewerGroupCtx (fn7 [userIsaacAnimalGroupMembership]) - shouldSucceed userWithoutPermCtx (fn7 []) - shouldSucceed anonymousCtx (fn7 []) - let fn8 memberships = do - deleteUserGroupMemberships - traverse_ insertUserGroupMembership memberships - checkViewPermissionToQtn VisibleViewQuestionnaire AnyoneWithLinkEditQuestionnaire permissions - shouldSucceed adminCtx (fn8 []) - shouldSucceed ownerCtx (fn8 []) - shouldSucceed editorCtx (fn8 []) - shouldSucceed viewerCtx (fn8 []) - shouldSucceed userInOwnerGroupCtx (fn8 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInEditorGroupCtx (fn8 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInViewerGroupCtx (fn8 [userIsaacAnimalGroupMembership]) - shouldSucceed userWithoutPermCtx (fn8 []) - shouldSucceed anonymousCtx (fn8 []) - let fn9 memberships = do - deleteUserGroupMemberships - traverse_ insertUserGroupMembership memberships - checkViewPermissionToQtn VisibleEditQuestionnaire AnyoneWithLinkEditQuestionnaire permissions - shouldSucceed adminCtx (fn9 []) - shouldSucceed ownerCtx (fn9 []) - shouldSucceed editorCtx (fn9 []) - shouldSucceed viewerCtx (fn9 []) - shouldSucceed userInOwnerGroupCtx (fn9 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInEditorGroupCtx (fn9 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInViewerGroupCtx (fn9 [userIsaacAnimalGroupMembership]) - shouldSucceed userWithoutPermCtx (fn9 []) - shouldSucceed anonymousCtx (fn9 []) - it "checkOwnerPermissionToQtn" $ do - runLocalTestMigration appContext - let fn1 memberships = do - deleteUserGroupMemberships - traverse_ insertUserGroupMembership memberships - checkOwnerPermissionToQtn PrivateQuestionnaire permissions - shouldSucceed adminCtx (fn1 []) - shouldSucceed ownerCtx (fn1 []) - shouldFailed editorCtx (fn1 []) - shouldFailed viewerCtx (fn1 []) - shouldSucceed userInOwnerGroupCtx (fn1 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldFailed userInEditorGroupCtx (fn1 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldFailed userInViewerGroupCtx (fn1 [userIsaacAnimalGroupMembership]) - shouldFailed userWithoutPermCtx (fn1 []) - shouldFailed anonymousCtx (fn1 []) - let fn2 memberships = do - deleteUserGroupMemberships - traverse_ insertUserGroupMembership memberships - checkOwnerPermissionToQtn VisibleViewQuestionnaire permissions - shouldSucceed adminCtx (fn2 []) - shouldSucceed ownerCtx (fn2 []) - shouldFailed editorCtx (fn2 []) - shouldFailed viewerCtx (fn2 []) - shouldSucceed userInOwnerGroupCtx (fn2 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldFailed userInEditorGroupCtx (fn2 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldFailed userInViewerGroupCtx (fn2 [userIsaacAnimalGroupMembership]) - shouldFailed userWithoutPermCtx (fn2 []) - shouldFailed anonymousCtx (fn2 []) - let fn3 memberships = do - deleteUserGroupMemberships - traverse_ insertUserGroupMembership memberships - checkOwnerPermissionToQtn VisibleEditQuestionnaire permissions - shouldSucceed adminCtx (fn3 []) - shouldSucceed ownerCtx (fn3 []) - shouldFailed editorCtx (fn3 []) - shouldFailed viewerCtx (fn3 []) - shouldSucceed userInOwnerGroupCtx (fn3 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldFailed userInEditorGroupCtx (fn3 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldFailed userInViewerGroupCtx (fn3 [userIsaacAnimalGroupMembership]) - shouldFailed userWithoutPermCtx (fn3 []) - shouldFailed anonymousCtx (fn3 []) - it "checkEditPermissionToQtn" $ do - runLocalTestMigration appContext - let fn1 memberships = do - deleteUserGroupMemberships - traverse_ insertUserGroupMembership memberships - checkEditPermissionToQtn PrivateQuestionnaire RestrictedQuestionnaire permissions - shouldSucceed adminCtx (fn1 []) - shouldSucceed ownerCtx (fn1 []) - shouldSucceed editorCtx (fn1 []) - shouldFailed viewerCtx (fn1 []) - shouldSucceed userInOwnerGroupCtx (fn1 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInEditorGroupCtx (fn1 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldFailed userInViewerGroupCtx (fn1 [userIsaacAnimalGroupMembership]) - shouldFailed userWithoutPermCtx (fn1 []) - shouldFailed anonymousCtx (fn1 []) - let fn2 memberships = do - deleteUserGroupMemberships - traverse_ insertUserGroupMembership memberships - checkEditPermissionToQtn VisibleViewQuestionnaire RestrictedQuestionnaire permissions - shouldSucceed adminCtx (fn2 []) - shouldSucceed ownerCtx (fn2 []) - shouldSucceed editorCtx (fn2 []) - shouldFailed viewerCtx (fn2 []) - shouldSucceed userInOwnerGroupCtx (fn2 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInEditorGroupCtx (fn2 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldFailed userInViewerGroupCtx (fn2 [userIsaacAnimalGroupMembership]) - shouldFailed userWithoutPermCtx (fn2 []) - shouldFailed anonymousCtx (fn2 []) - let fn3 memberships = do - deleteUserGroupMemberships - traverse_ insertUserGroupMembership memberships - checkEditPermissionToQtn VisibleEditQuestionnaire RestrictedQuestionnaire permissions - shouldSucceed adminCtx (fn3 []) - shouldSucceed ownerCtx (fn3 []) - shouldSucceed editorCtx (fn3 []) - shouldSucceed viewerCtx (fn3 []) - shouldSucceed userInOwnerGroupCtx (fn3 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInEditorGroupCtx (fn3 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInViewerGroupCtx (fn3 [userIsaacAnimalGroupMembership]) - shouldSucceed userWithoutPermCtx (fn3 []) - shouldFailed anonymousCtx (fn3 []) - -- -------------------- - let fn4 memberships = do - deleteUserGroupMemberships - traverse_ insertUserGroupMembership memberships - checkEditPermissionToQtn PrivateQuestionnaire AnyoneWithLinkViewQuestionnaire permissions - shouldSucceed adminCtx (fn4 []) - shouldSucceed ownerCtx (fn4 []) - shouldSucceed editorCtx (fn4 []) - shouldFailed viewerCtx (fn4 []) - shouldSucceed userInOwnerGroupCtx (fn4 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInEditorGroupCtx (fn4 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldFailed userInViewerGroupCtx (fn4 [userIsaacAnimalGroupMembership]) - shouldFailed userWithoutPermCtx (fn4 []) - shouldFailed anonymousCtx (fn4 []) - let fn5 memberships = do - deleteUserGroupMemberships - traverse_ insertUserGroupMembership memberships - checkEditPermissionToQtn VisibleViewQuestionnaire AnyoneWithLinkViewQuestionnaire permissions - shouldSucceed adminCtx (fn5 []) - shouldSucceed ownerCtx (fn5 []) - shouldSucceed editorCtx (fn5 []) - shouldFailed viewerCtx (fn5 []) - shouldSucceed userInOwnerGroupCtx (fn5 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInEditorGroupCtx (fn5 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldFailed userInViewerGroupCtx (fn5 [userIsaacAnimalGroupMembership]) - shouldFailed userWithoutPermCtx (fn5 []) - shouldFailed anonymousCtx (fn5 []) - let fn6 memberships = do - deleteUserGroupMemberships - traverse_ insertUserGroupMembership memberships - checkEditPermissionToQtn VisibleEditQuestionnaire AnyoneWithLinkViewQuestionnaire permissions - shouldSucceed adminCtx (fn6 []) - shouldSucceed ownerCtx (fn6 []) - shouldSucceed editorCtx (fn6 []) - shouldSucceed viewerCtx (fn6 []) - shouldSucceed userInOwnerGroupCtx (fn6 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInEditorGroupCtx (fn6 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInViewerGroupCtx (fn6 [userIsaacAnimalGroupMembership]) - shouldSucceed userWithoutPermCtx (fn6 []) - shouldFailed anonymousCtx (fn6 []) - -- -------------------- - let fn7 memberships = do - deleteUserGroupMemberships - traverse_ insertUserGroupMembership memberships - checkEditPermissionToQtn PrivateQuestionnaire AnyoneWithLinkEditQuestionnaire permissions - shouldSucceed adminCtx (fn7 []) - shouldSucceed ownerCtx (fn7 []) - shouldSucceed editorCtx (fn7 []) - shouldSucceed viewerCtx (fn7 []) - shouldSucceed userInOwnerGroupCtx (fn7 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInEditorGroupCtx (fn7 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInViewerGroupCtx (fn7 [userIsaacAnimalGroupMembership]) - shouldSucceed userWithoutPermCtx (fn7 []) - shouldSucceed anonymousCtx (fn7 []) - let fn8 memberships = do - deleteUserGroupMemberships - traverse_ insertUserGroupMembership memberships - checkEditPermissionToQtn VisibleViewQuestionnaire AnyoneWithLinkEditQuestionnaire permissions - shouldSucceed adminCtx (fn8 []) - shouldSucceed ownerCtx (fn8 []) - shouldSucceed editorCtx (fn8 []) - shouldSucceed viewerCtx (fn8 []) - shouldSucceed userInOwnerGroupCtx (fn8 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInEditorGroupCtx (fn8 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInViewerGroupCtx (fn8 [userIsaacAnimalGroupMembership]) - shouldSucceed userWithoutPermCtx (fn8 []) - shouldSucceed anonymousCtx (fn8 []) - let fn9 memberships = do - deleteUserGroupMemberships - traverse_ insertUserGroupMembership memberships - checkEditPermissionToQtn VisibleEditQuestionnaire AnyoneWithLinkEditQuestionnaire permissions - shouldSucceed adminCtx (fn9 []) - shouldSucceed ownerCtx (fn9 []) - shouldSucceed editorCtx (fn9 []) - shouldSucceed viewerCtx (fn9 []) - shouldSucceed userInOwnerGroupCtx (fn9 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInEditorGroupCtx (fn9 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInViewerGroupCtx (fn9 [userIsaacAnimalGroupMembership]) - shouldSucceed userWithoutPermCtx (fn9 []) - shouldSucceed anonymousCtx (fn9 []) - it "checkMigrationPermissionToQtn" $ do - runLocalTestMigration appContext - let fn1 memberships = do - deleteUserGroupMemberships - traverse_ insertUserGroupMembership memberships - checkMigrationPermissionToQtn PrivateQuestionnaire permissions - shouldSucceed adminCtx (fn1 []) - shouldSucceed ownerCtx (fn1 []) - shouldSucceed editorCtx (fn1 []) - shouldSucceed userInOwnerGroupCtx (fn1 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInEditorGroupCtx (fn1 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldFailed userInViewerGroupCtx (fn1 [userIsaacAnimalGroupMembership]) - shouldFailed viewerCtx (fn1 []) - shouldFailed userWithoutPermCtx (fn1 []) - shouldFailed anonymousCtx (fn1 []) - let fn2 memberships = do - deleteUserGroupMemberships - traverse_ insertUserGroupMembership memberships - checkMigrationPermissionToQtn VisibleViewQuestionnaire permissions - shouldSucceed adminCtx (fn2 []) - shouldSucceed ownerCtx (fn2 []) - shouldSucceed editorCtx (fn2 []) - shouldFailed viewerCtx (fn2 []) - shouldSucceed userInOwnerGroupCtx (fn2 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInEditorGroupCtx (fn2 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldFailed userInViewerGroupCtx (fn2 [userIsaacAnimalGroupMembership]) - shouldFailed userWithoutPermCtx (fn2 []) - shouldFailed anonymousCtx (fn2 []) - let fn3 memberships = do - deleteUserGroupMemberships - traverse_ insertUserGroupMembership memberships - checkMigrationPermissionToQtn VisibleEditQuestionnaire permissions - shouldSucceed adminCtx (fn3 []) - shouldSucceed ownerCtx (fn3 []) - shouldSucceed editorCtx (fn3 []) - shouldSucceed viewerCtx (fn3 []) - shouldSucceed userInOwnerGroupCtx (fn3 [userIsaacBioGroupMembership, userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInEditorGroupCtx (fn3 [userIsaacPlantGroupMembership, userIsaacAnimalGroupMembership]) - shouldSucceed userInViewerGroupCtx (fn3 [userIsaacAnimalGroupMembership]) - shouldSucceed userWithoutPermCtx (fn3 []) - shouldFailed anonymousCtx (fn3 []) - -runLocalTestMigration appContext = do - runInContext deleteQuestionnairePerms appContext - runInContext deleteQuestionnaires appContext - runInContext (insertPackage germanyKmPackage) appContext - runInContext (insertDocumentTemplate wizardDocumentTemplate) appContext - runInContext (insertQuestionnaire questionnaire1) appContext - runInContext (insertUser userIsaac) appContext - runInContext (insertUserGroup bioGroup) appContext - runInContext (insertUserGroup plantGroup) appContext - runInContext (insertUserGroup animalGroup) appContext diff --git a/wizard-server/test/Wizard/Specs/Service/Questionnaire/QuestionnaireServiceSpec.hs b/wizard-server/test/Wizard/Specs/Service/Questionnaire/QuestionnaireServiceSpec.hs deleted file mode 100644 index 89c58e89a..000000000 --- a/wizard-server/test/Wizard/Specs/Service/Questionnaire/QuestionnaireServiceSpec.hs +++ /dev/null @@ -1,51 +0,0 @@ -module Wizard.Specs.Service.Questionnaire.QuestionnaireServiceSpec where - -import Control.Monad.Reader (liftIO) -import Test.Hspec - -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeModelPackageMigration as PKG_Migration -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireCommands -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireMigration as QTN_Migration -import qualified Wizard.Database.Migration.Development.User.UserMigration as U_Migration -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Service.Questionnaire.QuestionnaireService -import WizardLib.Public.Model.PersistentCommand.Questionnaire.CreateQuestionnaireCommand - -import Wizard.Specs.API.Common -import Wizard.Specs.Common - -questionnaireServiceSpec appContext = - describe "Questionnaire Service" $ do - it "createQuestionnairesFromCommands" $ - -- GIVEN: - do - runInContextIO U_Migration.runMigration appContext - runInContextIO PKG_Migration.runMigration appContext - runInContextIO TML_Migration.runMigration appContext - -- WHEN: - (Right ()) <- runInContext (createQuestionnairesFromCommands [command1, command2]) appContext - -- THEN: - (Right questionnaires) <- runInContext findQuestionnaires appContext - length questionnaires `shouldBe` 2 - compareQuestionnaire (head questionnaires) command1 - compareQuestionnaire (questionnaires !! 1) command2 - - it "cleanQuestionnaires works" $ - -- GIVEN: - do - runInContextIO TML_Migration.runMigration appContext - runInContextIO QTN_Migration.runMigration appContext - assertCountInDB findQuestionnaires appContext 3 - -- WHEN: - (Right ()) <- runInContext cleanQuestionnaires appContext - -- THEN: - assertCountInDB findQuestionnaires appContext 2 - -compareQuestionnaire :: Questionnaire -> CreateQuestionnaireCommand -> IO () -compareQuestionnaire questionnaire command = liftIO $ do - questionnaire.name `shouldBe` command.name - questionnaire.knowledgeModelPackageId `shouldBe` command.knowledgeModelPackageId - questionnaire.documentTemplateId `shouldBe` command.documentTemplateId - length questionnaire.permissions `shouldBe` length command.emails diff --git a/wizard-server/test/Wizard/Specs/Service/Questionnaire/QuestionnaireValidationSpec.hs b/wizard-server/test/Wizard/Specs/Service/Questionnaire/QuestionnaireValidationSpec.hs deleted file mode 100644 index 930880514..000000000 --- a/wizard-server/test/Wizard/Specs/Service/Questionnaire/QuestionnaireValidationSpec.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Wizard.Specs.Service.Questionnaire.QuestionnaireValidationSpec where - -import qualified Data.Map.Strict as M -import Test.Hspec - -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Wizard.Service.Questionnaire.QuestionnaireValidation - -questionnaireValidationSpec = - describe "QuestionnaireValidation" $ do - it "isValidProjectTag" $ do - let validationError word = - Just $ ValidationError [] (M.singleton "tags" [_ERROR_VALIDATION__FORBIDDEN_CHARACTERS word]) - isValidProjectTag "a" `shouldBe` Nothing - isValidProjectTag "ab" `shouldBe` Nothing - isValidProjectTag "aB" `shouldBe` Nothing - isValidProjectTag "ab c" `shouldBe` Nothing - isValidProjectTag "ab_c" `shouldBe` Nothing - isValidProjectTag "ab-c" `shouldBe` Nothing - isValidProjectTag "ab-,c" `shouldBe` validationError "ab-,c" diff --git a/wizard-server/test/Wizard/Specs/Service/Report/ReportGeneratorSpec.hs b/wizard-server/test/Wizard/Specs/Service/Report/ReportGeneratorSpec.hs index ca1ac1b3a..1b1616c2b 100644 --- a/wizard-server/test/Wizard/Specs/Service/Report/ReportGeneratorSpec.hs +++ b/wizard-server/test/Wizard/Specs/Service/Report/ReportGeneratorSpec.hs @@ -7,10 +7,10 @@ import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data. import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.KnowledgeModels import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Phases import Shared.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireReplies -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires +import Wizard.Database.Migration.Development.Project.Data.ProjectReplies +import Wizard.Database.Migration.Development.Project.Data.Projects import Wizard.Database.Migration.Development.Report.Data.Reports -import Wizard.Model.Questionnaire.QuestionnaireContent +import Wizard.Model.Project.ProjectContent import Wizard.Service.Report.ReportGenerator reportGeneratorSpec = @@ -27,7 +27,7 @@ createComputeChapterReportTest number chapter expectation = do let requiredPhaseUuidUuid = Just $ phase1.uuid let km = km1WithQ4 - let rs = M.fromList $ unused_rQ2_aYes_fuQ1_aYes_fuq2 : M.toList questionnaire1Ctn.replies + let rs = M.fromList $ unused_rQ2_aYes_fuQ1_aYes_fuq2 : M.toList project1Ctn.replies -- WHEN: let result = computeChapterReport requiredPhaseUuidUuid km rs chapter -- THEN @@ -39,7 +39,7 @@ createComputeTotalReportTest number expectation = do let requiredPhaseUuidUuid = Just $ phase1.uuid let km = km1WithQ4 - let rs = M.fromList $ unused_rQ2_aYes_fuQ1_aYes_fuq2 : M.toList questionnaire1Ctn.replies + let rs = M.fromList $ unused_rQ2_aYes_fuQ1_aYes_fuq2 : M.toList project1Ctn.replies -- WHEN: let result = computeTotalReport requiredPhaseUuidUuid km rs -- THEN diff --git a/wizard-server/test/Wizard/Specs/Websocket/KnowledgeModelEditor/Detail/Common.hs b/wizard-server/test/Wizard/Specs/Websocket/KnowledgeModelEditor/Detail/Common.hs index 707005044..4fe4e648b 100644 --- a/wizard-server/test/Wizard/Specs/Websocket/KnowledgeModelEditor/Detail/Common.hs +++ b/wizard-server/test/Wizard/Specs/Websocket/KnowledgeModelEditor/Detail/Common.hs @@ -13,7 +13,7 @@ import Shared.Common.Util.String import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Api.Resource.Websocket.KnowledgeModelEditorActionDTO +import Wizard.Api.Resource.Websocket.KnowledgeModelEditorMessageDTO import Wizard.Api.Resource.Websocket.WebsocketActionDTO import Wizard.Cache.KnowledgeModelEditorWebsocketCache import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelEditorDAO @@ -86,8 +86,8 @@ connectTestWebsocketUsers appContext bUuid = read_SetUserList connection expConnectionCount = do resDto <- receiveData connection - let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerKnowledgeModelEditorActionDTO) - let (Right (Success_ServerActionDTO (SetUserList_ServerKnowledgeModelEditorActionDTO resConnection))) = eResult + let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerKnowledgeModelEditorMessageDTO) + let (Right (Success_ServerActionDTO (SetUserList_ServerKnowledgeModelEditorMessageDTO resConnection))) = eResult length resConnection `shouldBe` expConnectionCount read_Error connection expError = do diff --git a/wizard-server/test/Wizard/Specs/Websocket/KnowledgeModelEditor/Detail/GeneralSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/KnowledgeModelEditor/Detail/GeneralSpec.hs index 97aa10197..d05fb1253 100644 --- a/wizard-server/test/Wizard/Specs/Websocket/KnowledgeModelEditor/Detail/GeneralSpec.hs +++ b/wizard-server/test/Wizard/Specs/Websocket/KnowledgeModelEditor/Detail/GeneralSpec.hs @@ -81,7 +81,7 @@ test404 appContext = do read_Error c1 expError -- AND: Close sockets closeSockets [s1] - it "WS 404 NOT FOUND - questionnaire was deleted" $ + it "WS 404 NOT FOUND - project was deleted" $ -- GIVEN: Prepare database do let editor = amsterdamKnowledgeModelEditor diff --git a/wizard-server/test/Wizard/Specs/Websocket/KnowledgeModelEditor/Detail/SetEventSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/KnowledgeModelEditor/Detail/SetEventSpec.hs index c5fec5c17..4e839cc4e 100644 --- a/wizard-server/test/Wizard/Specs/Websocket/KnowledgeModelEditor/Detail/SetEventSpec.hs +++ b/wizard-server/test/Wizard/Specs/Websocket/KnowledgeModelEditor/Detail/SetEventSpec.hs @@ -5,7 +5,7 @@ import Network.WebSockets import Test.Hspec hiding (shouldBe) import Test.Hspec.Expectations.Pretty -import Wizard.Api.Resource.Websocket.KnowledgeModelEditorActionDTO +import Wizard.Api.Resource.Websocket.KnowledgeModelEditorMessageDTO import Wizard.Api.Resource.Websocket.WebsocketActionDTO import Wizard.Database.Migration.Development.KnowledgeModel.Data.Editor.KnowledgeModelEditorEvents import Wizard.Database.Migration.Development.KnowledgeModel.Data.Editor.KnowledgeModelEditors @@ -44,11 +44,11 @@ test200 appContext = -- ---------------------------------------------------- -- ---------------------------------------------------- write_SetReply connection replyDto = do - let reqDto = SetContent_ClientKnowledgeModelEditorActionDTO replyDto + let reqDto = SetContent_ClientKnowledgeModelEditorMessageDTO replyDto sendMessage connection reqDto read_SetReply connection expReplyDto = do resDto <- receiveData connection - let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerKnowledgeModelEditorActionDTO) - let (Right (Success_ServerActionDTO (SetContent_ServerKnowledgeModelEditorActionDTO replyDto))) = eResult + let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerKnowledgeModelEditorMessageDTO) + let (Right (Success_ServerActionDTO (SetContent_ServerKnowledgeModelEditorMessageDTO replyDto))) = eResult expReplyDto `shouldBe` replyDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/KnowledgeModelEditor/Detail/SetRepliesSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/KnowledgeModelEditor/Detail/SetRepliesSpec.hs index 5b6c20a2d..4e4f3ebfc 100644 --- a/wizard-server/test/Wizard/Specs/Websocket/KnowledgeModelEditor/Detail/SetRepliesSpec.hs +++ b/wizard-server/test/Wizard/Specs/Websocket/KnowledgeModelEditor/Detail/SetRepliesSpec.hs @@ -5,7 +5,7 @@ import Network.WebSockets import Test.Hspec hiding (shouldBe) import Test.Hspec.Expectations.Pretty -import Wizard.Api.Resource.Websocket.KnowledgeModelEditorActionDTO +import Wizard.Api.Resource.Websocket.KnowledgeModelEditorMessageDTO import Wizard.Api.Resource.Websocket.WebsocketActionDTO import Wizard.Database.Migration.Development.KnowledgeModel.Data.Editor.KnowledgeModelEditorEvents import Wizard.Database.Migration.Development.KnowledgeModel.Data.Editor.KnowledgeModelEditors @@ -44,11 +44,11 @@ test200 appContext = -- ---------------------------------------------------- -- ---------------------------------------------------- write_SetReplies connection replyDto = do - let reqDto = SetReplies_ClientKnowledgeModelEditorActionDTO replyDto + let reqDto = SetReplies_ClientKnowledgeModelEditorMessageDTO replyDto sendMessage connection reqDto read_SetReplies connection expRepliesDto = do resDto <- receiveData connection - let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerKnowledgeModelEditorActionDTO) - let (Right (Success_ServerActionDTO (SetReplies_ServerKnowledgeModelEditorActionDTO replyDto))) = eResult + let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerKnowledgeModelEditorMessageDTO) + let (Right (Success_ServerActionDTO (SetReplies_ServerKnowledgeModelEditorMessageDTO replyDto))) = eResult expRepliesDto `shouldBe` replyDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/AddCommentSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/AddCommentSpec.hs new file mode 100644 index 000000000..bfa34a66a --- /dev/null +++ b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/AddCommentSpec.hs @@ -0,0 +1,66 @@ +module Wizard.Specs.Websocket.Project.Detail.AddCommentSpec where + +import Data.Aeson +import Data.Foldable (traverse_) +import Network.WebSockets +import Test.Hspec hiding (shouldBe) +import Test.Hspec.Expectations.Pretty + +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Api.Resource.Websocket.ProjectMessageDTO +import Wizard.Api.Resource.Websocket.WebsocketActionDTO +import Wizard.Database.DAO.Project.ProjectDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Project.Project + +import Wizard.Specs.Common +import Wizard.Specs.Websocket.Common +import Wizard.Specs.Websocket.Project.Detail.Common + +addCommentSpec appContext = describe "addComment" $ test200 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test200 appContext = + it "WS 200 OK" $ + -- GIVEN: Prepare database + do + runInContext U.runMigration appContext + runInContextIO TML_Migration.runMigration appContext + runInContextIO (insertPackage germanyKmPackage) appContext + runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext + runInContextIO (insertProject project10) appContext + runInContextIO (insertProject project7) appContext + -- AND: Connect to websocket + ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext project10.uuid + ((c4, s4), (c5, s5), (c6, s6)) <- connectTestWebsocketUsers appContext project7.uuid + -- WHEN: + write_AddComment c1 acche_rQ2_t1_1' + -- THEN: + read_AddComment c1 ace_rQ2_t1_1' + read_AddComment c2 ace_rQ2_t1_1' + read_AddComment c3 ace_rQ2_t1_1' + nothingWasReceived c4 + nothingWasReceived c5 + nothingWasReceived c6 + -- AND: Close sockets + closeSockets [s1, s2, s3, s4, s5, s6] + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +write_AddComment connection replyDto = do + let reqDto = SetContent_ClientProjectMessageDTO replyDto + sendMessage connection reqDto + +read_AddComment connection expReplyDto = do + resDto <- receiveData connection + let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerProjectMessageDTO) + let (Right (Success_ServerActionDTO (SetContent_ServerProjectMessageDTO replyDto))) = eResult + expReplyDto `shouldBe` replyDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/AssignCommentThreadSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/AssignCommentThreadSpec.hs new file mode 100644 index 000000000..4e116f137 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/AssignCommentThreadSpec.hs @@ -0,0 +1,66 @@ +module Wizard.Specs.Websocket.Project.Detail.AssignCommentThreadSpec where + +import Data.Aeson +import Data.Foldable (traverse_) +import Network.WebSockets +import Test.Hspec hiding (shouldBe) +import Test.Hspec.Expectations.Pretty + +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Api.Resource.Websocket.ProjectMessageDTO +import Wizard.Api.Resource.Websocket.WebsocketActionDTO +import Wizard.Database.DAO.Project.ProjectDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Project.Project + +import Wizard.Specs.Common +import Wizard.Specs.Websocket.Common +import Wizard.Specs.Websocket.Project.Detail.Common + +assignCommentThreadSpec appContext = describe "assignCommentThread" $ test200 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test200 appContext = + it "WS 200 OK" $ + -- GIVEN: Prepare database + do + runInContext U.runMigration appContext + runInContextIO TML_Migration.runMigration appContext + runInContextIO (insertPackage germanyKmPackage) appContext + runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext + runInContextIO (insertProject project10) appContext + runInContextIO (insertProject project7) appContext + -- AND: Connect to websocket + ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext project10.uuid + ((c4, s4), (c5, s5), (c6, s6)) <- connectTestWebsocketUsers appContext project7.uuid + -- WHEN: + write_AssignCommentThread c1 asche_rQ1_t1' + -- THEN: + read_AssignCommentThread c1 aste_rQ1_t1' + read_AssignCommentThread c2 aste_rQ1_t1' + read_AssignCommentThread c3 aste_rQ1_t1' + nothingWasReceived c4 + nothingWasReceived c5 + nothingWasReceived c6 + -- AND: Close sockets + closeSockets [s1, s2, s3, s4, s5, s6] + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +write_AssignCommentThread connection replyDto = do + let reqDto = SetContent_ClientProjectMessageDTO replyDto + sendMessage connection reqDto + +read_AssignCommentThread connection expReplyDto = do + resDto <- receiveData connection + let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerProjectMessageDTO) + let (Right (Success_ServerActionDTO (SetContent_ServerProjectMessageDTO replyDto))) = eResult + expReplyDto `shouldBe` replyDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/ClearReplySpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/ClearReplySpec.hs new file mode 100644 index 000000000..562a97386 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/ClearReplySpec.hs @@ -0,0 +1,68 @@ +module Wizard.Specs.Websocket.Project.Detail.ClearReplySpec where + +import Data.Aeson +import Data.Foldable (traverse_) +import Network.WebSockets +import Test.Hspec hiding (shouldBe) +import Test.Hspec.Expectations.Pretty + +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Api.Resource.Websocket.ProjectMessageDTO +import Wizard.Api.Resource.Websocket.WebsocketActionDTO +import Wizard.Database.DAO.Project.ProjectDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Database.Migration.Development.User.Data.Users +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Project.Project +import Wizard.Service.Project.Event.ProjectEventMapper + +import Wizard.Specs.Common +import Wizard.Specs.Websocket.Common +import Wizard.Specs.Websocket.Project.Detail.Common + +clearReplySpec appContext = describe "clearReply" $ test200 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test200 appContext = + it "WS 200 OK" $ + -- GIVEN: Prepare database + do + runInContext U.runMigration appContext + runInContextIO TML_Migration.runMigration appContext + runInContextIO (insertPackage germanyKmPackage) appContext + runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext + runInContextIO (insertProject project10) appContext + runInContextIO (insertProject project7) appContext + -- AND: Connect to websocket + ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext project10.uuid + ((c4, s4), (c5, s5), (c6, s6)) <- connectTestWebsocketUsers appContext project7.uuid + -- WHEN: + write_ClearReply c1 (toEventChangeDTO (cre_rQ1' project10Uuid)) + -- THEN: + read_ClearReply c1 (toEventDTO (cre_rQ1' project10Uuid) (Just userAlbert)) + read_ClearReply c2 (toEventDTO (cre_rQ1' project10Uuid) (Just userAlbert)) + read_ClearReply c3 (toEventDTO (cre_rQ1' project10Uuid) (Just userAlbert)) + nothingWasReceived c4 + nothingWasReceived c5 + nothingWasReceived c6 + -- AND: Close sockets + closeSockets [s1, s2, s3, s4, s5, s6] + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +write_ClearReply connection replyDto = do + let reqDto = SetContent_ClientProjectMessageDTO replyDto + sendMessage connection reqDto + +read_ClearReply connection expReplyDto = do + resDto <- receiveData connection + let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerProjectMessageDTO) + let (Right (Success_ServerActionDTO (SetContent_ServerProjectMessageDTO replyDto))) = eResult + expReplyDto `shouldBe` replyDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/Common.hs b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/Common.hs new file mode 100644 index 000000000..05c0bd820 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/Common.hs @@ -0,0 +1,153 @@ +module Wizard.Specs.Websocket.Project.Detail.Common where + +import qualified Control.Exception.Base as E +import Data.Aeson +import qualified Data.ByteString.Lazy.Char8 as BSL +import Data.Foldable (traverse_) +import qualified Data.Map.Strict as M +import qualified Data.UUID as U +import qualified Network.HTTP.Client as HC +import Network.WebSockets +import qualified Network.Wreq as W +import qualified Network.Wreq.Types as WT +import System.Timeout +import Test.Hspec.Expectations.Pretty + +import Shared.Common.Integration.Http.Common.HttpClient (mapHeader) +import Shared.Common.Integration.Http.Common.HttpClientFactory +import Shared.Common.Model.Http.HttpRequest +import Shared.Common.Util.JSON +import Shared.Common.Util.String +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Api.Resource.Websocket.ProjectMessageDTO +import Wizard.Api.Resource.Websocket.WebsocketActionDTO +import Wizard.Cache.ProjectWebsocketCache +import Wizard.Database.DAO.Project.ProjectDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Config.ServerConfig +import Wizard.Model.Context.AppContext +import Wizard.Model.Websocket.WebsocketRecord +import Wizard.Service.Project.Collaboration.ProjectCollaborationService + +import Wizard.Specs.API.Common +import Wizard.Specs.Common +import Wizard.Specs.Websocket.Common + +-- -------------------------------- +-- ASSERTS +-- -------------------------------- +assertCountOfWebsocketConnection appContext expCount = do + (Right resCount) <- runInContext countCache appContext + resCount `shouldBe` expCount + +-- -------------------------------- +-- URL +-- -------------------------------- +reqUrlT projectUuid mUser = + let suffix = + case mUser of + Just user -> "?Authorization=Bearer%20" ++ user + Nothing -> "" + in f' "/wizard-api/projects/%s/websocket%s" [U.toString projectUuid, suffix] + +-- -------------------------------- +-- DATABASE +-- -------------------------------- +insertProjectAndUsers appContext project = + -- Prepare DB + do + runInContext U.runMigration appContext + runInContextIO TML_Migration.runMigration appContext + runInContextIO (insertPackage germanyKmPackage) appContext + runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext + runInContextIO (insertProject project) appContext + +-- -------------------------------- +-- CONNECT +-- -------------------------------- +connectTestWebsocketUsers appContext projectUuid = + -- Clear websockets + do + clearConnections appContext projectUuid + -- Connect 1. user + (c1, s1) <- createConnection appContext (reqUrlT projectUuid (Just reqAuthToken)) + read_SetUserList c1 0 + -- Connect 2. user + (c2, s2) <- createConnection appContext (reqUrlT projectUuid (Just reqNonAdminAuthToken)) + read_SetUserList c1 1 + read_SetUserList c2 1 + -- Connect 3. user + (c3, s3) <- createConnection appContext (reqUrlT projectUuid Nothing) + read_SetUserList c1 2 + read_SetUserList c2 2 + read_SetUserList c3 2 + return ((c1, s1), (c2, s2), (c3, s3)) + +read_SetUserList connection expConnectionCount = do + resDto <- receiveData connection + let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerProjectMessageDTO) + let (Right (Success_ServerActionDTO (SetUserList_ServerProjectMessageDTO resConnection))) = eResult + length resConnection `shouldBe` expConnectionCount + +read_Error connection expError = do + resDto <- receiveData connection + let eResult = eitherDecode resDto :: Either String Error_ServerActionDTO + let (Right (Error_ServerActionDTO error)) = eResult + error `shouldBe` expError + +read_SetUserList_or_Error connection expError = do + resDto <- receiveData connection + let (Right result) = eitherDecode resDto :: Either String Object + let resultType = getField "type" result return + case resultType of + (Right "Success_ServerAction") -> read_Error connection expError + (Right "Error_ServerAction") -> do + let eResult = eitherDecode resDto :: Either String Error_ServerActionDTO + let (Right (Error_ServerActionDTO error)) = eResult + error `shouldBe` expError + rest -> print rest + +nothingWasReceived connection = do + maybeResDto <- timeout 1000 (receive connection) + maybeResDto `shouldBe` Nothing + +-- -------------------------------- +-- DISCONNECT +-- -------------------------------- +clearConnections :: AppContext -> U.UUID -> IO () +clearConnections appContext projectUuid = do + (Right records) <- runInContext getAllFromCache appContext + traverse_ (clearConnection appContext projectUuid) . filter (\r -> r.entityId == U.toString projectUuid) $ records + +clearConnection :: AppContext -> U.UUID -> WebsocketRecord -> IO () +clearConnection appContext projectUuid record = do + runInContext (deleteUser projectUuid record.connectionUuid) appContext + return () + +-- -------------------------------- +-- HTTP Client +-- -------------------------------- +runSimpleRequest :: AppContext -> HttpRequest -> IO (Either E.SomeException (HC.Response BSL.ByteString)) +runSimpleRequest appContext req = do + httpClientManager <- createHttpClientManager appContext.serverConfig.logging + let opts = + W.defaults + { WT.manager = Right httpClientManager + , WT.headers = reqHeaders + , WT.checkResponse = Just (\_ _ -> return ()) + } + E.try . action $ opts + where + reqMethod = req.requestMethod + host = + if appContext.serverConfig.general.serverPort == 80 + then "localhost" + else "localhost:" ++ show appContext.serverConfig.general.serverPort + reqUrl = f' "http://%s/%s" [host, req.requestUrl] + reqHeaders = mapHeader <$> M.toList req.requestHeaders + action opts + | reqMethod == "GET" = W.getWith opts reqUrl + | otherwise = W.customPayloadMethodWith reqMethod opts reqUrl req.requestBody diff --git a/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/DeleteCommentSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/DeleteCommentSpec.hs new file mode 100644 index 000000000..923874c3f --- /dev/null +++ b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/DeleteCommentSpec.hs @@ -0,0 +1,66 @@ +module Wizard.Specs.Websocket.Project.Detail.DeleteCommentSpec where + +import Data.Aeson +import Data.Foldable (traverse_) +import Network.WebSockets +import Test.Hspec hiding (shouldBe) +import Test.Hspec.Expectations.Pretty + +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Api.Resource.Websocket.ProjectMessageDTO +import Wizard.Api.Resource.Websocket.WebsocketActionDTO +import Wizard.Database.DAO.Project.ProjectDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Project.Project + +import Wizard.Specs.Common +import Wizard.Specs.Websocket.Common +import Wizard.Specs.Websocket.Project.Detail.Common + +deleteCommentSpec appContext = describe "deleteComment" $ test200 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test200 appContext = + it "WS 200 OK" $ + -- GIVEN: Prepare database + do + runInContext U.runMigration appContext + runInContextIO TML_Migration.runMigration appContext + runInContextIO (insertPackage germanyKmPackage) appContext + runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext + runInContextIO (insertProject project10) appContext + runInContextIO (insertProject project7) appContext + -- AND: Connect to websocket + ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext project10.uuid + ((c4, s4), (c5, s5), (c6, s6)) <- connectTestWebsocketUsers appContext project7.uuid + -- WHEN: + write_DeleteComment c1 dcche_rQ1_t1_1' + -- THEN: + read_DeleteComment c1 dce_rQ1_t1_1' + read_DeleteComment c2 dce_rQ1_t1_1' + read_DeleteComment c3 dce_rQ1_t1_1' + nothingWasReceived c4 + nothingWasReceived c5 + nothingWasReceived c6 + -- AND: Close sockets + closeSockets [s1, s2, s3, s4, s5, s6] + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +write_DeleteComment connection replyDto = do + let reqDto = SetContent_ClientProjectMessageDTO replyDto + sendMessage connection reqDto + +read_DeleteComment connection expReplyDto = do + resDto <- receiveData connection + let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerProjectMessageDTO) + let (Right (Success_ServerActionDTO (SetContent_ServerProjectMessageDTO replyDto))) = eResult + expReplyDto `shouldBe` replyDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/DeleteCommentThreadSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/DeleteCommentThreadSpec.hs new file mode 100644 index 000000000..b92307010 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/DeleteCommentThreadSpec.hs @@ -0,0 +1,66 @@ +module Wizard.Specs.Websocket.Project.Detail.DeleteCommentThreadSpec where + +import Data.Aeson +import Data.Foldable (traverse_) +import Network.WebSockets +import Test.Hspec hiding (shouldBe) +import Test.Hspec.Expectations.Pretty + +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Api.Resource.Websocket.ProjectMessageDTO +import Wizard.Api.Resource.Websocket.WebsocketActionDTO +import Wizard.Database.DAO.Project.ProjectDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Project.Project + +import Wizard.Specs.Common +import Wizard.Specs.Websocket.Common +import Wizard.Specs.Websocket.Project.Detail.Common + +deleteCommentThreadSpec appContext = describe "deleteCommentThread" $ test200 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test200 appContext = + it "WS 200 OK" $ + -- GIVEN: Prepare database + do + runInContext U.runMigration appContext + runInContextIO TML_Migration.runMigration appContext + runInContextIO (insertPackage germanyKmPackage) appContext + runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext + runInContextIO (insertProject project10) appContext + runInContextIO (insertProject project7) appContext + -- AND: Connect to websocket + ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext project10.uuid + ((c4, s4), (c5, s5), (c6, s6)) <- connectTestWebsocketUsers appContext project7.uuid + -- WHEN: + write_DeleteCommentThread c1 dtche_rQ1_t1' + -- THEN: + read_DeleteCommentThread c1 dte_rQ1_t1' + read_DeleteCommentThread c2 dte_rQ1_t1' + read_DeleteCommentThread c3 dte_rQ1_t1' + nothingWasReceived c4 + nothingWasReceived c5 + nothingWasReceived c6 + -- AND: Close sockets + closeSockets [s1, s2, s3, s4, s5, s6] + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +write_DeleteCommentThread connection replyDto = do + let reqDto = SetContent_ClientProjectMessageDTO replyDto + sendMessage connection reqDto + +read_DeleteCommentThread connection expReplyDto = do + resDto <- receiveData connection + let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerProjectMessageDTO) + let (Right (Success_ServerActionDTO (SetContent_ServerProjectMessageDTO replyDto))) = eResult + expReplyDto `shouldBe` replyDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/EditCommentSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/EditCommentSpec.hs new file mode 100644 index 000000000..6db023848 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/EditCommentSpec.hs @@ -0,0 +1,66 @@ +module Wizard.Specs.Websocket.Project.Detail.EditCommentSpec where + +import Data.Aeson +import Data.Foldable (traverse_) +import Network.WebSockets +import Test.Hspec hiding (shouldBe) +import Test.Hspec.Expectations.Pretty + +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Api.Resource.Websocket.ProjectMessageDTO +import Wizard.Api.Resource.Websocket.WebsocketActionDTO +import Wizard.Database.DAO.Project.ProjectDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Project.Project + +import Wizard.Specs.Common +import Wizard.Specs.Websocket.Common +import Wizard.Specs.Websocket.Project.Detail.Common + +editCommentSpec appContext = describe "editComment" $ test200 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test200 appContext = + it "WS 200 OK" $ + -- GIVEN: Prepare database + do + runInContext U.runMigration appContext + runInContextIO TML_Migration.runMigration appContext + runInContextIO (insertPackage germanyKmPackage) appContext + runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext + runInContextIO (insertProject project10) appContext + runInContextIO (insertProject project7) appContext + -- AND: Connect to websocket + ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext project10.uuid + ((c4, s4), (c5, s5), (c6, s6)) <- connectTestWebsocketUsers appContext project7.uuid + -- WHEN: + write_EditComment c1 ecche_rQ1_t1_1' + -- THEN: + read_EditComment c1 ece_rQ1_t1_1' + read_EditComment c2 ece_rQ1_t1_1' + read_EditComment c3 ece_rQ1_t1_1' + nothingWasReceived c4 + nothingWasReceived c5 + nothingWasReceived c6 + -- AND: Close sockets + closeSockets [s1, s2, s3, s4, s5, s6] + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +write_EditComment connection replyDto = do + let reqDto = SetContent_ClientProjectMessageDTO replyDto + sendMessage connection reqDto + +read_EditComment connection expReplyDto = do + resDto <- receiveData connection + let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerProjectMessageDTO) + let (Right (Success_ServerActionDTO (SetContent_ServerProjectMessageDTO replyDto))) = eResult + expReplyDto `shouldBe` replyDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/GeneralSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/GeneralSpec.hs new file mode 100644 index 000000000..724306946 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/GeneralSpec.hs @@ -0,0 +1,133 @@ +module Wizard.Specs.Websocket.Project.Detail.GeneralSpec where + +import qualified Data.UUID as U +import Test.Hspec hiding (shouldBe) + +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Shared.Common.Util.Uuid +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Database.Migration.Development.Tenant.Data.Tenants +import Wizard.Localization.Messages.Public +import Wizard.Model.Config.ServerConfig +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Project +import Wizard.Model.Tenant.Tenant +import Wizard.Service.Project.ProjectMapper +import Wizard.Service.Project.ProjectService + +import Wizard.Specs.API.Common +import Wizard.Specs.Common +import Wizard.Specs.Websocket.Common +import Wizard.Specs.Websocket.Project.Detail.Common + +generalSpec appContext = + describe "general" $ do + test200 appContext + test403 appContext + test404 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test200 appContext = + it "WS 200 OK" $ + -- GIVEN: Prepare database + do + let project = project10 + insertProjectAndUsers appContext project + -- WHEN + ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext project.uuid + -- THEN: + assertCountOfWebsocketConnection appContext 3 + -- AND: Close sockets + closeSockets [s1, s2, s3] + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test403 appContext = do + create_403_no_perm + "WS 403 FORBIDDEN - no required view entity permission (Anonymous, Private)" + appContext + project1 + Nothing + "View Project" + create_403_no_perm + "WS 403 FORBIDDEN - no required view entity permission (Non-owner, Private)" + appContext + project1 + (Just reqNonAdminAuthToken) + "View Project" + it "WS 403 FORBIDDEN - when perms are changed" $ + -- GIVEN: Prepare database + do + let project = project10 + insertProjectAndUsers appContext project + let updatedProject = project {visibility = PrivateProjectVisibility, sharing = RestrictedProjectSharing} + -- AND: Connect to websocket + ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext project.uuid + -- AND: Prepare expectation + let expError = ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN "View Project" + -- WHEN: Update permission + runInContext (modifyProjectShare updatedProject.uuid (toChangeDTO updatedProject)) appContext + -- THEN: Read response + read_SetUserList c1 1 + read_SetUserList c1 0 + read_SetUserList_or_Error c2 expError + read_SetUserList_or_Error c3 expError + -- AND: Close sockets + closeSockets [s1, s2, s3] + +create_403_no_perm title appContext project authToken errorMessage = + it title $ + -- GIVEN: Prepare database + do + insertProjectAndUsers appContext project + -- AND: Prepare expectation + let expError = ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN errorMessage + -- WHEN: Connect to websocket + (c1, s1) <- createConnection appContext (reqUrlT project.uuid authToken) + -- THEN: Read response + read_Error c1 expError + -- AND: Close sockets + closeSockets [s1] + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test404 appContext = do + it "WS 404 NOT FOUND - non existing entity" $ + -- GIVEN: Prepare request + do + let nonExistingProjectUuid = "fd5ea37c-852a-4174-9d65-2bf23202541d" + -- AND: Prepare expectation + let expError = + NotExistsError + ( _ERROR_DATABASE__ENTITY_NOT_FOUND + "project" + [("tenant_uuid", U.toString defaultTenant.uuid), ("uuid", nonExistingProjectUuid)] + ) + -- WHEN: + (c1, s1) <- createConnection appContext (reqUrlT (u' nonExistingProjectUuid) (Just reqAuthToken)) + -- THEN: + read_Error c1 expError + -- AND: Close sockets + closeSockets [s1] + it "WS 404 NOT FOUND - project was deleted" $ + -- GIVEN: Prepare database + do + let project = project10 + insertProjectAndUsers appContext project + -- AND: Connect to websocket + ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext project.uuid + -- AND: Prepare expectation + let expError = NotExistsError (_ERROR_SERVICE_PROJECT_COLLABORATION__FORCE_DISCONNECT (U.toString $ project.uuid)) + -- WHEN: Update permission + runInContext (deleteProject project.uuid True) appContext + -- THEN: Read response + read_Error c1 expError + read_Error c2 expError + read_Error c3 expError + -- AND: Close sockets + closeSockets [s1, s2, s3] diff --git a/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/ReopenCommentThreadSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/ReopenCommentThreadSpec.hs new file mode 100644 index 000000000..7f9b9bac4 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/ReopenCommentThreadSpec.hs @@ -0,0 +1,66 @@ +module Wizard.Specs.Websocket.Project.Detail.ReopenCommentThreadSpec where + +import Data.Aeson +import Data.Foldable (traverse_) +import Network.WebSockets +import Test.Hspec hiding (shouldBe) +import Test.Hspec.Expectations.Pretty + +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Api.Resource.Websocket.ProjectMessageDTO +import Wizard.Api.Resource.Websocket.WebsocketActionDTO +import Wizard.Database.DAO.Project.ProjectDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Project.Project + +import Wizard.Specs.Common +import Wizard.Specs.Websocket.Common +import Wizard.Specs.Websocket.Project.Detail.Common + +reopenCommentThreadSpec appContext = describe "reopenCommentThread" $ test200 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test200 appContext = + it "WS 200 OK" $ + -- GIVEN: Prepare database + do + runInContext U.runMigration appContext + runInContextIO TML_Migration.runMigration appContext + runInContextIO (insertPackage germanyKmPackage) appContext + runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext + runInContextIO (insertProject project10) appContext + runInContextIO (insertProject project7) appContext + -- AND: Connect to websocket + ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext project10.uuid + ((c4, s4), (c5, s5), (c6, s6)) <- connectTestWebsocketUsers appContext project7.uuid + -- WHEN: + write_ReopenCommentThread c1 otche_rQ1_t1' + -- THEN: + read_ReopenCommentThread c1 ote_rQ1_t1' + read_ReopenCommentThread c2 ote_rQ1_t1' + read_ReopenCommentThread c3 ote_rQ1_t1' + nothingWasReceived c4 + nothingWasReceived c5 + nothingWasReceived c6 + -- AND: Close sockets + closeSockets [s1, s2, s3, s4, s5, s6] + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +write_ReopenCommentThread connection replyDto = do + let reqDto = SetContent_ClientProjectMessageDTO replyDto + sendMessage connection reqDto + +read_ReopenCommentThread connection expReplyDto = do + resDto <- receiveData connection + let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerProjectMessageDTO) + let (Right (Success_ServerActionDTO (SetContent_ServerProjectMessageDTO replyDto))) = eResult + expReplyDto `shouldBe` replyDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/ResolveCommentThreadSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/ResolveCommentThreadSpec.hs new file mode 100644 index 000000000..c9d7e8c75 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/ResolveCommentThreadSpec.hs @@ -0,0 +1,66 @@ +module Wizard.Specs.Websocket.Project.Detail.ResolveCommentThreadSpec where + +import Data.Aeson +import Data.Foldable (traverse_) +import Network.WebSockets +import Test.Hspec hiding (shouldBe) +import Test.Hspec.Expectations.Pretty + +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Api.Resource.Websocket.ProjectMessageDTO +import Wizard.Api.Resource.Websocket.WebsocketActionDTO +import Wizard.Database.DAO.Project.ProjectDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Project.Project + +import Wizard.Specs.Common +import Wizard.Specs.Websocket.Common +import Wizard.Specs.Websocket.Project.Detail.Common + +resolveCommentThreadSpec appContext = describe "resolveCommentThread" $ test200 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test200 appContext = + it "WS 200 OK" $ + -- GIVEN: Prepare database + do + runInContext U.runMigration appContext + runInContextIO TML_Migration.runMigration appContext + runInContextIO (insertPackage germanyKmPackage) appContext + runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext + runInContextIO (insertProject project10) appContext + runInContextIO (insertProject project7) appContext + -- AND: Connect to websocket + ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext project10.uuid + ((c4, s4), (c5, s5), (c6, s6)) <- connectTestWebsocketUsers appContext project7.uuid + -- WHEN: + write_ResolveCommentThread c1 rtche_rQ1_t1' + -- THEN: + read_ResolveCommentThread c1 rte_rQ1_t1' + read_ResolveCommentThread c2 rte_rQ1_t1' + read_ResolveCommentThread c3 rte_rQ1_t1' + nothingWasReceived c4 + nothingWasReceived c5 + nothingWasReceived c6 + -- AND: Close sockets + closeSockets [s1, s2, s3, s4, s5, s6] + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +write_ResolveCommentThread connection replyDto = do + let reqDto = SetContent_ClientProjectMessageDTO replyDto + sendMessage connection reqDto + +read_ResolveCommentThread connection expReplyDto = do + resDto <- receiveData connection + let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerProjectMessageDTO) + let (Right (Success_ServerActionDTO (SetContent_ServerProjectMessageDTO replyDto))) = eResult + expReplyDto `shouldBe` replyDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/SetLabelsSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/SetLabelsSpec.hs new file mode 100644 index 000000000..b399f88dc --- /dev/null +++ b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/SetLabelsSpec.hs @@ -0,0 +1,68 @@ +module Wizard.Specs.Websocket.Project.Detail.SetLabelsSpec where + +import Data.Aeson +import Data.Foldable (traverse_) +import Network.WebSockets +import Test.Hspec hiding (shouldBe) +import Test.Hspec.Expectations.Pretty + +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Api.Resource.Websocket.ProjectMessageDTO +import Wizard.Api.Resource.Websocket.WebsocketActionDTO +import Wizard.Database.DAO.Project.ProjectDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Database.Migration.Development.User.Data.Users +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Project.Project +import Wizard.Service.Project.Event.ProjectEventMapper + +import Wizard.Specs.Common +import Wizard.Specs.Websocket.Common +import Wizard.Specs.Websocket.Project.Detail.Common + +setLabelsSpec appContext = describe "setLabels" $ test200 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test200 appContext = + it "WS 200 OK" $ + -- GIVEN: Prepare database + do + runInContext U.runMigration appContext + runInContextIO TML_Migration.runMigration appContext + runInContextIO (insertPackage germanyKmPackage) appContext + runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext + runInContextIO (insertProject project10) appContext + runInContextIO (insertProject project7) appContext + -- AND: Connect to websocket + ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext project10.uuid + ((c4, s4), (c5, s5), (c6, s6)) <- connectTestWebsocketUsers appContext project7.uuid + -- WHEN: + write_SetLabels c1 (toEventChangeDTO (slble_rQ1' project10Uuid)) + -- THEN: + read_SetLabels c1 (toEventDTO (slble_rQ1' project10Uuid) (Just userAlbert)) + read_SetLabels c2 (toEventDTO (slble_rQ1' project10Uuid) (Just userAlbert)) + read_SetLabels c3 (toEventDTO (slble_rQ1' project10Uuid) (Just userAlbert)) + nothingWasReceived c4 + nothingWasReceived c5 + nothingWasReceived c6 + -- AND: Close sockets + closeSockets [s1, s2, s3, s4, s5, s6] + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +write_SetLabels connection replyDto = do + let reqDto = SetContent_ClientProjectMessageDTO replyDto + sendMessage connection reqDto + +read_SetLabels connection expReplyDto = do + resDto <- receiveData connection + let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerProjectMessageDTO) + let (Right (Success_ServerActionDTO (SetContent_ServerProjectMessageDTO replyDto))) = eResult + expReplyDto `shouldBe` replyDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/SetPhaseSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/SetPhaseSpec.hs new file mode 100644 index 000000000..68cd8015b --- /dev/null +++ b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/SetPhaseSpec.hs @@ -0,0 +1,68 @@ +module Wizard.Specs.Websocket.Project.Detail.SetPhaseSpec where + +import Data.Aeson +import Data.Foldable (traverse_) +import Network.WebSockets +import Test.Hspec hiding (shouldBe) +import Test.Hspec.Expectations.Pretty + +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Api.Resource.Websocket.ProjectMessageDTO +import Wizard.Api.Resource.Websocket.WebsocketActionDTO +import Wizard.Database.DAO.Project.ProjectDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Database.Migration.Development.User.Data.Users +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Project.Project +import Wizard.Service.Project.Event.ProjectEventMapper + +import Wizard.Specs.Common +import Wizard.Specs.Websocket.Common +import Wizard.Specs.Websocket.Project.Detail.Common + +setPhaseSpec appContext = describe "setPhase" $ test200 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test200 appContext = + it "WS 200 OK" $ + -- GIVEN: Prepare database + do + runInContext U.runMigration appContext + runInContextIO TML_Migration.runMigration appContext + runInContextIO (insertPackage germanyKmPackage) appContext + runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext + runInContextIO (insertProject project10) appContext + runInContextIO (insertProject project7) appContext + -- AND: Connect to websocket + ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext project10.uuid + ((c4, s4), (c5, s5), (c6, s6)) <- connectTestWebsocketUsers appContext project7.uuid + -- WHEN: + write_SetPhase c1 (toEventChangeDTO (sphse_2' project10Uuid)) + -- THEN: + read_SetPhase c1 (toEventDTO (sphse_2' project10Uuid) (Just userAlbert)) + read_SetPhase c2 (toEventDTO (sphse_2' project10Uuid) (Just userAlbert)) + read_SetPhase c3 (toEventDTO (sphse_2' project10Uuid) (Just userAlbert)) + nothingWasReceived c4 + nothingWasReceived c5 + nothingWasReceived c6 + -- AND: Close sockets + closeSockets [s1, s2, s3, s4, s5, s6] + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +write_SetPhase connection replyDto = do + let reqDto = SetContent_ClientProjectMessageDTO replyDto + sendMessage connection reqDto + +read_SetPhase connection expReplyDto = do + resDto <- receiveData connection + let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerProjectMessageDTO) + let (Right (Success_ServerActionDTO (SetContent_ServerProjectMessageDTO replyDto))) = eResult + expReplyDto `shouldBe` replyDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/SetProjectSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/SetProjectSpec.hs new file mode 100644 index 000000000..0aecd6b3e --- /dev/null +++ b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/SetProjectSpec.hs @@ -0,0 +1,86 @@ +module Wizard.Specs.Websocket.Project.Detail.SetProjectSpec where + +import Data.Aeson +import qualified Data.ByteString.Lazy.Char8 as BSL +import Data.Either (isRight) +import Data.Foldable (traverse_) +import qualified Data.Map.Strict as M +import qualified Data.UUID as U +import qualified Network.HTTP.Client as HC +import Network.HTTP.Types.Status (ok200) +import Network.WebSockets +import Test.Hspec hiding (shouldBe) +import Test.Hspec.Expectations.Pretty + +import Shared.Common.Model.Http.HttpRequest +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Api.Resource.Websocket.ProjectMessageDTO +import Wizard.Api.Resource.Websocket.WebsocketActionDTO +import Wizard.Database.DAO.Project.ProjectDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration +import Wizard.Database.Migration.Development.Project.Data.Projects +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Project.Project + +import Wizard.Specs.API.Common +import Wizard.Specs.Common +import Wizard.Specs.Websocket.Common +import Wizard.Specs.Websocket.Project.Detail.Common + +setProjectSpec appContext = + describe "setProjectSpec" $ + test200 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test200 appContext = + it "WS 200 OK" $ + -- GIVEN: Prepare database + do + runInContext U.runMigration appContext + runInContextIO TML_Migration.runMigration appContext + runInContextIO (insertPackage germanyKmPackage) appContext + runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext + runInContextIO (insertProject project10) appContext + runInContextIO (insertProject project7) appContext + -- AND: Connect to websocket + ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext project10.uuid + ((c4, s4), (c5, s5), (c6, s6)) <- connectTestWebsocketUsers appContext project7.uuid + -- AND: Prepare request + let request = + HttpRequest + { requestMethod = "PUT" + , requestUrl = "/wizard-api/projects/" ++ U.toString project10.uuid ++ "/settings" + , requestHeaders = M.fromList [("Authorization", "Bearer " ++ reqAuthToken), ("Content-Type", "application/json")] + , requestBody = BSL.toStrict . encode $ project10EditedSettingsChange + , multipart = Nothing + } + -- AND: Prepare expectation + let expStatus = 200 + -- WHEN: + response <- runSimpleRequest appContext request + -- THEN: + isRight response `shouldBe` True + let (Right r) = response + HC.responseStatus r `shouldBe` ok200 + -- AND: + read_SetProject c1 project10EditedWs + read_SetProject c2 project10EditedWs + read_SetProject c3 project10EditedWs + nothingWasReceived c4 + nothingWasReceived c5 + nothingWasReceived c6 + -- AND: Close sockets + closeSockets [s1, s2, s3, s4, s5, s6] + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +read_SetProject connection expProjectChangeDto = do + resDto <- receiveData connection + let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerProjectMessageDTO) + let (Right (Success_ServerActionDTO (SetProject_ServerProjectMessageDTO projectChangeDto))) = eResult + expProjectChangeDto `shouldBe` projectChangeDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/SetReplySpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/SetReplySpec.hs new file mode 100644 index 000000000..95d7f1e57 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/SetReplySpec.hs @@ -0,0 +1,110 @@ +module Wizard.Specs.Websocket.Project.Detail.SetReplySpec where + +import Data.Aeson +import Data.Foldable (traverse_) +import Network.WebSockets +import Test.Hspec hiding (shouldBe) +import Test.Hspec.Expectations.Pretty + +import Shared.Common.Localization.Messages.Public +import Shared.Common.Model.Error.Error +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO +import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO +import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages +import Wizard.Api.Resource.Websocket.ProjectMessageDTO +import Wizard.Api.Resource.Websocket.WebsocketActionDTO +import Wizard.Database.DAO.Project.ProjectDAO +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration +import Wizard.Database.Migration.Development.Project.Data.ProjectEvents +import Wizard.Database.Migration.Development.Project.Data.Projects +import Wizard.Database.Migration.Development.User.Data.Users +import qualified Wizard.Database.Migration.Development.User.UserMigration as U +import Wizard.Model.Config.ServerConfig +import Wizard.Model.Context.AppContext +import Wizard.Model.Project.Project +import Wizard.Service.Project.Event.ProjectEventMapper + +import Wizard.Specs.API.Common +import Wizard.Specs.Common +import Wizard.Specs.Websocket.Common +import Wizard.Specs.Websocket.Project.Detail.Common + +setReplySpec appContext = + describe "setReply" $ do + test200 appContext + test403 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test200 appContext = + it "WS 200 OK" $ + -- GIVEN: Prepare database + do + runInContext U.runMigration appContext + runInContextIO TML_Migration.runMigration appContext + runInContextIO (insertPackage germanyKmPackage) appContext + runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext + runInContextIO (insertProject project10) appContext + runInContextIO (insertProject project7) appContext + -- AND: Connect to websocket + ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext project10.uuid + ((c4, s4), (c5, s5), (c6, s6)) <- connectTestWebsocketUsers appContext project7.uuid + -- WHEN: + write_SetReply c1 (toEventChangeDTO (sre_rQ1Updated' project10Uuid)) + -- THEN: + read_SetReply c1 (toEventDTO (sre_rQ1Updated' project10Uuid) (Just userAlbert)) + read_SetReply c2 (toEventDTO (sre_rQ1Updated' project10Uuid) (Just userAlbert)) + read_SetReply c3 (toEventDTO (sre_rQ1Updated' project10Uuid) (Just userAlbert)) + nothingWasReceived c4 + nothingWasReceived c5 + nothingWasReceived c6 + -- AND: Close sockets + closeSockets [s1, s2, s3, s4, s5, s6] + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test403 appContext = do + create_403_no_perm + "WS 403 FORBIDDEN - no required edit entity permission (Anonymous, VisibleView)" + appContext + project5 + Nothing + "Edit Project" + create_403_no_perm + "WS 403 FORBIDDEN - no required edit entity permission (Non-owner, VisibleView)" + appContext + project5 + (Just reqNonAdminAuthToken) + "Edit Project" + +create_403_no_perm title appContext project authToken errorMessage = + it title $ + -- GIVEN: Prepare database + do + insertProjectAndUsers appContext project + -- AND: Prepare expectation + let expError = ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN errorMessage + -- AND: Connect to websocket + (c1, s1) <- createConnection appContext (reqUrlT project.uuid authToken) + read_SetUserList c1 0 + -- WHEN: Send setReply + write_SetReply c1 (toEventChangeDTO (sre_rQ1Updated' project.uuid)) + -- THEN: Read response + read_Error c1 expError + -- AND: Close sockets + closeSockets [s1] + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +write_SetReply connection replyDto = do + let reqDto = SetContent_ClientProjectMessageDTO replyDto + sendMessage connection reqDto + +read_SetReply connection expReplyDto = do + resDto <- receiveData connection + let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerProjectMessageDTO) + let (Right (Success_ServerActionDTO (SetContent_ServerProjectMessageDTO replyDto))) = eResult + expReplyDto `shouldBe` replyDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/WebsocketSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/WebsocketSpec.hs new file mode 100644 index 000000000..05abe30d6 --- /dev/null +++ b/wizard-server/test/Wizard/Specs/Websocket/Project/Detail/WebsocketSpec.hs @@ -0,0 +1,36 @@ +module Wizard.Specs.Websocket.Project.Detail.WebsocketSpec where + +import Test.Hspec hiding (shouldBe) + +import Wizard.Model.Context.AppContext + +import Wizard.Specs.Websocket.Project.Detail.AddCommentSpec +import Wizard.Specs.Websocket.Project.Detail.AssignCommentThreadSpec +import Wizard.Specs.Websocket.Project.Detail.ClearReplySpec +import Wizard.Specs.Websocket.Project.Detail.DeleteCommentSpec +import Wizard.Specs.Websocket.Project.Detail.DeleteCommentThreadSpec +import Wizard.Specs.Websocket.Project.Detail.EditCommentSpec +import Wizard.Specs.Websocket.Project.Detail.GeneralSpec +import Wizard.Specs.Websocket.Project.Detail.ReopenCommentThreadSpec +import Wizard.Specs.Websocket.Project.Detail.ResolveCommentThreadSpec +import Wizard.Specs.Websocket.Project.Detail.SetLabelsSpec +import Wizard.Specs.Websocket.Project.Detail.SetPhaseSpec +import Wizard.Specs.Websocket.Project.Detail.SetProjectSpec +import Wizard.Specs.Websocket.Project.Detail.SetReplySpec + +projectWebsocketAPI :: AppContext -> SpecWith () +projectWebsocketAPI appContext = + describe "WS /wizard-api/projects/{projectUuid}/websocket" $ do + generalSpec appContext + setReplySpec appContext + clearReplySpec appContext + setPhaseSpec appContext + setLabelsSpec appContext + resolveCommentThreadSpec appContext + reopenCommentThreadSpec appContext + assignCommentThreadSpec appContext + deleteCommentThreadSpec appContext + addCommentSpec appContext + editCommentSpec appContext + deleteCommentSpec appContext + setProjectSpec appContext diff --git a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/AddCommentSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/AddCommentSpec.hs deleted file mode 100644 index 640ebab60..000000000 --- a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/AddCommentSpec.hs +++ /dev/null @@ -1,67 +0,0 @@ -module Wizard.Specs.Websocket.Questionnaire.Detail.AddCommentSpec where - -import Data.Aeson -import Data.Foldable (traverse_) -import Network.WebSockets -import Test.Hspec hiding (shouldBe) -import Test.Hspec.Expectations.Pretty - -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Api.Resource.Websocket.QuestionnaireActionDTO -import Wizard.Api.Resource.Websocket.WebsocketActionDTO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Questionnaire.Questionnaire - -import Wizard.Specs.Common -import Wizard.Specs.Websocket.Common -import Wizard.Specs.Websocket.Questionnaire.Detail.Common - -addCommentSpec appContext = describe "addComment" $ test200 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test200 appContext = - it "WS 200 OK" $ - -- GIVEN: Prepare database - do - let qtn = questionnaire10 - runInContext U.runMigration appContext - runInContextIO TML_Migration.runMigration appContext - runInContextIO (insertPackage germanyKmPackage) appContext - runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - runInContextIO (insertQuestionnaire questionnaire10) appContext - runInContextIO (insertQuestionnaire questionnaire7) appContext - -- AND: Connect to websocket - ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext questionnaire10.uuid - ((c4, s4), (c5, s5), (c6, s6)) <- connectTestWebsocketUsers appContext questionnaire7.uuid - -- WHEN: - write_AddComment c1 acche_rQ2_t1_1' - -- THEN: - read_AddComment c1 ace_rQ2_t1_1' - read_AddComment c2 ace_rQ2_t1_1' - read_AddComment c3 ace_rQ2_t1_1' - nothingWasReceived c4 - nothingWasReceived c5 - nothingWasReceived c6 - -- AND: Close sockets - closeSockets [s1, s2, s3, s4, s5, s6] - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -write_AddComment connection replyDto = do - let reqDto = SetContent_ClientQuestionnaireActionDTO replyDto - sendMessage connection reqDto - -read_AddComment connection expReplyDto = do - resDto <- receiveData connection - let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerQuestionnaireActionDTO) - let (Right (Success_ServerActionDTO (SetContent_ServerQuestionnaireActionDTO replyDto))) = eResult - expReplyDto `shouldBe` replyDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/AssignCommentThreadSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/AssignCommentThreadSpec.hs deleted file mode 100644 index da04ed454..000000000 --- a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/AssignCommentThreadSpec.hs +++ /dev/null @@ -1,67 +0,0 @@ -module Wizard.Specs.Websocket.Questionnaire.Detail.AssignCommentThreadSpec where - -import Data.Aeson -import Data.Foldable (traverse_) -import Network.WebSockets -import Test.Hspec hiding (shouldBe) -import Test.Hspec.Expectations.Pretty - -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Api.Resource.Websocket.QuestionnaireActionDTO -import Wizard.Api.Resource.Websocket.WebsocketActionDTO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Questionnaire.Questionnaire - -import Wizard.Specs.Common -import Wizard.Specs.Websocket.Common -import Wizard.Specs.Websocket.Questionnaire.Detail.Common - -assignCommentThreadSpec appContext = describe "assignCommentThread" $ test200 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test200 appContext = - it "WS 200 OK" $ - -- GIVEN: Prepare database - do - let qtn = questionnaire10 - runInContext U.runMigration appContext - runInContextIO TML_Migration.runMigration appContext - runInContextIO (insertPackage germanyKmPackage) appContext - runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - runInContextIO (insertQuestionnaire questionnaire10) appContext - runInContextIO (insertQuestionnaire questionnaire7) appContext - -- AND: Connect to websocket - ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext questionnaire10.uuid - ((c4, s4), (c5, s5), (c6, s6)) <- connectTestWebsocketUsers appContext questionnaire7.uuid - -- WHEN: - write_AssignCommentThread c1 asche_rQ1_t1' - -- THEN: - read_AssignCommentThread c1 aste_rQ1_t1' - read_AssignCommentThread c2 aste_rQ1_t1' - read_AssignCommentThread c3 aste_rQ1_t1' - nothingWasReceived c4 - nothingWasReceived c5 - nothingWasReceived c6 - -- AND: Close sockets - closeSockets [s1, s2, s3, s4, s5, s6] - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -write_AssignCommentThread connection replyDto = do - let reqDto = SetContent_ClientQuestionnaireActionDTO replyDto - sendMessage connection reqDto - -read_AssignCommentThread connection expReplyDto = do - resDto <- receiveData connection - let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerQuestionnaireActionDTO) - let (Right (Success_ServerActionDTO (SetContent_ServerQuestionnaireActionDTO replyDto))) = eResult - expReplyDto `shouldBe` replyDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/ClearReplySpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/ClearReplySpec.hs deleted file mode 100644 index de0c3202e..000000000 --- a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/ClearReplySpec.hs +++ /dev/null @@ -1,69 +0,0 @@ -module Wizard.Specs.Websocket.Questionnaire.Detail.ClearReplySpec where - -import Data.Aeson -import Data.Foldable (traverse_) -import Network.WebSockets -import Test.Hspec hiding (shouldBe) -import Test.Hspec.Expectations.Pretty - -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Api.Resource.Websocket.QuestionnaireActionDTO -import Wizard.Api.Resource.Websocket.WebsocketActionDTO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Database.Migration.Development.User.Data.Users -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Service.Questionnaire.Event.QuestionnaireEventMapper - -import Wizard.Specs.Common -import Wizard.Specs.Websocket.Common -import Wizard.Specs.Websocket.Questionnaire.Detail.Common - -clearReplySpec appContext = describe "clearReply" $ test200 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test200 appContext = - it "WS 200 OK" $ - -- GIVEN: Prepare database - do - let qtn = questionnaire10 - runInContext U.runMigration appContext - runInContextIO TML_Migration.runMigration appContext - runInContextIO (insertPackage germanyKmPackage) appContext - runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - runInContextIO (insertQuestionnaire questionnaire10) appContext - runInContextIO (insertQuestionnaire questionnaire7) appContext - -- AND: Connect to websocket - ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext questionnaire10.uuid - ((c4, s4), (c5, s5), (c6, s6)) <- connectTestWebsocketUsers appContext questionnaire7.uuid - -- WHEN: - write_ClearReply c1 (toEventChangeDTO (cre_rQ1' questionnaire10Uuid)) - -- THEN: - read_ClearReply c1 (toEventDTO (cre_rQ1' questionnaire10Uuid) (Just userAlbert)) - read_ClearReply c2 (toEventDTO (cre_rQ1' questionnaire10Uuid) (Just userAlbert)) - read_ClearReply c3 (toEventDTO (cre_rQ1' questionnaire10Uuid) (Just userAlbert)) - nothingWasReceived c4 - nothingWasReceived c5 - nothingWasReceived c6 - -- AND: Close sockets - closeSockets [s1, s2, s3, s4, s5, s6] - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -write_ClearReply connection replyDto = do - let reqDto = SetContent_ClientQuestionnaireActionDTO replyDto - sendMessage connection reqDto - -read_ClearReply connection expReplyDto = do - resDto <- receiveData connection - let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerQuestionnaireActionDTO) - let (Right (Success_ServerActionDTO (SetContent_ServerQuestionnaireActionDTO replyDto))) = eResult - expReplyDto `shouldBe` replyDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/Common.hs b/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/Common.hs deleted file mode 100644 index 6ef1386be..000000000 --- a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/Common.hs +++ /dev/null @@ -1,153 +0,0 @@ -module Wizard.Specs.Websocket.Questionnaire.Detail.Common where - -import qualified Control.Exception.Base as E -import Data.Aeson -import qualified Data.ByteString.Lazy.Char8 as BSL -import Data.Foldable (traverse_) -import qualified Data.Map.Strict as M -import qualified Data.UUID as U -import qualified Network.HTTP.Client as HC -import Network.WebSockets -import qualified Network.Wreq as W -import qualified Network.Wreq.Types as WT -import System.Timeout -import Test.Hspec.Expectations.Pretty - -import Shared.Common.Integration.Http.Common.HttpClient (mapHeader) -import Shared.Common.Integration.Http.Common.HttpClientFactory -import Shared.Common.Model.Http.HttpRequest -import Shared.Common.Util.JSON -import Shared.Common.Util.String -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Api.Resource.Websocket.QuestionnaireActionDTO -import Wizard.Api.Resource.Websocket.WebsocketActionDTO -import Wizard.Cache.QuestionnaireWebsocketCache -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Config.ServerConfig -import Wizard.Model.Context.AppContext -import Wizard.Model.Websocket.WebsocketRecord -import Wizard.Service.Questionnaire.Collaboration.CollaborationService - -import Wizard.Specs.API.Common -import Wizard.Specs.Common -import Wizard.Specs.Websocket.Common - --- -------------------------------- --- ASSERTS --- -------------------------------- -assertCountOfWebsocketConnection appContext expCount = do - (Right resCount) <- runInContext countCache appContext - resCount `shouldBe` expCount - --- -------------------------------- --- URL --- -------------------------------- -reqUrlT qtnUuid mUser = - let suffix = - case mUser of - Just user -> "?Authorization=Bearer%20" ++ user - Nothing -> "" - in f' "/wizard-api/questionnaires/%s/websocket%s" [U.toString qtnUuid, suffix] - --- -------------------------------- --- DATABASE --- -------------------------------- -insertQuestionnaireAndUsers appContext qtn = - -- Prepare DB - do - runInContext U.runMigration appContext - runInContextIO TML_Migration.runMigration appContext - runInContextIO (insertPackage germanyKmPackage) appContext - runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - runInContextIO (insertQuestionnaire qtn) appContext - --- -------------------------------- --- CONNECT --- -------------------------------- -connectTestWebsocketUsers appContext qtnUuid = - -- Clear websockets - do - clearConnections appContext qtnUuid - -- Connect 1. user - (c1, s1) <- createConnection appContext (reqUrlT qtnUuid (Just reqAuthToken)) - read_SetUserList c1 0 - -- Connect 2. user - (c2, s2) <- createConnection appContext (reqUrlT qtnUuid (Just reqNonAdminAuthToken)) - read_SetUserList c1 1 - read_SetUserList c2 1 - -- Connect 3. user - (c3, s3) <- createConnection appContext (reqUrlT qtnUuid Nothing) - read_SetUserList c1 2 - read_SetUserList c2 2 - read_SetUserList c3 2 - return ((c1, s1), (c2, s2), (c3, s3)) - -read_SetUserList connection expConnectionCount = do - resDto <- receiveData connection - let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerQuestionnaireActionDTO) - let (Right (Success_ServerActionDTO (SetUserList_ServerQuestionnaireActionDTO resConnection))) = eResult - length resConnection `shouldBe` expConnectionCount - -read_Error connection expError = do - resDto <- receiveData connection - let eResult = eitherDecode resDto :: Either String Error_ServerActionDTO - let (Right (Error_ServerActionDTO error)) = eResult - error `shouldBe` expError - -read_SetUserList_or_Error connection expError = do - resDto <- receiveData connection - let (Right result) = eitherDecode resDto :: Either String Object - let resultType = getField "type" result return - case resultType of - (Right "Success_ServerAction") -> read_Error connection expError - (Right "Error_ServerAction") -> do - let eResult = eitherDecode resDto :: Either String Error_ServerActionDTO - let (Right (Error_ServerActionDTO error)) = eResult - error `shouldBe` expError - rest -> print rest - -nothingWasReceived connection = do - maybeResDto <- timeout 1000 (receive connection) - maybeResDto `shouldBe` Nothing - --- -------------------------------- --- DISCONNECT --- -------------------------------- -clearConnections :: AppContext -> U.UUID -> IO () -clearConnections appContext qtnUuid = do - (Right records) <- runInContext getAllFromCache appContext - traverse_ (clearConnection appContext qtnUuid) . filter (\r -> r.entityId == U.toString qtnUuid) $ records - -clearConnection :: AppContext -> U.UUID -> WebsocketRecord -> IO () -clearConnection appContext qtnUuid record = do - runInContext (deleteUser qtnUuid record.connectionUuid) appContext - return () - --- -------------------------------- --- HTTP Client --- -------------------------------- -runSimpleRequest :: AppContext -> HttpRequest -> IO (Either E.SomeException (HC.Response BSL.ByteString)) -runSimpleRequest appContext req = do - httpClientManager <- createHttpClientManager appContext.serverConfig.logging - let opts = - W.defaults - { WT.manager = Right httpClientManager - , WT.headers = reqHeaders - , WT.checkResponse = Just (\_ _ -> return ()) - } - E.try . action $ opts - where - reqMethod = req.requestMethod - host = - if appContext.serverConfig.general.serverPort == 80 - then "localhost" - else "localhost:" ++ show appContext.serverConfig.general.serverPort - reqUrl = f' "http://%s/%s" [host, req.requestUrl] - reqHeaders = mapHeader <$> M.toList req.requestHeaders - action opts - | reqMethod == "GET" = W.getWith opts reqUrl - | otherwise = W.customPayloadMethodWith reqMethod opts reqUrl req.requestBody diff --git a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/DeleteCommentSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/DeleteCommentSpec.hs deleted file mode 100644 index 6db313dad..000000000 --- a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/DeleteCommentSpec.hs +++ /dev/null @@ -1,67 +0,0 @@ -module Wizard.Specs.Websocket.Questionnaire.Detail.DeleteCommentSpec where - -import Data.Aeson -import Data.Foldable (traverse_) -import Network.WebSockets -import Test.Hspec hiding (shouldBe) -import Test.Hspec.Expectations.Pretty - -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Api.Resource.Websocket.QuestionnaireActionDTO -import Wizard.Api.Resource.Websocket.WebsocketActionDTO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Questionnaire.Questionnaire - -import Wizard.Specs.Common -import Wizard.Specs.Websocket.Common -import Wizard.Specs.Websocket.Questionnaire.Detail.Common - -deleteCommentSpec appContext = describe "deleteComment" $ test200 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test200 appContext = - it "WS 200 OK" $ - -- GIVEN: Prepare database - do - let qtn = questionnaire10 - runInContext U.runMigration appContext - runInContextIO TML_Migration.runMigration appContext - runInContextIO (insertPackage germanyKmPackage) appContext - runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - runInContextIO (insertQuestionnaire questionnaire10) appContext - runInContextIO (insertQuestionnaire questionnaire7) appContext - -- AND: Connect to websocket - ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext questionnaire10.uuid - ((c4, s4), (c5, s5), (c6, s6)) <- connectTestWebsocketUsers appContext questionnaire7.uuid - -- WHEN: - write_DeleteComment c1 dcche_rQ1_t1_1' - -- THEN: - read_DeleteComment c1 dce_rQ1_t1_1' - read_DeleteComment c2 dce_rQ1_t1_1' - read_DeleteComment c3 dce_rQ1_t1_1' - nothingWasReceived c4 - nothingWasReceived c5 - nothingWasReceived c6 - -- AND: Close sockets - closeSockets [s1, s2, s3, s4, s5, s6] - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -write_DeleteComment connection replyDto = do - let reqDto = SetContent_ClientQuestionnaireActionDTO replyDto - sendMessage connection reqDto - -read_DeleteComment connection expReplyDto = do - resDto <- receiveData connection - let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerQuestionnaireActionDTO) - let (Right (Success_ServerActionDTO (SetContent_ServerQuestionnaireActionDTO replyDto))) = eResult - expReplyDto `shouldBe` replyDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/DeleteCommentThreadSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/DeleteCommentThreadSpec.hs deleted file mode 100644 index cfcb10c39..000000000 --- a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/DeleteCommentThreadSpec.hs +++ /dev/null @@ -1,67 +0,0 @@ -module Wizard.Specs.Websocket.Questionnaire.Detail.DeleteCommentThreadSpec where - -import Data.Aeson -import Data.Foldable (traverse_) -import Network.WebSockets -import Test.Hspec hiding (shouldBe) -import Test.Hspec.Expectations.Pretty - -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Api.Resource.Websocket.QuestionnaireActionDTO -import Wizard.Api.Resource.Websocket.WebsocketActionDTO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Questionnaire.Questionnaire - -import Wizard.Specs.Common -import Wizard.Specs.Websocket.Common -import Wizard.Specs.Websocket.Questionnaire.Detail.Common - -deleteCommentThreadSpec appContext = describe "deleteCommentThread" $ test200 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test200 appContext = - it "WS 200 OK" $ - -- GIVEN: Prepare database - do - let qtn = questionnaire10 - runInContext U.runMigration appContext - runInContextIO TML_Migration.runMigration appContext - runInContextIO (insertPackage germanyKmPackage) appContext - runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - runInContextIO (insertQuestionnaire questionnaire10) appContext - runInContextIO (insertQuestionnaire questionnaire7) appContext - -- AND: Connect to websocket - ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext questionnaire10.uuid - ((c4, s4), (c5, s5), (c6, s6)) <- connectTestWebsocketUsers appContext questionnaire7.uuid - -- WHEN: - write_DeleteCommentThread c1 dtche_rQ1_t1' - -- THEN: - read_DeleteCommentThread c1 dte_rQ1_t1' - read_DeleteCommentThread c2 dte_rQ1_t1' - read_DeleteCommentThread c3 dte_rQ1_t1' - nothingWasReceived c4 - nothingWasReceived c5 - nothingWasReceived c6 - -- AND: Close sockets - closeSockets [s1, s2, s3, s4, s5, s6] - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -write_DeleteCommentThread connection replyDto = do - let reqDto = SetContent_ClientQuestionnaireActionDTO replyDto - sendMessage connection reqDto - -read_DeleteCommentThread connection expReplyDto = do - resDto <- receiveData connection - let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerQuestionnaireActionDTO) - let (Right (Success_ServerActionDTO (SetContent_ServerQuestionnaireActionDTO replyDto))) = eResult - expReplyDto `shouldBe` replyDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/EditCommentSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/EditCommentSpec.hs deleted file mode 100644 index 4975bb123..000000000 --- a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/EditCommentSpec.hs +++ /dev/null @@ -1,67 +0,0 @@ -module Wizard.Specs.Websocket.Questionnaire.Detail.EditCommentSpec where - -import Data.Aeson -import Data.Foldable (traverse_) -import Network.WebSockets -import Test.Hspec hiding (shouldBe) -import Test.Hspec.Expectations.Pretty - -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Api.Resource.Websocket.QuestionnaireActionDTO -import Wizard.Api.Resource.Websocket.WebsocketActionDTO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Questionnaire.Questionnaire - -import Wizard.Specs.Common -import Wizard.Specs.Websocket.Common -import Wizard.Specs.Websocket.Questionnaire.Detail.Common - -editCommentSpec appContext = describe "editComment" $ test200 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test200 appContext = - it "WS 200 OK" $ - -- GIVEN: Prepare database - do - let qtn = questionnaire10 - runInContext U.runMigration appContext - runInContextIO TML_Migration.runMigration appContext - runInContextIO (insertPackage germanyKmPackage) appContext - runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - runInContextIO (insertQuestionnaire questionnaire10) appContext - runInContextIO (insertQuestionnaire questionnaire7) appContext - -- AND: Connect to websocket - ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext questionnaire10.uuid - ((c4, s4), (c5, s5), (c6, s6)) <- connectTestWebsocketUsers appContext questionnaire7.uuid - -- WHEN: - write_EditComment c1 ecche_rQ1_t1_1' - -- THEN: - read_EditComment c1 ece_rQ1_t1_1' - read_EditComment c2 ece_rQ1_t1_1' - read_EditComment c3 ece_rQ1_t1_1' - nothingWasReceived c4 - nothingWasReceived c5 - nothingWasReceived c6 - -- AND: Close sockets - closeSockets [s1, s2, s3, s4, s5, s6] - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -write_EditComment connection replyDto = do - let reqDto = SetContent_ClientQuestionnaireActionDTO replyDto - sendMessage connection reqDto - -read_EditComment connection expReplyDto = do - resDto <- receiveData connection - let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerQuestionnaireActionDTO) - let (Right (Success_ServerActionDTO (SetContent_ServerQuestionnaireActionDTO replyDto))) = eResult - expReplyDto `shouldBe` replyDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/GeneralSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/GeneralSpec.hs deleted file mode 100644 index c393a9917..000000000 --- a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/GeneralSpec.hs +++ /dev/null @@ -1,133 +0,0 @@ -module Wizard.Specs.Websocket.Questionnaire.Detail.GeneralSpec where - -import qualified Data.UUID as U -import Test.Hspec hiding (shouldBe) - -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Shared.Common.Util.Uuid -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Database.Migration.Development.Tenant.Data.Tenants -import Wizard.Localization.Messages.Public -import Wizard.Model.Config.ServerConfig -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Tenant.Tenant -import Wizard.Service.Questionnaire.QuestionnaireMapper -import Wizard.Service.Questionnaire.QuestionnaireService - -import Wizard.Specs.API.Common -import Wizard.Specs.Common -import Wizard.Specs.Websocket.Common -import Wizard.Specs.Websocket.Questionnaire.Detail.Common - -generalSpec appContext = - describe "general" $ do - test200 appContext - test403 appContext - test404 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test200 appContext = - it "WS 200 OK" $ - -- GIVEN: Prepare database - do - let qtn = questionnaire10 - insertQuestionnaireAndUsers appContext qtn - -- WHEN - ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext qtn.uuid - -- THEN: - assertCountOfWebsocketConnection appContext 3 - -- AND: Close sockets - closeSockets [s1, s2, s3] - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test403 appContext = do - create_403_no_perm - "WS 403 FORBIDDEN - no required view entity permission (Anonymous, Private)" - appContext - questionnaire1 - Nothing - "View Questionnaire" - create_403_no_perm - "WS 403 FORBIDDEN - no required view entity permission (Non-owner, Private)" - appContext - questionnaire1 - (Just reqNonAdminAuthToken) - "View Questionnaire" - it "WS 403 FORBIDDEN - when perms are changed" $ - -- GIVEN: Prepare database - do - let qtn = questionnaire10 - insertQuestionnaireAndUsers appContext qtn - let updatedQtn = qtn {visibility = PrivateQuestionnaire, sharing = RestrictedQuestionnaire} - -- AND: Connect to websocket - ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext qtn.uuid - -- AND: Prepare expectation - let expError = ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN "View Questionnaire" - -- WHEN: Update permission - runInContext (modifyQuestionnaireShare updatedQtn.uuid (toChangeDTO updatedQtn)) appContext - -- THEN: Read response - read_SetUserList c1 1 - read_SetUserList c1 0 - read_SetUserList_or_Error c2 expError - read_SetUserList_or_Error c3 expError - -- AND: Close sockets - closeSockets [s1, s2, s3] - -create_403_no_perm title appContext qtn authToken errorMessage = - it title $ - -- GIVEN: Prepare database - do - insertQuestionnaireAndUsers appContext qtn - -- AND: Prepare expectation - let expError = ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN errorMessage - -- WHEN: Connect to websocket - (c1, s1) <- createConnection appContext (reqUrlT qtn.uuid authToken) - -- THEN: Read response - read_Error c1 expError - -- AND: Close sockets - closeSockets [s1] - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test404 appContext = do - it "WS 404 NOT FOUND - non existing entity" $ - -- GIVEN: Prepare request - do - let nonExistingQtnUuid = "fd5ea37c-852a-4174-9d65-2bf23202541d" - -- AND: Prepare expectation - let expError = - NotExistsError - ( _ERROR_DATABASE__ENTITY_NOT_FOUND - "questionnaire" - [("tenant_uuid", U.toString defaultTenant.uuid), ("uuid", nonExistingQtnUuid)] - ) - -- WHEN: - (c1, s1) <- createConnection appContext (reqUrlT (u' nonExistingQtnUuid) (Just reqAuthToken)) - -- THEN: - read_Error c1 expError - -- AND: Close sockets - closeSockets [s1] - it "WS 404 NOT FOUND - questionnaire was deleted" $ - -- GIVEN: Prepare database - do - let qtn = questionnaire10 - insertQuestionnaireAndUsers appContext qtn - -- AND: Connect to websocket - ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext qtn.uuid - -- AND: Prepare expectation - let expError = NotExistsError (_ERROR_SERVICE_QTN_COLLABORATION__FORCE_DISCONNECT (U.toString $ qtn.uuid)) - -- WHEN: Update permission - runInContext (deleteQuestionnaire qtn.uuid True) appContext - -- THEN: Read response - read_Error c1 expError - read_Error c2 expError - read_Error c3 expError - -- AND: Close sockets - closeSockets [s1, s2, s3] diff --git a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/ReopenCommentThreadSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/ReopenCommentThreadSpec.hs deleted file mode 100644 index f4a6cb879..000000000 --- a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/ReopenCommentThreadSpec.hs +++ /dev/null @@ -1,67 +0,0 @@ -module Wizard.Specs.Websocket.Questionnaire.Detail.ReopenCommentThreadSpec where - -import Data.Aeson -import Data.Foldable (traverse_) -import Network.WebSockets -import Test.Hspec hiding (shouldBe) -import Test.Hspec.Expectations.Pretty - -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Api.Resource.Websocket.QuestionnaireActionDTO -import Wizard.Api.Resource.Websocket.WebsocketActionDTO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Questionnaire.Questionnaire - -import Wizard.Specs.Common -import Wizard.Specs.Websocket.Common -import Wizard.Specs.Websocket.Questionnaire.Detail.Common - -reopenCommentThreadSpec appContext = describe "reopenCommentThread" $ test200 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test200 appContext = - it "WS 200 OK" $ - -- GIVEN: Prepare database - do - let qtn = questionnaire10 - runInContext U.runMigration appContext - runInContextIO TML_Migration.runMigration appContext - runInContextIO (insertPackage germanyKmPackage) appContext - runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - runInContextIO (insertQuestionnaire questionnaire10) appContext - runInContextIO (insertQuestionnaire questionnaire7) appContext - -- AND: Connect to websocket - ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext questionnaire10.uuid - ((c4, s4), (c5, s5), (c6, s6)) <- connectTestWebsocketUsers appContext questionnaire7.uuid - -- WHEN: - write_ReopenCommentThread c1 otche_rQ1_t1' - -- THEN: - read_ReopenCommentThread c1 ote_rQ1_t1' - read_ReopenCommentThread c2 ote_rQ1_t1' - read_ReopenCommentThread c3 ote_rQ1_t1' - nothingWasReceived c4 - nothingWasReceived c5 - nothingWasReceived c6 - -- AND: Close sockets - closeSockets [s1, s2, s3, s4, s5, s6] - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -write_ReopenCommentThread connection replyDto = do - let reqDto = SetContent_ClientQuestionnaireActionDTO replyDto - sendMessage connection reqDto - -read_ReopenCommentThread connection expReplyDto = do - resDto <- receiveData connection - let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerQuestionnaireActionDTO) - let (Right (Success_ServerActionDTO (SetContent_ServerQuestionnaireActionDTO replyDto))) = eResult - expReplyDto `shouldBe` replyDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/ResolveCommentThreadSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/ResolveCommentThreadSpec.hs deleted file mode 100644 index dd1b3af94..000000000 --- a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/ResolveCommentThreadSpec.hs +++ /dev/null @@ -1,67 +0,0 @@ -module Wizard.Specs.Websocket.Questionnaire.Detail.ResolveCommentThreadSpec where - -import Data.Aeson -import Data.Foldable (traverse_) -import Network.WebSockets -import Test.Hspec hiding (shouldBe) -import Test.Hspec.Expectations.Pretty - -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Api.Resource.Websocket.QuestionnaireActionDTO -import Wizard.Api.Resource.Websocket.WebsocketActionDTO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Questionnaire.Questionnaire - -import Wizard.Specs.Common -import Wizard.Specs.Websocket.Common -import Wizard.Specs.Websocket.Questionnaire.Detail.Common - -resolveCommentThreadSpec appContext = describe "resolveCommentThread" $ test200 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test200 appContext = - it "WS 200 OK" $ - -- GIVEN: Prepare database - do - let qtn = questionnaire10 - runInContext U.runMigration appContext - runInContextIO TML_Migration.runMigration appContext - runInContextIO (insertPackage germanyKmPackage) appContext - runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - runInContextIO (insertQuestionnaire questionnaire10) appContext - runInContextIO (insertQuestionnaire questionnaire7) appContext - -- AND: Connect to websocket - ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext questionnaire10.uuid - ((c4, s4), (c5, s5), (c6, s6)) <- connectTestWebsocketUsers appContext questionnaire7.uuid - -- WHEN: - write_ResolveCommentThread c1 rtche_rQ1_t1' - -- THEN: - read_ResolveCommentThread c1 rte_rQ1_t1' - read_ResolveCommentThread c2 rte_rQ1_t1' - read_ResolveCommentThread c3 rte_rQ1_t1' - nothingWasReceived c4 - nothingWasReceived c5 - nothingWasReceived c6 - -- AND: Close sockets - closeSockets [s1, s2, s3, s4, s5, s6] - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -write_ResolveCommentThread connection replyDto = do - let reqDto = SetContent_ClientQuestionnaireActionDTO replyDto - sendMessage connection reqDto - -read_ResolveCommentThread connection expReplyDto = do - resDto <- receiveData connection - let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerQuestionnaireActionDTO) - let (Right (Success_ServerActionDTO (SetContent_ServerQuestionnaireActionDTO replyDto))) = eResult - expReplyDto `shouldBe` replyDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/SetLabelsSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/SetLabelsSpec.hs deleted file mode 100644 index ef97d14ea..000000000 --- a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/SetLabelsSpec.hs +++ /dev/null @@ -1,69 +0,0 @@ -module Wizard.Specs.Websocket.Questionnaire.Detail.SetLabelsSpec where - -import Data.Aeson -import Data.Foldable (traverse_) -import Network.WebSockets -import Test.Hspec hiding (shouldBe) -import Test.Hspec.Expectations.Pretty - -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Api.Resource.Websocket.QuestionnaireActionDTO -import Wizard.Api.Resource.Websocket.WebsocketActionDTO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Database.Migration.Development.User.Data.Users -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Service.Questionnaire.Event.QuestionnaireEventMapper - -import Wizard.Specs.Common -import Wizard.Specs.Websocket.Common -import Wizard.Specs.Websocket.Questionnaire.Detail.Common - -setLabelsSpec appContext = describe "setLabels" $ test200 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test200 appContext = - it "WS 200 OK" $ - -- GIVEN: Prepare database - do - let qtn = questionnaire10 - runInContext U.runMigration appContext - runInContextIO TML_Migration.runMigration appContext - runInContextIO (insertPackage germanyKmPackage) appContext - runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - runInContextIO (insertQuestionnaire questionnaire10) appContext - runInContextIO (insertQuestionnaire questionnaire7) appContext - -- AND: Connect to websocket - ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext questionnaire10.uuid - ((c4, s4), (c5, s5), (c6, s6)) <- connectTestWebsocketUsers appContext questionnaire7.uuid - -- WHEN: - write_SetLabels c1 (toEventChangeDTO (slble_rQ1' questionnaire10Uuid)) - -- THEN: - read_SetLabels c1 (toEventDTO (slble_rQ1' questionnaire10Uuid) (Just userAlbert)) - read_SetLabels c2 (toEventDTO (slble_rQ1' questionnaire10Uuid) (Just userAlbert)) - read_SetLabels c3 (toEventDTO (slble_rQ1' questionnaire10Uuid) (Just userAlbert)) - nothingWasReceived c4 - nothingWasReceived c5 - nothingWasReceived c6 - -- AND: Close sockets - closeSockets [s1, s2, s3, s4, s5, s6] - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -write_SetLabels connection replyDto = do - let reqDto = SetContent_ClientQuestionnaireActionDTO replyDto - sendMessage connection reqDto - -read_SetLabels connection expReplyDto = do - resDto <- receiveData connection - let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerQuestionnaireActionDTO) - let (Right (Success_ServerActionDTO (SetContent_ServerQuestionnaireActionDTO replyDto))) = eResult - expReplyDto `shouldBe` replyDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/SetPhaseSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/SetPhaseSpec.hs deleted file mode 100644 index e11faf6a2..000000000 --- a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/SetPhaseSpec.hs +++ /dev/null @@ -1,69 +0,0 @@ -module Wizard.Specs.Websocket.Questionnaire.Detail.SetPhaseSpec where - -import Data.Aeson -import Data.Foldable (traverse_) -import Network.WebSockets -import Test.Hspec hiding (shouldBe) -import Test.Hspec.Expectations.Pretty - -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Api.Resource.Websocket.QuestionnaireActionDTO -import Wizard.Api.Resource.Websocket.WebsocketActionDTO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Database.Migration.Development.User.Data.Users -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Service.Questionnaire.Event.QuestionnaireEventMapper - -import Wizard.Specs.Common -import Wizard.Specs.Websocket.Common -import Wizard.Specs.Websocket.Questionnaire.Detail.Common - -setPhaseSpec appContext = describe "setPhase" $ test200 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test200 appContext = - it "WS 200 OK" $ - -- GIVEN: Prepare database - do - let qtn = questionnaire10 - runInContext U.runMigration appContext - runInContextIO TML_Migration.runMigration appContext - runInContextIO (insertPackage germanyKmPackage) appContext - runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - runInContextIO (insertQuestionnaire questionnaire10) appContext - runInContextIO (insertQuestionnaire questionnaire7) appContext - -- AND: Connect to websocket - ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext questionnaire10.uuid - ((c4, s4), (c5, s5), (c6, s6)) <- connectTestWebsocketUsers appContext questionnaire7.uuid - -- WHEN: - write_SetPhase c1 (toEventChangeDTO (sphse_2' questionnaire10Uuid)) - -- THEN: - read_SetPhase c1 (toEventDTO (sphse_2' questionnaire10Uuid) (Just userAlbert)) - read_SetPhase c2 (toEventDTO (sphse_2' questionnaire10Uuid) (Just userAlbert)) - read_SetPhase c3 (toEventDTO (sphse_2' questionnaire10Uuid) (Just userAlbert)) - nothingWasReceived c4 - nothingWasReceived c5 - nothingWasReceived c6 - -- AND: Close sockets - closeSockets [s1, s2, s3, s4, s5, s6] - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -write_SetPhase connection replyDto = do - let reqDto = SetContent_ClientQuestionnaireActionDTO replyDto - sendMessage connection reqDto - -read_SetPhase connection expReplyDto = do - resDto <- receiveData connection - let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerQuestionnaireActionDTO) - let (Right (Success_ServerActionDTO (SetContent_ServerQuestionnaireActionDTO replyDto))) = eResult - expReplyDto `shouldBe` replyDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/SetQuestionnaireSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/SetQuestionnaireSpec.hs deleted file mode 100644 index bb8da1f83..000000000 --- a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/SetQuestionnaireSpec.hs +++ /dev/null @@ -1,87 +0,0 @@ -module Wizard.Specs.Websocket.Questionnaire.Detail.SetQuestionnaireSpec where - -import Data.Aeson -import qualified Data.ByteString.Lazy.Char8 as BSL -import Data.Either (isRight) -import Data.Foldable (traverse_) -import qualified Data.Map.Strict as M -import qualified Data.UUID as U -import qualified Network.HTTP.Client as HC -import Network.HTTP.Types.Status (ok200) -import Network.WebSockets -import Test.Hspec hiding (shouldBe) -import Test.Hspec.Expectations.Pretty - -import Shared.Common.Model.Http.HttpRequest -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Api.Resource.Websocket.QuestionnaireActionDTO -import Wizard.Api.Resource.Websocket.WebsocketActionDTO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Questionnaire.Questionnaire - -import Wizard.Specs.API.Common -import Wizard.Specs.Common -import Wizard.Specs.Websocket.Common -import Wizard.Specs.Websocket.Questionnaire.Detail.Common - -setQuestionnaireSpec appContext = - describe "setQuestionnaireSpec" $ - test200 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test200 appContext = - it "WS 200 OK" $ - -- GIVEN: Prepare database - do - let qtn = questionnaire10 - runInContext U.runMigration appContext - runInContextIO TML_Migration.runMigration appContext - runInContextIO (insertPackage germanyKmPackage) appContext - runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - runInContextIO (insertQuestionnaire questionnaire10) appContext - runInContextIO (insertQuestionnaire questionnaire7) appContext - -- AND: Connect to websocket - ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext questionnaire10.uuid - ((c4, s4), (c5, s5), (c6, s6)) <- connectTestWebsocketUsers appContext questionnaire7.uuid - -- AND: Prepare request - let request = - HttpRequest - { requestMethod = "PUT" - , requestUrl = "/wizard-api/questionnaires/" ++ U.toString questionnaire10.uuid ++ "/settings" - , requestHeaders = M.fromList [("Authorization", "Bearer " ++ reqAuthToken), ("Content-Type", "application/json")] - , requestBody = BSL.toStrict . encode $ questionnaire10EditedSettingsChange - , multipart = Nothing - } - -- AND: Prepare expectation - let expStatus = 200 - -- WHEN: - response <- runSimpleRequest appContext request - -- THEN: - isRight response `shouldBe` True - let (Right r) = response - HC.responseStatus r `shouldBe` ok200 - -- AND: - read_SetQuestionnaire c1 questionnaire10EditedWs - read_SetQuestionnaire c2 questionnaire10EditedWs - read_SetQuestionnaire c3 questionnaire10EditedWs - nothingWasReceived c4 - nothingWasReceived c5 - nothingWasReceived c6 - -- AND: Close sockets - closeSockets [s1, s2, s3, s4, s5, s6] - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -read_SetQuestionnaire connection expQtnChangeDto = do - resDto <- receiveData connection - let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerQuestionnaireActionDTO) - let (Right (Success_ServerActionDTO (SetQuestionnaire_ServerQuestionnaireActionDTO qtnChangeDto))) = eResult - expQtnChangeDto `shouldBe` qtnChangeDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/SetReplySpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/SetReplySpec.hs deleted file mode 100644 index 3b970f253..000000000 --- a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/SetReplySpec.hs +++ /dev/null @@ -1,111 +0,0 @@ -module Wizard.Specs.Websocket.Questionnaire.Detail.SetReplySpec where - -import Data.Aeson -import Data.Foldable (traverse_) -import Network.WebSockets -import Test.Hspec hiding (shouldBe) -import Test.Hspec.Expectations.Pretty - -import Shared.Common.Localization.Messages.Public -import Shared.Common.Model.Error.Error -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageDAO -import Shared.KnowledgeModel.Database.DAO.Package.KnowledgeModelPackageEventDAO -import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages -import Wizard.Api.Resource.Websocket.QuestionnaireActionDTO -import Wizard.Api.Resource.Websocket.WebsocketActionDTO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration -import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireEvents -import Wizard.Database.Migration.Development.Questionnaire.Data.Questionnaires -import Wizard.Database.Migration.Development.User.Data.Users -import qualified Wizard.Database.Migration.Development.User.UserMigration as U -import Wizard.Model.Config.ServerConfig -import Wizard.Model.Context.AppContext -import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Service.Questionnaire.Event.QuestionnaireEventMapper - -import Wizard.Specs.API.Common -import Wizard.Specs.Common -import Wizard.Specs.Websocket.Common -import Wizard.Specs.Websocket.Questionnaire.Detail.Common - -setReplySpec appContext = - describe "setReply" $ do - test200 appContext - test403 appContext - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test200 appContext = - it "WS 200 OK" $ - -- GIVEN: Prepare database - do - let qtn = questionnaire10 - runInContext U.runMigration appContext - runInContextIO TML_Migration.runMigration appContext - runInContextIO (insertPackage germanyKmPackage) appContext - runInContextIO (traverse_ insertPackageEvent germanyKmPackageEvents) appContext - runInContextIO (insertQuestionnaire questionnaire10) appContext - runInContextIO (insertQuestionnaire questionnaire7) appContext - -- AND: Connect to websocket - ((c1, s1), (c2, s2), (c3, s3)) <- connectTestWebsocketUsers appContext questionnaire10.uuid - ((c4, s4), (c5, s5), (c6, s6)) <- connectTestWebsocketUsers appContext questionnaire7.uuid - -- WHEN: - write_SetReply c1 (toEventChangeDTO (sre_rQ1Updated' questionnaire10Uuid)) - -- THEN: - read_SetReply c1 (toEventDTO (sre_rQ1Updated' questionnaire10Uuid) (Just userAlbert)) - read_SetReply c2 (toEventDTO (sre_rQ1Updated' questionnaire10Uuid) (Just userAlbert)) - read_SetReply c3 (toEventDTO (sre_rQ1Updated' questionnaire10Uuid) (Just userAlbert)) - nothingWasReceived c4 - nothingWasReceived c5 - nothingWasReceived c6 - -- AND: Close sockets - closeSockets [s1, s2, s3, s4, s5, s6] - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -test403 appContext = do - create_403_no_perm - "WS 403 FORBIDDEN - no required edit entity permission (Anonymous, VisibleView)" - appContext - questionnaire5 - Nothing - "Edit Questionnaire" - create_403_no_perm - "WS 403 FORBIDDEN - no required edit entity permission (Non-owner, VisibleView)" - appContext - questionnaire5 - (Just reqNonAdminAuthToken) - "Edit Questionnaire" - -create_403_no_perm title appContext qtn authToken errorMessage = - it title $ - -- GIVEN: Prepare database - do - insertQuestionnaireAndUsers appContext qtn - -- AND: Prepare expectation - let expError = ForbiddenError $ _ERROR_VALIDATION__FORBIDDEN errorMessage - -- AND: Connect to websocket - (c1, s1) <- createConnection appContext (reqUrlT qtn.uuid authToken) - read_SetUserList c1 0 - -- WHEN: Send setReply - write_SetReply c1 (toEventChangeDTO (sre_rQ1Updated' qtn.uuid)) - -- THEN: Read response - read_Error c1 expError - -- AND: Close sockets - closeSockets [s1] - --- ---------------------------------------------------- --- ---------------------------------------------------- --- ---------------------------------------------------- -write_SetReply connection replyDto = do - let reqDto = SetContent_ClientQuestionnaireActionDTO replyDto - sendMessage connection reqDto - -read_SetReply connection expReplyDto = do - resDto <- receiveData connection - let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerQuestionnaireActionDTO) - let (Right (Success_ServerActionDTO (SetContent_ServerQuestionnaireActionDTO replyDto))) = eResult - expReplyDto `shouldBe` replyDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/WebsocketSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/WebsocketSpec.hs deleted file mode 100644 index b76b1e3eb..000000000 --- a/wizard-server/test/Wizard/Specs/Websocket/Questionnaire/Detail/WebsocketSpec.hs +++ /dev/null @@ -1,36 +0,0 @@ -module Wizard.Specs.Websocket.Questionnaire.Detail.WebsocketSpec where - -import Test.Hspec hiding (shouldBe) - -import Wizard.Model.Context.AppContext - -import Wizard.Specs.Websocket.Questionnaire.Detail.AddCommentSpec -import Wizard.Specs.Websocket.Questionnaire.Detail.AssignCommentThreadSpec -import Wizard.Specs.Websocket.Questionnaire.Detail.ClearReplySpec -import Wizard.Specs.Websocket.Questionnaire.Detail.DeleteCommentSpec -import Wizard.Specs.Websocket.Questionnaire.Detail.DeleteCommentThreadSpec -import Wizard.Specs.Websocket.Questionnaire.Detail.EditCommentSpec -import Wizard.Specs.Websocket.Questionnaire.Detail.GeneralSpec -import Wizard.Specs.Websocket.Questionnaire.Detail.ReopenCommentThreadSpec -import Wizard.Specs.Websocket.Questionnaire.Detail.ResolveCommentThreadSpec -import Wizard.Specs.Websocket.Questionnaire.Detail.SetLabelsSpec -import Wizard.Specs.Websocket.Questionnaire.Detail.SetPhaseSpec -import Wizard.Specs.Websocket.Questionnaire.Detail.SetQuestionnaireSpec -import Wizard.Specs.Websocket.Questionnaire.Detail.SetReplySpec - -questionnaireWebsocketAPI :: AppContext -> SpecWith () -questionnaireWebsocketAPI appContext = - describe "WS /wizard-api/questionnaires/{qtnUuid}/websocket" $ do - generalSpec appContext - setReplySpec appContext - clearReplySpec appContext - setPhaseSpec appContext - setLabelsSpec appContext - resolveCommentThreadSpec appContext - reopenCommentThreadSpec appContext - assignCommentThreadSpec appContext - deleteCommentThreadSpec appContext - addCommentSpec appContext - editCommentSpec appContext - deleteCommentSpec appContext - setQuestionnaireSpec appContext diff --git a/wizard-server/test/Wizard/TestMigration.hs b/wizard-server/test/Wizard/TestMigration.hs index 0079f5dab..71547b25e 100644 --- a/wizard-server/test/Wizard/TestMigration.hs +++ b/wizard-server/test/Wizard/TestMigration.hs @@ -20,18 +20,18 @@ import Wizard.Database.DAO.Document.DocumentDAO import Wizard.Database.DAO.DocumentTemplate.DocumentTemplateDraftDAO import Wizard.Database.DAO.Feedback.FeedbackDAO import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelEditorDAO -import qualified Wizard.Database.DAO.KnowledgeModel.KnowledgeModelMigrationDAO as KM_MigratorDAO +import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelMigrationDAO import Wizard.Database.DAO.KnowledgeModel.KnowledgeModelSecretDAO -import qualified Wizard.Database.DAO.Questionnaire.MigratorDAO as QTN_MigratorDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireCommentDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireCommentThreadDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireEventDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireFileDAO -import Wizard.Database.DAO.Questionnaire.QuestionnairePermDAO -import Wizard.Database.DAO.Questionnaire.QuestionnaireVersionDAO -import Wizard.Database.DAO.QuestionnaireAction.QuestionnaireActionDAO -import Wizard.Database.DAO.QuestionnaireImporter.QuestionnaireImporterDAO +import Wizard.Database.DAO.Project.ProjectActionDAO +import Wizard.Database.DAO.Project.ProjectCommentDAO +import Wizard.Database.DAO.Project.ProjectCommentThreadDAO +import Wizard.Database.DAO.Project.ProjectDAO +import Wizard.Database.DAO.Project.ProjectEventDAO +import Wizard.Database.DAO.Project.ProjectFileDAO +import Wizard.Database.DAO.Project.ProjectImporterDAO +import Wizard.Database.DAO.Project.ProjectMigrationDAO +import Wizard.Database.DAO.Project.ProjectPermDAO +import Wizard.Database.DAO.Project.ProjectVersionDAO import Wizard.Database.DAO.Registry.RegistryKnowledgeModelPackageDAO import Wizard.Database.DAO.Registry.RegistryOrganizationDAO import Wizard.Database.DAO.Registry.RegistryTemplateDAO @@ -42,7 +42,7 @@ import Wizard.Database.DAO.Tenant.Config.TenantConfigKnowledgeModelDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigOrganizationDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigOwlDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigPrivacyAndSupportDAO -import Wizard.Database.DAO.Tenant.Config.TenantConfigQuestionnaireDAO +import Wizard.Database.DAO.Tenant.Config.TenantConfigProjectDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigRegistryDAO import Wizard.Database.DAO.Tenant.Config.TenantConfigSubmissionDAO import Wizard.Database.DAO.Tenant.TenantDAO @@ -58,16 +58,16 @@ import qualified Wizard.Database.Migration.Development.Instance.InstanceSchemaMi import Wizard.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeModelCacheSchemaMigration as KnowledgeModelCache import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeModelEditorSchemaMigration as KnowledgeModelEditor -import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeModelMigrationSchemaMigration as KnowledgeModelMigrator +import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeModelMigrationSchemaMigration as KnowledgeModelMigration import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeModelPackageSchemaMigration as KnowledgeModelPackage import qualified Wizard.Database.Migration.Development.KnowledgeModel.KnowledgeModelSecretSchemaMigration as KnowledgeModelSecret import qualified Wizard.Database.Migration.Development.Locale.LocaleMigration as LocaleMigration import qualified Wizard.Database.Migration.Development.Locale.LocaleSchemaMigration as Locale import qualified Wizard.Database.Migration.Development.PersistentCommand.PersistentCommandSchemaMigration as PersistentCommand -import qualified Wizard.Database.Migration.Development.Questionnaire.MigratorSchemaMigration as QuestionnaireMigrator -import qualified Wizard.Database.Migration.Development.Questionnaire.QuestionnaireSchemaMigration as Questionnaire -import qualified Wizard.Database.Migration.Development.QuestionnaireAction.QuestionnaireActionSchemaMigration as QuestionnaireAction -import qualified Wizard.Database.Migration.Development.QuestionnaireImporter.QuestionnaireImporterSchemaMigration as QuestionnaireImporter +import qualified Wizard.Database.Migration.Development.Project.ProjectActionSchemaMigration as ProjectAction +import qualified Wizard.Database.Migration.Development.Project.ProjectImporterSchemaMigration as ProjectImporter +import qualified Wizard.Database.Migration.Development.Project.ProjectMigrationSchemaMigration as ProjectMigration +import qualified Wizard.Database.Migration.Development.Project.ProjectSchemaMigration as Project import qualified Wizard.Database.Migration.Development.Registry.RegistrySchemaMigration as Registry import qualified Wizard.Database.Migration.Development.Submission.SubmissionSchemaMigration as Submission import Wizard.Database.Migration.Development.Tenant.Data.TenantConfigs @@ -96,10 +96,10 @@ import Wizard.Specs.Common buildSchema appContext = do putStrLn "DB: dropping DB triggers" runInContext Document.dropTriggers appContext - runInContext Questionnaire.dropTriggers appContext + runInContext Project.dropTriggers appContext runInContext Locale.dropTriggers appContext putStrLn "DB: dropping DB functions" - runInContext Questionnaire.dropFunctions appContext + runInContext Project.dropFunctions appContext runInContext DocumentTemplate.dropFunctions appContext runInContext KnowledgeModelEditor.dropFunctions appContext runInContext KnowledgeModelPackage.dropFunctions appContext @@ -109,20 +109,20 @@ buildSchema appContext = do runInContext ExternalLink.dropTables appContext runInContext Component.dropTables appContext runInContext Registry.dropTables appContext - runInContext QuestionnaireAction.dropTables appContext - runInContext QuestionnaireImporter.dropTables appContext + runInContext ProjectAction.dropTables appContext + runInContext ProjectImporter.dropTables appContext runInContext Audit.dropTables appContext runInContext Prefab.dropTables appContext runInContext PersistentCommand.dropTables appContext runInContext Submission.dropTables appContext runInContext ActionKey.dropTables appContext runInContext Feedback.dropTables appContext - runInContext KnowledgeModelMigrator.dropTables appContext + runInContext KnowledgeModelMigration.dropTables appContext runInContext KnowledgeModelCache.dropTables appContext runInContext KnowledgeModelEditor.dropTables appContext runInContext Document.dropTables appContext - runInContext QuestionnaireMigrator.dropTables appContext - runInContext Questionnaire.dropTables appContext + runInContext ProjectMigration.dropTables appContext + runInContext Project.dropTables appContext runInContext KnowledgeModelSecret.dropTables appContext runInContext KnowledgeModelPackage.dropTables appContext runInContext User.dropTables appContext @@ -149,17 +149,17 @@ buildSchema appContext = do runInContext Feedback.createTables appContext runInContext KnowledgeModelEditor.createTables appContext runInContext KnowledgeModelCache.createTables appContext - runInContext Questionnaire.createTables appContext + runInContext Project.createTables appContext runInContext DocumentTemplate.createDraftDataTable appContext runInContext Document.createTables appContext - runInContext QuestionnaireMigrator.createTables appContext - runInContext KnowledgeModelMigrator.createTables appContext + runInContext ProjectMigration.createTables appContext + runInContext KnowledgeModelMigration.createTables appContext runInContext Submission.createTables appContext runInContext PersistentCommand.createTables appContext runInContext Prefab.createTables appContext runInContext Audit.createTables appContext - runInContext QuestionnaireAction.createTables appContext - runInContext QuestionnaireImporter.createTables appContext + runInContext ProjectAction.createTables appContext + runInContext ProjectImporter.createTables appContext runInContext Registry.createTables appContext runInContext Component.createTables appContext runInContext ExternalLink.createTables appContext @@ -169,12 +169,12 @@ buildSchema appContext = do runInContext KnowledgeModelPackage.createFunctions appContext runInContext KnowledgeModelEditor.createFunctions appContext runInContext DocumentTemplate.createFunctions appContext - runInContext Questionnaire.createFunctions appContext + runInContext Project.createFunctions appContext putStrLn "DB: Creating missing foreign key constraints" runInContext User.createUserLocaleForeignKeyConstraint appContext putStrLn "DB: Creating triggers" runInContext Locale.createTriggers appContext - runInContext Questionnaire.createTriggers appContext + runInContext Project.createTriggers appContext runInContext Document.createTriggers appContext putStrLn "DB-S3: Purging and creating schema" runInContext DocumentTemplateMigration.runS3Migration appContext @@ -193,7 +193,7 @@ resetDB appContext = do runInContext deleteTenantConfigMails appContext runInContext deleteTenantConfigFeatures appContext runInContext deleteTenantConfigSubmissions appContext - runInContext deleteTenantConfigQuestionnaires appContext + runInContext deleteTenantConfigProjects appContext runInContext deleteTenantConfigKnowledgeModels appContext runInContext deleteTenantConfigRegistries appContext runInContext deleteTenantConfigLookAndFeels appContext @@ -201,23 +201,23 @@ resetDB appContext = do runInContext deleteTenantConfigPrivacyAndSupports appContext runInContext deleteTenantConfigAuthentications appContext runInContext deleteTenantConfigOrganizations appContext - runInContext KM_MigratorDAO.deleteMigratorStates appContext - runInContext QTN_MigratorDAO.deleteMigratorStates appContext + runInContext deleteKnowledgeModelMigrations appContext + runInContext deleteProjectMigrations appContext runInContext deleteFeedbacks appContext runInContext deleteActionKeys appContext runInContext deleteKnowledgeModelEditors appContext runInContext deleteDocuments appContext runInContext deleteDrafts appContext - runInContext deleteQuestionnaireVersions appContext - runInContext deleteQuestionnaireEvents appContext - runInContext deleteQuestionnaireFiles appContext - runInContext deleteQuestionnaireVersions appContext - runInContext deleteQuestionnaireComments appContext - runInContext deleteQuestionnaireCommentThreads appContext - runInContext deleteQuestionnairePerms appContext - runInContext deleteQuestionnaires appContext - runInContext deleteQuestionnaireActions appContext - runInContext deleteQuestionnaireImporters appContext + runInContext deleteProjectVersions appContext + runInContext deleteProjectEvents appContext + runInContext deleteProjectFiles appContext + runInContext deleteProjectVersions appContext + runInContext deleteProjectComments appContext + runInContext deleteProjectCommentThreads appContext + runInContext deleteProjectPerms appContext + runInContext deleteProjects appContext + runInContext deleteProjectActions appContext + runInContext deleteProjectImporters appContext runInContext deleteDocumentTemplates appContext runInContext deleteKnowledgeModelSecrets appContext runInContext deletePackages appContext @@ -245,7 +245,7 @@ resetDB appContext = do runInContext (insertTenantConfigRegistry defaultRegistryEncrypted) appContext runInContext (insertTenantConfigKnowledgeModel defaultKnowledgeModelEncrypted) appContext runInContext (insertTenantConfigKnowledgeModelPublicPackagePattern defaultKnowledgeModelPublicPackagePattern) appContext - runInContext (insertTenantConfigQuestionnaire defaultQuestionnaireEncrypted) appContext + runInContext (insertTenantConfigProject defaultProjectEncrypted) appContext runInContext (insertTenantConfigSubmission (defaultSubmission {services = []})) appContext runInContext (insertTenantConfigFeatures defaultFeatures) appContext runInContext (insertTenantConfigMail defaultMail) appContext