diff --git a/registry-public/package.yaml b/registry-public/package.yaml index bf0c5183a..765ab625c 100644 --- a/registry-public/package.yaml +++ b/registry-public/package.yaml @@ -1,5 +1,5 @@ name: registry-public -version: '4.13.0' +version: '4.14.0' synopsis: Registry Public description: Registry Public category: Web diff --git a/registry-server/package.yaml b/registry-server/package.yaml index ad219378e..b114dd70d 100644 --- a/registry-server/package.yaml +++ b/registry-server/package.yaml @@ -1,5 +1,5 @@ name: registry-server -version: '4.13.0' +version: '4.14.0' synopsis: Engine Registry description: Engine Registry category: Web diff --git a/registry-server/src/Registry/Api/Handler/Swagger/Api.hs b/registry-server/src/Registry/Api/Handler/Swagger/Api.hs index b48471f79..52190e041 100644 --- a/registry-server/src/Registry/Api/Handler/Swagger/Api.hs +++ b/registry-server/src/Registry/Api/Handler/Swagger/Api.hs @@ -38,7 +38,7 @@ swagger = s._swaggerInfo { _infoTitle = "Registry API" , _infoDescription = Just "API specification for Registry" - , _infoVersion = "4.13.0" + , _infoVersion = "4.14.0" , _infoLicense = Just $ License diff --git a/shared-common/package.yaml b/shared-common/package.yaml index ae8a3db5d..b0dd7fa43 100644 --- a/shared-common/package.yaml +++ b/shared-common/package.yaml @@ -1,5 +1,5 @@ name: shared-common -version: '4.13.0' +version: '4.14.0' synopsis: Engine Shared description: Engine Shared category: Web diff --git a/shared-common/src/Shared/ActionKey/Database/DAO/ActionKey/ActionKeyDAO.hs b/shared-common/src/Shared/ActionKey/Database/DAO/ActionKey/ActionKeyDAO.hs index 5477b8474..2c7bf20a7 100644 --- a/shared-common/src/Shared/ActionKey/Database/DAO/ActionKey/ActionKeyDAO.hs +++ b/shared-common/src/Shared/ActionKey/Database/DAO/ActionKey/ActionKeyDAO.hs @@ -31,6 +31,11 @@ findActionKeyByHashAndType hash aType = do tenantUuid <- asks (.tenantUuid') createFindEntityByFn entityName [tenantQueryUuid tenantUuid, ("hash", hash), ("type", show aType)] +findActionKeyByIdentityAndType' :: (AppContextC s sc m, ToField identity, FromField identity, FromField aType, Show aType) => String -> aType -> m (Maybe (ActionKey identity aType)) +findActionKeyByIdentityAndType' identity aType = do + tenantUuid <- asks (.tenantUuid') + createFindEntityByFn' entityName [tenantQueryUuid tenantUuid, ("identity", identity), ("type", show aType)] + findActionKeyByIdentityAndHash' :: ( AppContextC s sc m , FromField aType diff --git a/shared-common/src/Shared/Common/Util/Aeson.hs b/shared-common/src/Shared/Common/Util/Aeson.hs index 4a638ff21..7d7faaa1e 100644 --- a/shared-common/src/Shared/Common/Util/Aeson.hs +++ b/shared-common/src/Shared/Common/Util/Aeson.hs @@ -56,6 +56,7 @@ jsonSpecialFields "adData" = "data" jsonSpecialFields "seData" = "data" jsonSpecialFields "scData" = "data" jsonSpecialFields "sqData" = "data" +jsonSpecialFields "srData" = "data" jsonSpecialFields "ouiData" = "data" jsonSpecialFields "qeData" = "data" jsonSpecialFields "aType" = "type" diff --git a/wizard-common/package.yaml b/wizard-common/package.yaml index dd89af253..603085b7c 100644 --- a/wizard-common/package.yaml +++ b/wizard-common/package.yaml @@ -1,5 +1,5 @@ name: wizard-common -version: '4.13.0' +version: '4.14.0' synopsis: Wizard Engine description: Wizard Engine category: Web @@ -34,6 +34,7 @@ library: - directory - exceptions - fsutils + - hashable - http-client - http-client-tls - http-types diff --git a/wizard-common/src/WizardLib/Common/Util/Hashable.hs b/wizard-common/src/WizardLib/Common/Util/Hashable.hs new file mode 100644 index 000000000..01eccfe3b --- /dev/null +++ b/wizard-common/src/WizardLib/Common/Util/Hashable.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE StandaloneDeriving #-} + +module WizardLib.Common.Util.Hashable where + +import Data.Hashable +import Data.Time +import GHC.Generics + +import Shared.Common.Model.Common.MapEntry +import WizardLib.KnowledgeModel.Model.Event.EventField +import WizardLib.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel + +deriving instance Generic Day + +instance Hashable Day + +deriving instance Generic LocalTime + +instance Hashable LocalTime + +deriving instance Generic TimeOfDay + +instance Hashable TimeOfDay + +deriving instance Generic TimeZone + +instance Hashable TimeZone + +instance Hashable DiffTime where + hashWithSalt s = (hashWithSalt s :: Double -> Int) . realToFrac + +deriving instance Generic UTCTime + +instance Hashable UTCTime + +deriving instance Eq ZonedTime + +deriving instance Generic ZonedTime + +instance Hashable ZonedTime + +instance Hashable MetricMeasure +instance Hashable QuestionValidation +instance Hashable QuestionValueType +instance Hashable a => Hashable (EventField a) +instance (Hashable key, Hashable value) => Hashable (MapEntry key value) diff --git a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Answer/AnswerEvent.hs b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Answer/AnswerEvent.hs index e9453001a..f59db96b6 100644 --- a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Answer/AnswerEvent.hs +++ b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Answer/AnswerEvent.hs @@ -1,10 +1,12 @@ module WizardLib.KnowledgeModel.Model.Event.Answer.AnswerEvent where +import Data.Hashable import Data.Time import qualified Data.UUID as U import GHC.Generics import Shared.Common.Model.Common.MapEntry +import WizardLib.Common.Util.Hashable () import WizardLib.KnowledgeModel.Model.Event.EventField import WizardLib.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel @@ -20,6 +22,8 @@ data AddAnswerEvent = AddAnswerEvent } deriving (Show, Eq, Generic) +instance Hashable AddAnswerEvent + data EditAnswerEvent = EditAnswerEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -33,10 +37,20 @@ data EditAnswerEvent = EditAnswerEvent } deriving (Show, Eq, Generic) +instance Hashable EditAnswerEvent + data DeleteAnswerEvent = DeleteAnswerEvent { uuid :: U.UUID , parentUuid :: U.UUID , entityUuid :: U.UUID , createdAt :: UTCTime } - deriving (Show, Eq, Generic) + deriving (Show, Generic) + +instance Eq DeleteAnswerEvent where + a == b = + a.uuid == b.uuid + && a.parentUuid == b.parentUuid + && a.entityUuid == b.entityUuid + +instance Hashable DeleteAnswerEvent diff --git a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Chapter/ChapterEvent.hs b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Chapter/ChapterEvent.hs index 2d0ecec17..dfebb78bd 100644 --- a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Chapter/ChapterEvent.hs +++ b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Chapter/ChapterEvent.hs @@ -1,10 +1,12 @@ module WizardLib.KnowledgeModel.Model.Event.Chapter.ChapterEvent where +import Data.Hashable import Data.Time import qualified Data.UUID as U import GHC.Generics import Shared.Common.Model.Common.MapEntry +import WizardLib.Common.Util.Hashable () import WizardLib.KnowledgeModel.Model.Event.EventField data AddChapterEvent = AddChapterEvent @@ -18,6 +20,8 @@ data AddChapterEvent = AddChapterEvent } deriving (Show, Eq, Generic) +instance Hashable AddChapterEvent + data EditChapterEvent = EditChapterEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -30,6 +34,8 @@ data EditChapterEvent = EditChapterEvent } deriving (Show, Eq, Generic) +instance Hashable EditChapterEvent + data DeleteChapterEvent = DeleteChapterEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -37,3 +43,5 @@ data DeleteChapterEvent = DeleteChapterEvent , createdAt :: UTCTime } deriving (Show, Eq, Generic) + +instance Hashable DeleteChapterEvent diff --git a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Choice/ChoiceEvent.hs b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Choice/ChoiceEvent.hs index d47a111c9..b1383716b 100644 --- a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Choice/ChoiceEvent.hs +++ b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Choice/ChoiceEvent.hs @@ -1,10 +1,12 @@ module WizardLib.KnowledgeModel.Model.Event.Choice.ChoiceEvent where +import Data.Hashable import Data.Time import qualified Data.UUID as U import GHC.Generics import Shared.Common.Model.Common.MapEntry +import WizardLib.Common.Util.Hashable () import WizardLib.KnowledgeModel.Model.Event.EventField data AddChoiceEvent = AddChoiceEvent @@ -17,6 +19,8 @@ data AddChoiceEvent = AddChoiceEvent } deriving (Show, Eq, Generic) +instance Hashable AddChoiceEvent + data EditChoiceEvent = EditChoiceEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -27,6 +31,8 @@ data EditChoiceEvent = EditChoiceEvent } deriving (Show, Eq, Generic) +instance Hashable EditChoiceEvent + data DeleteChoiceEvent = DeleteChoiceEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -34,3 +40,5 @@ data DeleteChoiceEvent = DeleteChoiceEvent , createdAt :: UTCTime } deriving (Show, Eq, Generic) + +instance Hashable DeleteChoiceEvent diff --git a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Event.hs b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Event.hs index 3299a4101..5d17998e8 100644 --- a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Event.hs +++ b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Event.hs @@ -1,7 +1,9 @@ module WizardLib.KnowledgeModel.Model.Event.Event where +import Data.Hashable import GHC.Generics +import WizardLib.Common.Util.Hashable () import WizardLib.KnowledgeModel.Model.Event.Answer.AnswerEvent import WizardLib.KnowledgeModel.Model.Event.Chapter.ChapterEvent import WizardLib.KnowledgeModel.Model.Event.Choice.ChoiceEvent @@ -61,3 +63,5 @@ data Event | MoveExpertEvent' MoveExpertEvent | MoveReferenceEvent' MoveReferenceEvent deriving (Show, Eq, Generic) + +instance Hashable Event diff --git a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Expert/ExpertEvent.hs b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Expert/ExpertEvent.hs index 70274a8e8..fa09209c4 100644 --- a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Expert/ExpertEvent.hs +++ b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Expert/ExpertEvent.hs @@ -1,10 +1,12 @@ module WizardLib.KnowledgeModel.Model.Event.Expert.ExpertEvent where +import Data.Hashable import Data.Time import qualified Data.UUID as U import GHC.Generics import Shared.Common.Model.Common.MapEntry +import WizardLib.Common.Util.Hashable () import WizardLib.KnowledgeModel.Model.Event.EventField data AddExpertEvent = AddExpertEvent @@ -18,6 +20,8 @@ data AddExpertEvent = AddExpertEvent } deriving (Show, Eq, Generic) +instance Hashable AddExpertEvent + data EditExpertEvent = EditExpertEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -29,6 +33,8 @@ data EditExpertEvent = EditExpertEvent } deriving (Show, Eq, Generic) +instance Hashable EditExpertEvent + data DeleteExpertEvent = DeleteExpertEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -36,3 +42,5 @@ data DeleteExpertEvent = DeleteExpertEvent , createdAt :: UTCTime } deriving (Show, Eq, Generic) + +instance Hashable DeleteExpertEvent diff --git a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Integration/IntegrationEvent.hs b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Integration/IntegrationEvent.hs index d8d70fc37..e85183a01 100644 --- a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Integration/IntegrationEvent.hs +++ b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Integration/IntegrationEvent.hs @@ -1,10 +1,12 @@ module WizardLib.KnowledgeModel.Model.Event.Integration.IntegrationEvent where +import Data.Hashable import Data.Time import qualified Data.UUID as U import GHC.Generics import Shared.Common.Model.Common.MapEntry +import WizardLib.Common.Util.Hashable () import WizardLib.KnowledgeModel.Model.Event.EventField data AddIntegrationEvent @@ -12,6 +14,8 @@ data AddIntegrationEvent | AddWidgetIntegrationEvent' AddWidgetIntegrationEvent deriving (Show, Eq, Generic) +instance Hashable AddIntegrationEvent + data AddApiIntegrationEvent = AddApiIntegrationEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -34,6 +38,8 @@ data AddApiIntegrationEvent = AddApiIntegrationEvent } deriving (Show, Eq, Generic) +instance Hashable AddApiIntegrationEvent + data AddWidgetIntegrationEvent = AddWidgetIntegrationEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -49,11 +55,15 @@ data AddWidgetIntegrationEvent = AddWidgetIntegrationEvent } deriving (Show, Eq, Generic) +instance Hashable AddWidgetIntegrationEvent + data EditIntegrationEvent = EditApiIntegrationEvent' EditApiIntegrationEvent | EditWidgetIntegrationEvent' EditWidgetIntegrationEvent deriving (Show, Eq, Generic) +instance Hashable EditIntegrationEvent + data EditApiIntegrationEvent = EditApiIntegrationEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -76,6 +86,8 @@ data EditApiIntegrationEvent = EditApiIntegrationEvent } deriving (Show, Eq, Generic) +instance Hashable EditApiIntegrationEvent + data EditWidgetIntegrationEvent = EditWidgetIntegrationEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -91,6 +103,8 @@ data EditWidgetIntegrationEvent = EditWidgetIntegrationEvent } deriving (Show, Eq, Generic) +instance Hashable EditWidgetIntegrationEvent + data DeleteIntegrationEvent = DeleteIntegrationEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -98,3 +112,5 @@ data DeleteIntegrationEvent = DeleteIntegrationEvent , createdAt :: UTCTime } deriving (Show, Eq, Generic) + +instance Hashable DeleteIntegrationEvent diff --git a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/KnowledgeModel/KnowledgeModelEvent.hs b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/KnowledgeModel/KnowledgeModelEvent.hs index 37c1600f8..aacd538a8 100644 --- a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/KnowledgeModel/KnowledgeModelEvent.hs +++ b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/KnowledgeModel/KnowledgeModelEvent.hs @@ -1,10 +1,12 @@ module WizardLib.KnowledgeModel.Model.Event.KnowledgeModel.KnowledgeModelEvent where +import Data.Hashable import Data.Time import qualified Data.UUID as U import GHC.Generics import Shared.Common.Model.Common.MapEntry +import WizardLib.Common.Util.Hashable () import WizardLib.KnowledgeModel.Model.Event.EventField data AddKnowledgeModelEvent = AddKnowledgeModelEvent @@ -16,6 +18,8 @@ data AddKnowledgeModelEvent = AddKnowledgeModelEvent } deriving (Show, Eq, Generic) +instance Hashable AddKnowledgeModelEvent + data EditKnowledgeModelEvent = EditKnowledgeModelEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -30,3 +34,5 @@ data EditKnowledgeModelEvent = EditKnowledgeModelEvent , createdAt :: UTCTime } deriving (Show, Eq, Generic) + +instance Hashable EditKnowledgeModelEvent diff --git a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Metric/MetricEvent.hs b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Metric/MetricEvent.hs index 6f2923085..0ea1e8223 100644 --- a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Metric/MetricEvent.hs +++ b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Metric/MetricEvent.hs @@ -1,10 +1,12 @@ module WizardLib.KnowledgeModel.Model.Event.Metric.MetricEvent where +import Data.Hashable import Data.Time import qualified Data.UUID as U import GHC.Generics import Shared.Common.Model.Common.MapEntry +import WizardLib.Common.Util.Hashable () import WizardLib.KnowledgeModel.Model.Event.EventField data AddMetricEvent = AddMetricEvent @@ -19,6 +21,8 @@ data AddMetricEvent = AddMetricEvent } deriving (Show, Eq, Generic) +instance Hashable AddMetricEvent + data EditMetricEvent = EditMetricEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -31,6 +35,8 @@ data EditMetricEvent = EditMetricEvent } deriving (Show, Eq, Generic) +instance Hashable EditMetricEvent + data DeleteMetricEvent = DeleteMetricEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -38,3 +44,5 @@ data DeleteMetricEvent = DeleteMetricEvent , createdAt :: UTCTime } deriving (Show, Eq, Generic) + +instance Hashable DeleteMetricEvent diff --git a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Move/MoveEvent.hs b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Move/MoveEvent.hs index 6f6bd2078..b97e3264c 100644 --- a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Move/MoveEvent.hs +++ b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Move/MoveEvent.hs @@ -1,9 +1,12 @@ module WizardLib.KnowledgeModel.Model.Event.Move.MoveEvent where +import Data.Hashable import Data.Time import qualified Data.UUID as U import GHC.Generics +import WizardLib.Common.Util.Hashable () + data MoveQuestionEvent = MoveQuestionEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -13,6 +16,8 @@ data MoveQuestionEvent = MoveQuestionEvent } deriving (Show, Eq, Generic) +instance Hashable MoveQuestionEvent + data MoveAnswerEvent = MoveAnswerEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -22,6 +27,8 @@ data MoveAnswerEvent = MoveAnswerEvent } deriving (Show, Eq, Generic) +instance Hashable MoveAnswerEvent + data MoveChoiceEvent = MoveChoiceEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -31,6 +38,8 @@ data MoveChoiceEvent = MoveChoiceEvent } deriving (Show, Eq, Generic) +instance Hashable MoveChoiceEvent + data MoveExpertEvent = MoveExpertEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -40,6 +49,8 @@ data MoveExpertEvent = MoveExpertEvent } deriving (Show, Eq, Generic) +instance Hashable MoveExpertEvent + data MoveReferenceEvent = MoveReferenceEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -48,3 +59,5 @@ data MoveReferenceEvent = MoveReferenceEvent , createdAt :: UTCTime } deriving (Show, Eq, Generic) + +instance Hashable MoveReferenceEvent diff --git a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Phase/PhaseEvent.hs b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Phase/PhaseEvent.hs index e55e6cd7b..a60818b3d 100644 --- a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Phase/PhaseEvent.hs +++ b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Phase/PhaseEvent.hs @@ -1,10 +1,12 @@ module WizardLib.KnowledgeModel.Model.Event.Phase.PhaseEvent where +import Data.Hashable import Data.Time import qualified Data.UUID as U import GHC.Generics import Shared.Common.Model.Common.MapEntry +import WizardLib.Common.Util.Hashable () import WizardLib.KnowledgeModel.Model.Event.EventField data AddPhaseEvent = AddPhaseEvent @@ -18,6 +20,8 @@ data AddPhaseEvent = AddPhaseEvent } deriving (Show, Eq, Generic) +instance Hashable AddPhaseEvent + data EditPhaseEvent = EditPhaseEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -29,6 +33,8 @@ data EditPhaseEvent = EditPhaseEvent } deriving (Show, Eq, Generic) +instance Hashable EditPhaseEvent + data DeletePhaseEvent = DeletePhaseEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -36,3 +42,5 @@ data DeletePhaseEvent = DeletePhaseEvent , createdAt :: UTCTime } deriving (Show, Eq, Generic) + +instance Hashable DeletePhaseEvent diff --git a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Question/QuestionEvent.hs b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Question/QuestionEvent.hs index 0b5565519..2088bb933 100644 --- a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Question/QuestionEvent.hs +++ b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Question/QuestionEvent.hs @@ -1,11 +1,13 @@ module WizardLib.KnowledgeModel.Model.Event.Question.QuestionEvent where +import Data.Hashable import qualified Data.Map.Strict as M import Data.Time import qualified Data.UUID as U import GHC.Generics import Shared.Common.Model.Common.MapEntry +import WizardLib.Common.Util.Hashable () import WizardLib.KnowledgeModel.Model.Event.EventField import WizardLib.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel @@ -19,6 +21,8 @@ data AddQuestionEvent | AddFileQuestionEvent' AddFileQuestionEvent deriving (Show, Eq, Generic) +instance Hashable AddQuestionEvent + data AddOptionsQuestionEvent = AddOptionsQuestionEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -32,6 +36,8 @@ data AddOptionsQuestionEvent = AddOptionsQuestionEvent } deriving (Show, Eq, Generic) +instance Hashable AddOptionsQuestionEvent + data AddMultiChoiceQuestionEvent = AddMultiChoiceQuestionEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -45,6 +51,8 @@ data AddMultiChoiceQuestionEvent = AddMultiChoiceQuestionEvent } deriving (Show, Eq, Generic) +instance Hashable AddMultiChoiceQuestionEvent + data AddListQuestionEvent = AddListQuestionEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -58,6 +66,8 @@ data AddListQuestionEvent = AddListQuestionEvent } deriving (Show, Eq, Generic) +instance Hashable AddListQuestionEvent + data AddValueQuestionEvent = AddValueQuestionEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -73,6 +83,8 @@ data AddValueQuestionEvent = AddValueQuestionEvent } deriving (Show, Eq, Generic) +instance Hashable AddValueQuestionEvent + data AddIntegrationQuestionEvent = AddIntegrationQuestionEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -88,6 +100,8 @@ data AddIntegrationQuestionEvent = AddIntegrationQuestionEvent } deriving (Show, Eq, Generic) +instance Hashable AddIntegrationQuestionEvent + data AddItemSelectQuestionEvent = AddItemSelectQuestionEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -102,6 +116,8 @@ data AddItemSelectQuestionEvent = AddItemSelectQuestionEvent } deriving (Show, Eq, Generic) +instance Hashable AddItemSelectQuestionEvent + data AddFileQuestionEvent = AddFileQuestionEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -117,6 +133,8 @@ data AddFileQuestionEvent = AddFileQuestionEvent } deriving (Show, Eq, Generic) +instance Hashable AddFileQuestionEvent + -- -------------------------------------------- data EditQuestionEvent = EditOptionsQuestionEvent' EditOptionsQuestionEvent @@ -128,6 +146,8 @@ data EditQuestionEvent | EditFileQuestionEvent' EditFileQuestionEvent deriving (Show, Eq, Generic) +instance Hashable EditQuestionEvent + data EditOptionsQuestionEvent = EditOptionsQuestionEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -144,6 +164,8 @@ data EditOptionsQuestionEvent = EditOptionsQuestionEvent } deriving (Show, Eq, Generic) +instance Hashable EditOptionsQuestionEvent + data EditMultiChoiceQuestionEvent = EditMultiChoiceQuestionEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -160,6 +182,8 @@ data EditMultiChoiceQuestionEvent = EditMultiChoiceQuestionEvent } deriving (Show, Eq, Generic) +instance Hashable EditMultiChoiceQuestionEvent + data EditListQuestionEvent = EditListQuestionEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -176,6 +200,8 @@ data EditListQuestionEvent = EditListQuestionEvent } deriving (Show, Eq, Generic) +instance Hashable EditListQuestionEvent + data EditValueQuestionEvent = EditValueQuestionEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -193,6 +219,8 @@ data EditValueQuestionEvent = EditValueQuestionEvent } deriving (Show, Eq, Generic) +instance Hashable EditValueQuestionEvent + data EditIntegrationQuestionEvent = EditIntegrationQuestionEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -210,6 +238,8 @@ data EditIntegrationQuestionEvent = EditIntegrationQuestionEvent } deriving (Show, Eq, Generic) +instance Hashable EditIntegrationQuestionEvent + data EditItemSelectQuestionEvent = EditItemSelectQuestionEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -226,6 +256,8 @@ data EditItemSelectQuestionEvent = EditItemSelectQuestionEvent } deriving (Show, Eq, Generic) +instance Hashable EditItemSelectQuestionEvent + data EditFileQuestionEvent = EditFileQuestionEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -243,6 +275,8 @@ data EditFileQuestionEvent = EditFileQuestionEvent } deriving (Show, Eq, Generic) +instance Hashable EditFileQuestionEvent + -- -------------------------------------------- data DeleteQuestionEvent = DeleteQuestionEvent { uuid :: U.UUID @@ -251,3 +285,5 @@ data DeleteQuestionEvent = DeleteQuestionEvent , createdAt :: UTCTime } deriving (Show, Eq, Generic) + +instance Hashable DeleteQuestionEvent diff --git a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Reference/ReferenceEvent.hs b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Reference/ReferenceEvent.hs index 22f987391..23aba7961 100644 --- a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Reference/ReferenceEvent.hs +++ b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Reference/ReferenceEvent.hs @@ -1,10 +1,12 @@ module WizardLib.KnowledgeModel.Model.Event.Reference.ReferenceEvent where +import Data.Hashable import Data.Time import qualified Data.UUID as U import GHC.Generics import Shared.Common.Model.Common.MapEntry +import WizardLib.Common.Util.Hashable () import WizardLib.KnowledgeModel.Model.Event.EventField data AddReferenceEvent @@ -13,6 +15,8 @@ data AddReferenceEvent | AddCrossReferenceEvent' AddCrossReferenceEvent deriving (Show, Eq, Generic) +instance Hashable AddReferenceEvent + data AddResourcePageReferenceEvent = AddResourcePageReferenceEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -23,6 +27,8 @@ data AddResourcePageReferenceEvent = AddResourcePageReferenceEvent } deriving (Show, Eq, Generic) +instance Hashable AddResourcePageReferenceEvent + data AddURLReferenceEvent = AddURLReferenceEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -34,6 +40,8 @@ data AddURLReferenceEvent = AddURLReferenceEvent } deriving (Show, Eq, Generic) +instance Hashable AddURLReferenceEvent + data AddCrossReferenceEvent = AddCrossReferenceEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -45,6 +53,8 @@ data AddCrossReferenceEvent = AddCrossReferenceEvent } deriving (Show, Eq, Generic) +instance Hashable AddCrossReferenceEvent + -- -------------------------------------------- data EditReferenceEvent = EditResourcePageReferenceEvent' EditResourcePageReferenceEvent @@ -52,6 +62,8 @@ data EditReferenceEvent | EditCrossReferenceEvent' EditCrossReferenceEvent deriving (Show, Eq, Generic) +instance Hashable EditReferenceEvent + data EditResourcePageReferenceEvent = EditResourcePageReferenceEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -62,6 +74,8 @@ data EditResourcePageReferenceEvent = EditResourcePageReferenceEvent } deriving (Show, Eq, Generic) +instance Hashable EditResourcePageReferenceEvent + data EditURLReferenceEvent = EditURLReferenceEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -73,6 +87,8 @@ data EditURLReferenceEvent = EditURLReferenceEvent } deriving (Show, Eq, Generic) +instance Hashable EditURLReferenceEvent + data EditCrossReferenceEvent = EditCrossReferenceEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -84,6 +100,8 @@ data EditCrossReferenceEvent = EditCrossReferenceEvent } deriving (Show, Eq, Generic) +instance Hashable EditCrossReferenceEvent + -- -------------------------------------------- data DeleteReferenceEvent = DeleteReferenceEvent { uuid :: U.UUID @@ -92,3 +110,5 @@ data DeleteReferenceEvent = DeleteReferenceEvent , createdAt :: UTCTime } deriving (Show, Eq, Generic) + +instance Hashable DeleteReferenceEvent diff --git a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Resource/ResourceEvent.hs b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Resource/ResourceEvent.hs index 3e1c550d4..b699dcd27 100644 --- a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Resource/ResourceEvent.hs +++ b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Resource/ResourceEvent.hs @@ -1,10 +1,12 @@ module WizardLib.KnowledgeModel.Model.Event.Resource.ResourceEvent where +import Data.Hashable import Data.Time import qualified Data.UUID as U import GHC.Generics import Shared.Common.Model.Common.MapEntry +import WizardLib.Common.Util.Hashable () import WizardLib.KnowledgeModel.Model.Event.EventField data AddResourceCollectionEvent = AddResourceCollectionEvent @@ -17,6 +19,8 @@ data AddResourceCollectionEvent = AddResourceCollectionEvent } deriving (Show, Eq, Generic) +instance Hashable AddResourceCollectionEvent + data EditResourceCollectionEvent = EditResourceCollectionEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -28,6 +32,8 @@ data EditResourceCollectionEvent = EditResourceCollectionEvent } deriving (Show, Eq, Generic) +instance Hashable EditResourceCollectionEvent + data DeleteResourceCollectionEvent = DeleteResourceCollectionEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -36,6 +42,8 @@ data DeleteResourceCollectionEvent = DeleteResourceCollectionEvent } deriving (Show, Eq, Generic) +instance Hashable DeleteResourceCollectionEvent + -- ------------------------------------------------ data AddResourcePageEvent = AddResourcePageEvent { uuid :: U.UUID @@ -48,6 +56,8 @@ data AddResourcePageEvent = AddResourcePageEvent } deriving (Show, Eq, Generic) +instance Hashable AddResourcePageEvent + data EditResourcePageEvent = EditResourcePageEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -59,6 +69,8 @@ data EditResourcePageEvent = EditResourcePageEvent } deriving (Show, Eq, Generic) +instance Hashable EditResourcePageEvent + data DeleteResourcePageEvent = DeleteResourcePageEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -66,3 +78,5 @@ data DeleteResourcePageEvent = DeleteResourcePageEvent , createdAt :: UTCTime } deriving (Show, Eq, Generic) + +instance Hashable DeleteResourcePageEvent diff --git a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Tag/TagEvent.hs b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Tag/TagEvent.hs index 6cdeac4c5..e43745543 100644 --- a/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Tag/TagEvent.hs +++ b/wizard-common/src/WizardLib/KnowledgeModel/Model/Event/Tag/TagEvent.hs @@ -1,10 +1,12 @@ module WizardLib.KnowledgeModel.Model.Event.Tag.TagEvent where +import Data.Hashable import Data.Time import qualified Data.UUID as U import GHC.Generics import Shared.Common.Model.Common.MapEntry +import WizardLib.Common.Util.Hashable () import WizardLib.KnowledgeModel.Model.Event.EventField data AddTagEvent = AddTagEvent @@ -19,6 +21,8 @@ data AddTagEvent = AddTagEvent } deriving (Show, Eq, Generic) +instance Hashable AddTagEvent + data EditTagEvent = EditTagEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -31,6 +35,8 @@ data EditTagEvent = EditTagEvent } deriving (Show, Eq, Generic) +instance Hashable EditTagEvent + data DeleteTagEvent = DeleteTagEvent { uuid :: U.UUID , parentUuid :: U.UUID @@ -38,3 +44,5 @@ data DeleteTagEvent = DeleteTagEvent , createdAt :: UTCTime } deriving (Show, Eq, Generic) + +instance Hashable DeleteTagEvent diff --git a/wizard-public/package.yaml b/wizard-public/package.yaml index ce6c363ae..965aa3032 100644 --- a/wizard-public/package.yaml +++ b/wizard-public/package.yaml @@ -1,5 +1,5 @@ name: wizard-public -version: '4.13.0' +version: '4.14.0' synopsis: Wizard Public description: Wizard Public category: Web diff --git a/wizard-public/src/WizardLib/Public/Database/DAO/PersistentCommand/PersistentCommandDAO.hs b/wizard-public/src/WizardLib/Public/Database/DAO/PersistentCommand/PersistentCommandDAO.hs index f8e22f951..257506c2e 100644 --- a/wizard-public/src/WizardLib/Public/Database/DAO/PersistentCommand/PersistentCommandDAO.hs +++ b/wizard-public/src/WizardLib/Public/Database/DAO/PersistentCommand/PersistentCommandDAO.hs @@ -25,7 +25,7 @@ findPersistentCommandsPage states pageable sort = do let (statesCondition, statesParam) = case states of [] -> ("", []) - _ -> (f' "WHERE state in (%s)" [generateQuestionMarks states], states) + _ -> (f' "WHERE persistent_command.state in (%s)" [generateQuestionMarks states], states) let conditionParams = statesParam let (sizeI, pageI, skip, limit) = preparePaginationVariables pageable -- 2. Get total count diff --git a/wizard-server/package.yaml b/wizard-server/package.yaml index 6a0a0076d..a4abbbeb0 100644 --- a/wizard-server/package.yaml +++ b/wizard-server/package.yaml @@ -1,5 +1,5 @@ name: wizard-server -version: '4.13.0' +version: '4.14.0' synopsis: Engine Wizard description: Engine Wizard category: Web diff --git a/wizard-server/src/Wizard/Api/Handler/Branch/Api.hs b/wizard-server/src/Wizard/Api/Handler/Branch/Api.hs index 511fbf8a1..5afaa1f11 100644 --- a/wizard-server/src/Wizard/Api/Handler/Branch/Api.hs +++ b/wizard-server/src/Wizard/Api/Handler/Branch/Api.hs @@ -9,11 +9,13 @@ import Wizard.Api.Handler.Branch.Detail_PUT import Wizard.Api.Handler.Branch.Detail_WS import Wizard.Api.Handler.Branch.List_GET import Wizard.Api.Handler.Branch.List_POST +import Wizard.Api.Handler.Branch.List_Suggestions_GET import Wizard.Model.Context.BaseContext type BranchAPI = Tags "Branch" :> ( List_GET + :<|> List_Suggestions_GET :<|> List_POST :<|> Detail_GET :<|> Detail_PUT @@ -25,4 +27,11 @@ branchApi :: Proxy BranchAPI branchApi = Proxy branchServer :: ServerT BranchAPI BaseContextM -branchServer = list_GET :<|> list_POST :<|> detail_GET :<|> detail_PUT :<|> detail_DELETE :<|> detail_WS +branchServer = + list_GET + :<|> list_suggestions_GET + :<|> list_POST + :<|> detail_GET + :<|> detail_PUT + :<|> detail_DELETE + :<|> detail_WS diff --git a/wizard-server/src/Wizard/Api/Handler/Branch/Detail_WS.hs b/wizard-server/src/Wizard/Api/Handler/Branch/Detail_WS.hs index 93a59b729..c6c85bcbe 100644 --- a/wizard-server/src/Wizard/Api/Handler/Branch/Detail_WS.hs +++ b/wizard-server/src/Wizard/Api/Handler/Branch/Detail_WS.hs @@ -50,3 +50,7 @@ handleMessage branchUuid connectionUuid connection = log connectionUuid "SetContent" setContent branchUuid connectionUuid reqDto handleMessage branchUuid connectionUuid connection + handleAction (SetReplies_ClientBranchActionDTO reqDto) = do + log connectionUuid "SetReplies" + setReplies branchUuid connectionUuid reqDto + handleMessage branchUuid connectionUuid connection diff --git a/wizard-server/src/Wizard/Api/Handler/Branch/List_Suggestions_GET.hs b/wizard-server/src/Wizard/Api/Handler/Branch/List_Suggestions_GET.hs new file mode 100644 index 000000000..adab3bcaf --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/Branch/List_Suggestions_GET.hs @@ -0,0 +1,38 @@ +module Wizard.Api.Handler.Branch.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 Wizard.Api.Handler.Common +import Wizard.Api.Resource.Branch.BranchSuggestionJM () +import Wizard.Model.Branch.BranchSuggestion +import Wizard.Model.Context.BaseContext +import Wizard.Service.Branch.BranchService + +type List_Suggestions_GET = + Header "Authorization" String + :> Header "Host" String + :> "branches" + :> "suggestions" + :> QueryParam "q" String + :> QueryParam "page" Int + :> QueryParam "size" Int + :> QueryParam "sort" String + :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] (Page BranchSuggestion)) + +list_suggestions_GET + :: Maybe String + -> Maybe String + -> Maybe String + -> Maybe Int + -> Maybe Int + -> Maybe String + -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page BranchSuggestion)) +list_suggestions_GET mTokenHeader mServerUrl mQuery mPage mSize mSort = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService NoTransaction $ + addTraceUuidHeader + =<< getBranchSuggestionsPage 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 864f4b43f..fb0b9e550 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 @@ -27,10 +27,10 @@ detail_documents_preview_GET -> Maybe String -> String -> BaseContextM (Headers '[Header "x-trace-uuid" String] TemporaryFileDTO) -detail_documents_preview_GET mTokenHeader mServerUrl qtnUuid = +detail_documents_preview_GET mTokenHeader mServerUrl documentTemplateId = getMaybeAuthServiceExecutor mTokenHeader mServerUrl $ \runInMaybeAuthService -> runInMaybeAuthService Transactional $ do - (doc, fileDto) <- createDocumentPreviewForDocTmlDraft qtnUuid + (doc, fileDto) <- createDocumentPreviewForDocTmlDraft documentTemplateId case doc.state of DoneDocumentState -> addTraceUuidHeader fileDto ErrorDocumentState -> diff --git a/wizard-server/src/Wizard/Api/Handler/DocumentTemplateDraft/Folder/Api.hs b/wizard-server/src/Wizard/Api/Handler/DocumentTemplateDraft/Folder/Api.hs index f2e82ab1e..fe4da3453 100644 --- a/wizard-server/src/Wizard/Api/Handler/DocumentTemplateDraft/Folder/Api.hs +++ b/wizard-server/src/Wizard/Api/Handler/DocumentTemplateDraft/Folder/Api.hs @@ -3,15 +3,20 @@ module Wizard.Api.Handler.DocumentTemplateDraft.Folder.Api where import Servant import Servant.Swagger.Tags +import Wizard.Api.Handler.DocumentTemplateDraft.Folder.List_Delete_POST import Wizard.Api.Handler.DocumentTemplateDraft.Folder.List_Move_POST import Wizard.Model.Context.BaseContext type DocumentTemplateFolderAPI = Tags "Document Template Draft Folder" - :> List_Move_POST + :> ( List_Delete_POST + :<|> List_Move_POST + ) documentTemplateFolderApi :: Proxy DocumentTemplateFolderAPI documentTemplateFolderApi = Proxy documentTemplateFolderServer :: ServerT DocumentTemplateFolderAPI BaseContextM -documentTemplateFolderServer = list_move_POST +documentTemplateFolderServer = + list_delete_POST + :<|> list_move_POST diff --git a/wizard-server/src/Wizard/Api/Handler/DocumentTemplateDraft/Folder/List_Delete_POST.hs b/wizard-server/src/Wizard/Api/Handler/DocumentTemplateDraft/Folder/List_Delete_POST.hs new file mode 100644 index 000000000..fed0195d1 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Handler/DocumentTemplateDraft/Folder/List_Delete_POST.hs @@ -0,0 +1,34 @@ +module Wizard.Api.Handler.DocumentTemplateDraft.Folder.List_Delete_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.DocumentTemplate.Folder.DocumentTemplateFolderDeleteDTO +import Wizard.Api.Resource.DocumentTemplate.Folder.DocumentTemplateFolderDeleteJM () +import Wizard.Model.Context.BaseContext +import Wizard.Service.DocumentTemplate.Folder.DocumentTemplateFolderService + +type List_Delete_POST = + Header "Authorization" String + :> Header "Host" String + :> ReqBody '[SafeJSON] DocumentTemplateFolderDeleteDTO + :> "document-template-drafts" + :> Capture "documentTemplateId" String + :> "folders" + :> "delete" + :> Verb POST 204 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] NoContent) + +list_delete_POST + :: Maybe String + -> Maybe String + -> DocumentTemplateFolderDeleteDTO + -> String + -> BaseContextM (Headers '[Header "x-trace-uuid" String] NoContent) +list_delete_POST mTokenHeader mServerUrl reqDto documentTemplateId = + getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService -> + runInAuthService Transactional $ + addTraceUuidHeader =<< do + deleteDraftFolder documentTemplateId reqDto + return NoContent diff --git a/wizard-server/src/Wizard/Api/Handler/Swagger/Api.hs b/wizard-server/src/Wizard/Api/Handler/Swagger/Api.hs index 1323b667b..6dbc69f15 100644 --- a/wizard-server/src/Wizard/Api/Handler/Swagger/Api.hs +++ b/wizard-server/src/Wizard/Api/Handler/Swagger/Api.hs @@ -44,6 +44,7 @@ import Wizard.Api.Resource.DocumentTemplate.Draft.DocumentTemplateDraftDetailSM import Wizard.Api.Resource.DocumentTemplate.Draft.DocumentTemplateDraftListSM () import Wizard.Api.Resource.DocumentTemplate.File.DocumentTemplateFileChangeSM () import Wizard.Api.Resource.DocumentTemplate.File.DocumentTemplateFileListSM () +import Wizard.Api.Resource.DocumentTemplate.Folder.DocumentTemplateFolderDeleteSM () import Wizard.Api.Resource.DocumentTemplate.Folder.DocumentTemplateFolderMoveSM () import Wizard.Api.Resource.Feedback.FeedbackCreateSM () import Wizard.Api.Resource.Feedback.FeedbackSM () @@ -139,7 +140,7 @@ swagger = s._swaggerInfo { _infoTitle = "Wizard API" , _infoDescription = Just "API specification for Wizard" - , _infoVersion = "4.13.0" + , _infoVersion = "4.14.0" , _infoLicense = Just $ License diff --git a/wizard-server/src/Wizard/Api/Resource/Branch/BranchDetailDTO.hs b/wizard-server/src/Wizard/Api/Resource/Branch/BranchDetailDTO.hs index 7a409b83a..25e62b24c 100644 --- a/wizard-server/src/Wizard/Api/Resource/Branch/BranchDetailDTO.hs +++ b/wizard-server/src/Wizard/Api/Resource/Branch/BranchDetailDTO.hs @@ -1,11 +1,13 @@ module Wizard.Api.Resource.Branch.BranchDetailDTO where +import qualified Data.Map.Strict as M import Data.Time import qualified Data.UUID as U import GHC.Generics import Wizard.Api.Resource.Package.PackageSimpleDTO import Wizard.Model.Branch.BranchState +import Wizard.Model.Questionnaire.QuestionnaireReply import WizardLib.KnowledgeModel.Model.Event.Event import WizardLib.KnowledgeModel.Model.KnowledgeModel.KnowledgeModel @@ -23,6 +25,7 @@ data BranchDetailDTO = BranchDetailDTO , forkOfPackage :: Maybe PackageSimpleDTO , createdBy :: Maybe U.UUID , events :: [Event] + , replies :: M.Map String Reply , knowledgeModel :: KnowledgeModel , createdAt :: UTCTime , updatedAt :: UTCTime @@ -44,4 +47,5 @@ instance Eq BranchDetailDTO where && a.forkOfPackage == b.forkOfPackage && a.createdBy == b.createdBy && a.events == b.events + && a.replies == b.replies && a.knowledgeModel == b.knowledgeModel diff --git a/wizard-server/src/Wizard/Api/Resource/Branch/BranchDetailJM.hs b/wizard-server/src/Wizard/Api/Resource/Branch/BranchDetailJM.hs index 64e608f9c..b55febd54 100644 --- a/wizard-server/src/Wizard/Api/Resource/Branch/BranchDetailJM.hs +++ b/wizard-server/src/Wizard/Api/Resource/Branch/BranchDetailJM.hs @@ -6,6 +6,7 @@ import Shared.Common.Util.Aeson import Wizard.Api.Resource.Branch.BranchDetailDTO import Wizard.Api.Resource.Branch.BranchStateJM () import Wizard.Api.Resource.Package.PackageSimpleJM () +import Wizard.Api.Resource.Questionnaire.QuestionnaireReplyJM () import WizardLib.KnowledgeModel.Api.Resource.Event.EventJM () instance FromJSON BranchDetailDTO where diff --git a/wizard-server/src/Wizard/Api/Resource/Branch/BranchDetailSM.hs b/wizard-server/src/Wizard/Api/Resource/Branch/BranchDetailSM.hs index 3097fff44..2c75fcd28 100644 --- a/wizard-server/src/Wizard/Api/Resource/Branch/BranchDetailSM.hs +++ b/wizard-server/src/Wizard/Api/Resource/Branch/BranchDetailSM.hs @@ -7,6 +7,7 @@ import Wizard.Api.Resource.Branch.BranchDetailDTO import Wizard.Api.Resource.Branch.BranchDetailJM () import Wizard.Api.Resource.Branch.BranchStateSM () import Wizard.Api.Resource.Package.PackageSimpleSM () +import Wizard.Api.Resource.Questionnaire.QuestionnaireReplySM () import Wizard.Database.Migration.Development.Branch.Data.Branches import WizardLib.KnowledgeModel.Api.Resource.Event.EventSM () diff --git a/wizard-server/src/Wizard/Api/Resource/Branch/BranchSuggestionJM.hs b/wizard-server/src/Wizard/Api/Resource/Branch/BranchSuggestionJM.hs new file mode 100644 index 000000000..fb46126a6 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Branch/BranchSuggestionJM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.Branch.BranchSuggestionJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Model.Branch.BranchSuggestion + +instance FromJSON BranchSuggestion where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON BranchSuggestion where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Branch/BranchSuggestionSM.hs b/wizard-server/src/Wizard/Api/Resource/Branch/BranchSuggestionSM.hs new file mode 100644 index 000000000..baa12ea98 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Branch/BranchSuggestionSM.hs @@ -0,0 +1,11 @@ +module Wizard.Api.Resource.Branch.BranchSuggestionSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Branch.BranchSuggestionJM () +import Wizard.Database.Migration.Development.Branch.Data.Branches +import Wizard.Model.Branch.BranchSuggestion + +instance ToSchema BranchSuggestion where + declareNamedSchema = toSwagger amsterdamBranchSuggestion diff --git a/wizard-server/src/Wizard/Api/Resource/Branch/Event/SetRepliesDTO.hs b/wizard-server/src/Wizard/Api/Resource/Branch/Event/SetRepliesDTO.hs new file mode 100644 index 000000000..f6277827e --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Branch/Event/SetRepliesDTO.hs @@ -0,0 +1,13 @@ +module Wizard.Api.Resource.Branch.Event.SetRepliesDTO where + +import qualified Data.Map.Strict as M +import qualified Data.UUID as U +import GHC.Generics + +import Wizard.Model.Questionnaire.QuestionnaireReply + +data SetRepliesDTO = SetRepliesDTO + { uuid :: U.UUID + , replies :: M.Map String Reply + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Branch/Event/SetRepliesJM.hs b/wizard-server/src/Wizard/Api/Resource/Branch/Event/SetRepliesJM.hs new file mode 100644 index 000000000..d74a074d0 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Branch/Event/SetRepliesJM.hs @@ -0,0 +1,13 @@ +module Wizard.Api.Resource.Branch.Event.SetRepliesJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.Branch.Event.SetRepliesDTO +import Wizard.Api.Resource.Questionnaire.QuestionnaireReplyJM () + +instance FromJSON SetRepliesDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON SetRepliesDTO where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Branch/Event/SetRepliesSM.hs b/wizard-server/src/Wizard/Api/Resource/Branch/Event/SetRepliesSM.hs new file mode 100644 index 000000000..523db4b9a --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/Branch/Event/SetRepliesSM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.Branch.Event.SetRepliesSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Branch.Event.SetRepliesDTO +import Wizard.Api.Resource.Branch.Event.SetRepliesJM () +import Wizard.Api.Resource.Questionnaire.QuestionnaireReplySM () +import Wizard.Database.Migration.Development.Branch.Data.BranchEvents + +instance ToSchema SetRepliesDTO where + declareNamedSchema = toSwagger setRepliesDTO diff --git a/wizard-server/src/Wizard/Api/Resource/Common/PageSM.hs b/wizard-server/src/Wizard/Api/Resource/Common/PageSM.hs index 5ef5ff2cb..cddd5b591 100644 --- a/wizard-server/src/Wizard/Api/Resource/Common/PageSM.hs +++ b/wizard-server/src/Wizard/Api/Resource/Common/PageSM.hs @@ -8,6 +8,7 @@ import Shared.Common.Database.Migration.Development.Common.Data.Pages import Shared.Common.Model.Common.Page import Shared.Common.Util.Swagger import Wizard.Api.Resource.Branch.BranchListSM () +import Wizard.Api.Resource.Branch.BranchSuggestionSM () import Wizard.Api.Resource.Document.DocumentDTO import Wizard.Api.Resource.Document.DocumentSM () import Wizard.Api.Resource.DocumentTemplate.DocumentTemplateSimpleDTO @@ -45,6 +46,7 @@ import Wizard.Database.Migration.Development.QuestionnaireImporter.Data.Question import Wizard.Database.Migration.Development.Tenant.Data.Tenants import Wizard.Database.Migration.Development.User.Data.Users import Wizard.Model.Branch.BranchList +import Wizard.Model.Branch.BranchSuggestion import Wizard.Model.DocumentTemplate.DocumentTemplateDraftList import Wizard.Model.Package.PackageSuggestion import Wizard.Model.Questionnaire.QuestionnaireCommentThreadAssigned @@ -107,6 +109,10 @@ instance ToSchema (Page BranchList) where declareNamedSchema = toSwaggerWithDtoName "Page BranchList" (Page "branches" pageMetadata [amsterdamBranchList]) +instance ToSchema (Page BranchSuggestion) where + declareNamedSchema = + toSwaggerWithDtoName "Page BranchSuggestion" (Page "branches" pageMetadata [amsterdamBranchSuggestion]) + instance ToSchema (Page QuestionnaireDTO) where declareNamedSchema = toSwaggerWithDtoName "Page QuestionnaireDTO" (Page "questionnaires" pageMetadata [questionnaire1Dto]) 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 0be8f83af..e9761316b 100644 --- a/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDataChangeDTO.hs +++ b/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDataChangeDTO.hs @@ -5,6 +5,7 @@ import GHC.Generics data DocumentTemplateDraftDataChangeDTO = DocumentTemplateDraftDataChangeDTO { questionnaireUuid :: Maybe U.UUID + , branchUuid :: Maybe U.UUID , formatUuid :: Maybe U.UUID } deriving (Show, Eq, Generic) 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 8edaab64e..23dd12c97 100644 --- a/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDataDTO.hs +++ b/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDataDTO.hs @@ -3,11 +3,14 @@ module Wizard.Api.Resource.DocumentTemplate.Draft.DocumentTemplateDraftDataDTO w import qualified Data.UUID as U import GHC.Generics +import Wizard.Model.Branch.BranchSuggestion import Wizard.Model.Questionnaire.QuestionnaireSuggestion data DocumentTemplateDraftDataDTO = DocumentTemplateDraftDataDTO { questionnaireUuid :: Maybe U.UUID - , formatUuid :: Maybe U.UUID , questionnaire :: Maybe QuestionnaireSuggestion + , branchUuid :: Maybe U.UUID + , branch :: Maybe BranchSuggestion + , formatUuid :: Maybe U.UUID } deriving (Show, Eq, Generic) 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 35992179e..e3cecf2b8 100644 --- a/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDataJM.hs +++ b/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDataJM.hs @@ -3,6 +3,7 @@ module Wizard.Api.Resource.DocumentTemplate.Draft.DocumentTemplateDraftDataJM wh import Data.Aeson import Shared.Common.Util.Aeson +import Wizard.Api.Resource.Branch.BranchSuggestionJM () import Wizard.Api.Resource.DocumentTemplate.Draft.DocumentTemplateDraftDataDTO import Wizard.Api.Resource.Questionnaire.QuestionnaireSuggestionJM () 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 3cd45feae..778010813 100644 --- a/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDataSM.hs +++ b/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDataSM.hs @@ -3,6 +3,7 @@ module Wizard.Api.Resource.DocumentTemplate.Draft.DocumentTemplateDraftDataSM wh import Data.Swagger import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Branch.BranchSuggestionSM () import Wizard.Api.Resource.DocumentTemplate.Draft.DocumentTemplateDraftDataDTO import Wizard.Api.Resource.DocumentTemplate.Draft.DocumentTemplateDraftDataJM () import Wizard.Api.Resource.Questionnaire.QuestionnaireSuggestionSM () 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 54ac1e755..309f17995 100644 --- a/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDetailJM.hs +++ b/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDetailJM.hs @@ -3,6 +3,7 @@ module Wizard.Api.Resource.DocumentTemplate.Draft.DocumentTemplateDraftDetailJM import Data.Aeson import Shared.Common.Util.Aeson +import Wizard.Api.Resource.Branch.BranchSuggestionJM () import Wizard.Api.Resource.Questionnaire.QuestionnaireSuggestionJM () import Wizard.Model.DocumentTemplate.DocumentTemplateDraftDetail import WizardLib.DocumentTemplate.Model.DocumentTemplate.DocumentTemplateJM () 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 c04442eae..00cc202a2 100644 --- a/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDetailSM.hs +++ b/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Draft/DocumentTemplateDraftDetailSM.hs @@ -3,6 +3,7 @@ module Wizard.Api.Resource.DocumentTemplate.Draft.DocumentTemplateDraftDetailSM import Data.Swagger import Shared.Common.Util.Swagger +import Wizard.Api.Resource.Branch.BranchSuggestionSM () import Wizard.Api.Resource.DocumentTemplate.Draft.DocumentTemplateDraftDetailJM () import Wizard.Api.Resource.Questionnaire.QuestionnaireSuggestionSM () import Wizard.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplateDrafts @@ -13,4 +14,4 @@ import WizardLib.DocumentTemplate.Database.Migration.Development.DocumentTemplat import WizardLib.KnowledgeModel.Api.Resource.Package.PackagePatternSM () instance ToSchema DocumentTemplateDraftDetail where - declareNamedSchema = toSwagger (toDraftDetail wizardDocumentTemplateDraft wizardDocumentTemplateDraftData Nothing) + declareNamedSchema = toSwagger (toDraftDetail wizardDocumentTemplateDraft wizardDocumentTemplateDraftData Nothing Nothing) diff --git a/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Folder/DocumentTemplateFolderDeleteDTO.hs b/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Folder/DocumentTemplateFolderDeleteDTO.hs new file mode 100644 index 000000000..06e7ea2fe --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Folder/DocumentTemplateFolderDeleteDTO.hs @@ -0,0 +1,8 @@ +module Wizard.Api.Resource.DocumentTemplate.Folder.DocumentTemplateFolderDeleteDTO where + +import GHC.Generics + +data DocumentTemplateFolderDeleteDTO = DocumentTemplateFolderDeleteDTO + { path :: String + } + deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Folder/DocumentTemplateFolderDeleteJM.hs b/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Folder/DocumentTemplateFolderDeleteJM.hs new file mode 100644 index 000000000..9b36fdbb3 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Folder/DocumentTemplateFolderDeleteJM.hs @@ -0,0 +1,12 @@ +module Wizard.Api.Resource.DocumentTemplate.Folder.DocumentTemplateFolderDeleteJM where + +import Data.Aeson + +import Shared.Common.Util.Aeson +import Wizard.Api.Resource.DocumentTemplate.Folder.DocumentTemplateFolderDeleteDTO + +instance FromJSON DocumentTemplateFolderDeleteDTO where + parseJSON = genericParseJSON jsonOptions + +instance ToJSON DocumentTemplateFolderDeleteDTO where + toJSON = genericToJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Folder/DocumentTemplateFolderDeleteSM.hs b/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Folder/DocumentTemplateFolderDeleteSM.hs new file mode 100644 index 000000000..e951d0e32 --- /dev/null +++ b/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Folder/DocumentTemplateFolderDeleteSM.hs @@ -0,0 +1,11 @@ +module Wizard.Api.Resource.DocumentTemplate.Folder.DocumentTemplateFolderDeleteSM where + +import Data.Swagger + +import Shared.Common.Util.Swagger +import Wizard.Api.Resource.DocumentTemplate.Folder.DocumentTemplateFolderDeleteDTO +import Wizard.Api.Resource.DocumentTemplate.Folder.DocumentTemplateFolderDeleteJM () +import Wizard.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplateFolders + +instance ToSchema DocumentTemplateFolderDeleteDTO where + declareNamedSchema = toSwagger folderDeleteDto diff --git a/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Folder/DocumentTemplateFolderMoveJM.hs b/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Folder/DocumentTemplateFolderMoveJM.hs index 3331800fb..c55e322a1 100644 --- a/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Folder/DocumentTemplateFolderMoveJM.hs +++ b/wizard-server/src/Wizard/Api/Resource/DocumentTemplate/Folder/DocumentTemplateFolderMoveJM.hs @@ -4,7 +4,6 @@ import Data.Aeson import Shared.Common.Util.Aeson import Wizard.Api.Resource.DocumentTemplate.Folder.DocumentTemplateFolderMoveDTO -import WizardLib.DocumentTemplate.Model.DocumentTemplate.DocumentTemplateJM () instance FromJSON DocumentTemplateFolderMoveDTO where parseJSON = genericParseJSON jsonOptions diff --git a/wizard-server/src/Wizard/Api/Resource/Websocket/BranchActionDTO.hs b/wizard-server/src/Wizard/Api/Resource/Websocket/BranchActionDTO.hs index 8a35acfdf..787526bf5 100644 --- a/wizard-server/src/Wizard/Api/Resource/Websocket/BranchActionDTO.hs +++ b/wizard-server/src/Wizard/Api/Resource/Websocket/BranchActionDTO.hs @@ -3,11 +3,16 @@ module Wizard.Api.Resource.Websocket.BranchActionDTO where import GHC.Generics import Wizard.Api.Resource.Branch.Event.BranchEventDTO +import Wizard.Api.Resource.Branch.Event.SetRepliesDTO import Wizard.Model.User.OnlineUserInfo -data ClientBranchActionDTO = SetContent_ClientBranchActionDTO - { aData :: BranchEventDTO - } +data ClientBranchActionDTO + = SetContent_ClientBranchActionDTO + { scData :: BranchEventDTO + } + | SetReplies_ClientBranchActionDTO + { srData :: SetRepliesDTO + } deriving (Show, Generic) data ServerBranchActionDTO @@ -17,4 +22,7 @@ data ServerBranchActionDTO | SetContent_ServerBranchActionDTO { scData :: BranchEventDTO } + | SetReplies_ServerBranchActionDTO + { srData :: SetRepliesDTO + } deriving (Show, Eq, Generic) diff --git a/wizard-server/src/Wizard/Api/Resource/Websocket/BranchActionJM.hs b/wizard-server/src/Wizard/Api/Resource/Websocket/BranchActionJM.hs index 3f42cbd7a..a0c0beb01 100644 --- a/wizard-server/src/Wizard/Api/Resource/Websocket/BranchActionJM.hs +++ b/wizard-server/src/Wizard/Api/Resource/Websocket/BranchActionJM.hs @@ -4,6 +4,7 @@ import Data.Aeson import Shared.Common.Util.Aeson import Wizard.Api.Resource.Branch.Event.BranchEventJM () +import Wizard.Api.Resource.Branch.Event.SetRepliesJM () import Wizard.Api.Resource.User.OnlineUserInfoJM () import Wizard.Api.Resource.Websocket.BranchActionDTO diff --git a/wizard-server/src/Wizard/Api/Resource/Websocket/BranchActionSM.hs b/wizard-server/src/Wizard/Api/Resource/Websocket/BranchActionSM.hs index 6fb6c9684..fd7530c22 100644 --- a/wizard-server/src/Wizard/Api/Resource/Websocket/BranchActionSM.hs +++ b/wizard-server/src/Wizard/Api/Resource/Websocket/BranchActionSM.hs @@ -4,6 +4,7 @@ import Data.Swagger import Shared.Common.Util.Swagger import Wizard.Api.Resource.Branch.Event.BranchEventSM () +import Wizard.Api.Resource.Branch.Event.SetRepliesSM () import Wizard.Api.Resource.User.OnlineUserInfoSM () import Wizard.Api.Resource.Websocket.BranchActionDTO import Wizard.Api.Resource.Websocket.BranchActionJM () diff --git a/wizard-server/src/Wizard/Database/DAO/Branch/BranchDAO.hs b/wizard-server/src/Wizard/Database/DAO/Branch/BranchDAO.hs index be0c9c8fb..730d176e9 100644 --- a/wizard-server/src/Wizard/Database/DAO/Branch/BranchDAO.hs +++ b/wizard-server/src/Wizard/Database/DAO/Branch/BranchDAO.hs @@ -16,8 +16,10 @@ import Shared.Common.Util.Logger import Wizard.Database.DAO.Common import Wizard.Database.Mapping.Branch.Branch () import Wizard.Database.Mapping.Branch.BranchList () +import Wizard.Database.Mapping.Branch.BranchSuggestion () import Wizard.Model.Branch.Branch import Wizard.Model.Branch.BranchList +import Wizard.Model.Branch.BranchSuggestion import Wizard.Model.Context.AppContext import Wizard.Model.Context.ContextLenses () @@ -81,6 +83,18 @@ findBranchesPage mQuery pageable sort = } return $ Page pageLabel metadata entities +findBranchSuggestionsPage :: Maybe String -> Pageable -> [Sort] -> AppContextM (Page BranchSuggestion) +findBranchSuggestionsPage mQuery pageable sort = do + tenantUuid <- asks currentTenantUuid + createFindEntitiesPageableQuerySortFn + entityName + pageLabel + pageable + sort + "uuid, name" + "WHERE name ~* ? AND tenant_uuid = ?" + [regexM mQuery, U.toString tenantUuid] + findBranchByUuid :: U.UUID -> AppContextM Branch findBranchByUuid uuid = do tenantUuid <- asks currentTenantUuid @@ -96,6 +110,11 @@ findBranchByKmId' kmId = do tenantUuid <- asks currentTenantUuid createFindEntityByFn' entityName [tenantQueryUuid tenantUuid, ("km_id", kmId)] +findBranchSuggestionByUuid' :: U.UUID -> AppContextM (Maybe BranchSuggestion) +findBranchSuggestionByUuid' uuid = do + tenantUuid <- asks currentTenantUuid + createFindEntityWithFieldsByFn' "uuid, name" entityName [tenantQueryUuid tenantUuid, ("uuid", U.toString uuid)] + countBranches :: AppContextM Int countBranches = do tenantUuid <- asks currentTenantUuid diff --git a/wizard-server/src/Wizard/Database/DAO/Branch/BranchDataDAO.hs b/wizard-server/src/Wizard/Database/DAO/Branch/BranchDataDAO.hs index 30559b5a3..28cf1a28c 100644 --- a/wizard-server/src/Wizard/Database/DAO/Branch/BranchDataDAO.hs +++ b/wizard-server/src/Wizard/Database/DAO/Branch/BranchDataDAO.hs @@ -8,6 +8,7 @@ import Database.PostgreSQL.Simple.ToField import Database.PostgreSQL.Simple.ToRow import GHC.Int +import qualified Data.Map as M import Shared.Common.Util.Logger import Shared.Common.Util.String (trim) import Wizard.Database.DAO.Common @@ -17,6 +18,7 @@ import Wizard.Model.Branch.BranchData import Wizard.Model.Branch.BranchDataLength import Wizard.Model.Context.AppContext import Wizard.Model.Context.ContextLenses () +import Wizard.Model.Questionnaire.QuestionnaireReply import WizardLib.KnowledgeModel.Model.Event.Event entityName = "branch_data" @@ -50,7 +52,7 @@ updateBranchDataById branchData = do tenantUuid <- asks currentTenantUuid let sql = fromString - "UPDATE branch_data SET branch_uuid = ?, metamodel_version = ?, events = ?, tenant_uuid = ?, created_at = ?, updated_at = ?, squashed = ? WHERE tenant_uuid = ? AND branch_uuid = ?;" + "UPDATE branch_data SET branch_uuid = ?, metamodel_version = ?, events = ?, tenant_uuid = ?, created_at = ?, updated_at = ?, squashed = ?, replies = ? WHERE tenant_uuid = ? AND branch_uuid = ?;" let params = toRow branchData ++ [toField tenantUuid, toField . U.toText $ branchData.branchUuid] @@ -70,6 +72,18 @@ appendBranchEventByUuid branchUuid events = do runDB action return () +updateRepliesByBranchUuid :: U.UUID -> M.Map String Reply -> AppContextM () +updateRepliesByBranchUuid branchUuid replies = do + tenantUuid <- asks currentTenantUuid + let sql = + fromString + "UPDATE branch_data SET replies = ?, updated_at = now() WHERE tenant_uuid = ? AND branch_uuid = ?" + let params = [toJSONField replies, toField tenantUuid, toField branchUuid] + logInsertAndUpdate sql params + let action conn = execute conn sql params + runDB action + return () + updateBranchEventsByUuid :: U.UUID -> [Event] -> AppContextM () updateBranchEventsByUuid branchUuid events = do let sql = fromString "UPDATE branch_data SET events = ?, squashed = true WHERE branch_uuid = ?" diff --git a/wizard-server/src/Wizard/Database/DAO/DocumentTemplate/DocumentTemplateDraftDAO.hs b/wizard-server/src/Wizard/Database/DAO/DocumentTemplate/DocumentTemplateDraftDAO.hs index 328b4fc00..2eacfd688 100644 --- a/wizard-server/src/Wizard/Database/DAO/DocumentTemplate/DocumentTemplateDraftDAO.hs +++ b/wizard-server/src/Wizard/Database/DAO/DocumentTemplate/DocumentTemplateDraftDAO.hs @@ -125,6 +125,30 @@ moveFolder documentTemplateId currentFolder newFolder = do let action conn = execute conn sql params runDB action +deleteFolder :: String -> String -> AppContextM Int64 +deleteFolder documentTemplateId path = do + tenantUuid <- asks currentTenantUuid + let sql = + fromString + "DELETE FROM document_template_asset \ + \WHERE tenant_uuid = ? \ + \ AND document_template_id = ? \ + \ AND starts_with(file_name, ?); \ + \ \ + \DELETE FROM document_template_file \ + \WHERE tenant_uuid = ? \ + \ AND document_template_id = ? \ + \ AND starts_with(file_name, ?);" + let paramsForOneUpdate = + [ toField tenantUuid + , toField documentTemplateId + , toField path + ] + let params = paramsForOneUpdate ++ paramsForOneUpdate + logQuery sql params + let action conn = execute conn sql params + runDB action + deleteDrafts :: AppContextM Int64 deleteDrafts = do tenantUuid <- asks currentTenantUuid diff --git a/wizard-server/src/Wizard/Database/DAO/DocumentTemplate/DocumentTemplateDraftDataDAO.hs b/wizard-server/src/Wizard/Database/DAO/DocumentTemplate/DocumentTemplateDraftDataDAO.hs index e5cc7281e..f4217fb06 100644 --- a/wizard-server/src/Wizard/Database/DAO/DocumentTemplate/DocumentTemplateDraftDataDAO.hs +++ b/wizard-server/src/Wizard/Database/DAO/DocumentTemplate/DocumentTemplateDraftDataDAO.hs @@ -29,7 +29,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 = ? WHERE tenant_uuid = ? AND document_template_id = ?" + "UPDATE document_template_draft_data SET document_template_id = ?, questionnaire_uuid = ?, format_uuid = ?, tenant_uuid = ?, created_at = ?, updated_at = ?, branch_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 @@ -46,6 +46,17 @@ unsetQuestionnaireFromDocumentTemplate qtnUuid = do let action conn = execute conn sql params runDB action +unsetBranchFromDocumentTemplate :: U.UUID -> AppContextM Int64 +unsetBranchFromDocumentTemplate qtnUuid = do + tenantUuid <- asks currentTenantUuid + let sql = + fromString + "UPDATE document_template_draft_data SET branch_uuid = null, format_uuid = null WHERE tenant_uuid = ? AND branch_uuid = ?" + let params = [toField tenantUuid, toField qtnUuid] + logQuery sql params + let action conn = execute conn sql params + runDB action + deleteDraftDatas :: AppContextM Int64 deleteDraftDatas = createDeleteEntitiesFn entityName diff --git a/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireFileDAO.hs b/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireFileDAO.hs index 9a9cde58b..1f56da83e 100644 --- a/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireFileDAO.hs +++ b/wizard-server/src/Wizard/Database/DAO/Questionnaire/QuestionnaireFileDAO.hs @@ -97,6 +97,15 @@ findQuestionnaireFilesByQuestionnaire qtnUuid = do tenantUuid <- asks currentTenantUuid createFindEntitiesWithFieldsByFn "uuid, file_name, content_type, file_size" entityName [tenantQueryUuid tenantUuid, ("questionnaire_uuid", U.toString qtnUuid)] +clearQuestionnaireFileCreatedBy :: U.UUID -> AppContextM () +clearQuestionnaireFileCreatedBy userUuid = do + let sql = fromString "UPDATE questionnaire_file SET created_by = null WHERE created_by = ?" + let params = [U.toString userUuid] + logInsertAndUpdate sql params + let action conn = execute conn sql params + runDB action + return () + findQuestionnaireFileByUuid :: U.UUID -> AppContextM QuestionnaireFile findQuestionnaireFileByUuid uuid = do tenantUuid <- asks currentTenantUuid diff --git a/wizard-server/src/Wizard/Database/Mapping/Branch/BranchData.hs b/wizard-server/src/Wizard/Database/Mapping/Branch/BranchData.hs index 1c4ccc164..e49501a25 100644 --- a/wizard-server/src/Wizard/Database/Mapping/Branch/BranchData.hs +++ b/wizard-server/src/Wizard/Database/Mapping/Branch/BranchData.hs @@ -6,6 +6,7 @@ import Database.PostgreSQL.Simple.FromRow import Database.PostgreSQL.Simple.ToField import Database.PostgreSQL.Simple.ToRow +import Wizard.Api.Resource.Questionnaire.QuestionnaireReplyJM () import Wizard.Model.Branch.BranchData import WizardLib.KnowledgeModel.Api.Resource.Event.EventJM () @@ -18,6 +19,7 @@ instance ToRow BranchData where , toField createdAt , toField updatedAt , toField squashed + , toJSONField replies ] instance FromRow BranchData where @@ -29,4 +31,5 @@ instance FromRow BranchData where createdAt <- field updatedAt <- field squashed <- field + replies <- fieldWith fromJSONField return $ BranchData {..} diff --git a/wizard-server/src/Wizard/Database/Mapping/Branch/BranchSuggestion.hs b/wizard-server/src/Wizard/Database/Mapping/Branch/BranchSuggestion.hs new file mode 100644 index 000000000..c97f7480a --- /dev/null +++ b/wizard-server/src/Wizard/Database/Mapping/Branch/BranchSuggestion.hs @@ -0,0 +1,7 @@ +module Wizard.Database.Mapping.Branch.BranchSuggestion where + +import Database.PostgreSQL.Simple + +import Wizard.Model.Branch.BranchSuggestion + +instance FromRow BranchSuggestion diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Branch/BranchSchemaMigration.hs b/wizard-server/src/Wizard/Database/Migration/Development/Branch/BranchSchemaMigration.hs index 126de1ea4..a29feb926 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/Branch/BranchSchemaMigration.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/Branch/BranchSchemaMigration.hs @@ -68,6 +68,7 @@ createBranchDataTable = do \ created_at timestamptz NOT NULL, \ \ updated_at timestamptz NOT NULL, \ \ squashed bool NOT NULL, \ + \ replies json NOT NULL, \ \ CONSTRAINT branch_data_pk PRIMARY KEY (branch_uuid, tenant_uuid), \ \ CONSTRAINT branch_data_branch_uuid_fk FOREIGN KEY (branch_uuid, tenant_uuid) REFERENCES branch (uuid, tenant_uuid), \ \ CONSTRAINT branch_data_tenant_uuid_fk FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) \ @@ -121,9 +122,9 @@ createGetBranchStateFn = do \ SELECT CASE \ \ WHEN knowledge_model_migration.migration_state ->> 'stateType' IS NOT NULL AND \ \ knowledge_model_migration.migration_state ->> 'stateType' != 'CompletedState' THEN 'BSMigrating' \ - \ WHEN jsonb_array_length(branch_data.events) > 0 THEN 'BSEdited' \ \ WHEN knowledge_model_migration.migration_state ->> 'stateType' IS NOT NULL AND \ \ knowledge_model_migration.migration_state ->> 'stateType' = 'CompletedState' THEN 'BSMigrated' \ + \ WHEN jsonb_array_length(branch_data.events) > 0 THEN 'BSEdited' \ \ WHEN fork_of_package_id != get_newest_package_2(fork_of_package_id, tenant_uuid, ARRAY['ReleasedPackagePhase', 'DeprecatedPackagePhase']) THEN 'BSOutdated' \ \ WHEN True THEN 'BSDefault' END \ \ INTO state; \ diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Branch/Data/BranchEvents.hs b/wizard-server/src/Wizard/Database/Migration/Development/Branch/Data/BranchEvents.hs index b82bfb023..00f6695cd 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/Branch/Data/BranchEvents.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/Branch/Data/BranchEvents.hs @@ -2,6 +2,8 @@ module Wizard.Database.Migration.Development.Branch.Data.BranchEvents where import Shared.Common.Util.Uuid import Wizard.Api.Resource.Branch.Event.BranchEventDTO +import Wizard.Api.Resource.Branch.Event.SetRepliesDTO +import Wizard.Database.Migration.Development.Questionnaire.Data.QuestionnaireReplies import WizardLib.KnowledgeModel.Database.Migration.Development.Event.Data.Events import WizardLib.KnowledgeModel.Model.Event.Event @@ -14,3 +16,10 @@ branchEvent1 = { uuid = u' "6858b0b6-bb6f-4e21-a0c2-6afc84950f7a" , event = AddKnowledgeModelEvent' a_km1 } + +setRepliesDTO :: SetRepliesDTO +setRepliesDTO = + SetRepliesDTO + { uuid = u' "91863e00-ae98-4bcf-aae6-03a5a801b4fa" + , replies = fReplies + } diff --git a/wizard-server/src/Wizard/Database/Migration/Development/Branch/Data/Branches.hs b/wizard-server/src/Wizard/Database/Migration/Development/Branch/Data/Branches.hs index 0608cd983..71ca33caf 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/Branch/Data/Branches.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/Branch/Data/Branches.hs @@ -1,6 +1,7 @@ module Wizard.Database.Migration.Development.Branch.Data.Branches where import Data.Either (rights) +import qualified Data.Map.Strict as M import Data.Maybe (fromJust) import Data.Time @@ -17,6 +18,7 @@ import Wizard.Model.Branch.Branch import Wizard.Model.Branch.BranchData import Wizard.Model.Branch.BranchList import Wizard.Model.Branch.BranchState +import Wizard.Model.Branch.BranchSuggestion import Wizard.Model.Tenant.Tenant import Wizard.Model.User.User import Wizard.Service.KnowledgeModel.Compilator.Compilator @@ -61,6 +63,13 @@ amsterdamBranch = , updatedAt = amsterdamBranchList.updatedAt } +amsterdamBranchSuggestion :: BranchSuggestion +amsterdamBranchSuggestion = + BranchSuggestion + { uuid = amsterdamBranchList.uuid + , name = amsterdamBranchList.name + } + amsterdamBranchData :: BranchData amsterdamBranchData = BranchData @@ -86,6 +95,7 @@ amsterdamBranchData = , AddAnswerEvent' a_km1_ch2_q3_aNo2 , AddAnswerEvent' a_km1_ch2_q3_aYes2 ] + , replies = M.empty , squashed = True , tenantUuid = defaultTenant.uuid , createdAt = amsterdamBranchList.createdAt @@ -132,6 +142,7 @@ amsterdamBranchDetail = , forkOfPackage = Just . PM.toSimpleDTO . SPM.toPackage $ netherlandsPackage , createdBy = amsterdamBranchList.createdBy , events = amsterdamBranchData.events + , replies = amsterdamBranchData.replies , knowledgeModel = amsterdamBranchKnowledgeModel , createdAt = amsterdamBranchList.createdAt , updatedAt = amsterdamBranchList.updatedAt @@ -184,6 +195,7 @@ differentBranchData = { branchUuid = differentBranch.uuid , metamodelVersion = kmMetamodelVersion , events = [] + , replies = M.empty , squashed = True , tenantUuid = differentTenant.uuid , createdAt = differentBranch.createdAt 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 5bb59cf5a..e07cf3160 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/Document/DocumentSchemaMigration.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/Document/DocumentSchemaMigration.hs @@ -40,7 +40,6 @@ createTables = do \ tenant_uuid uuid NOT NULL, \ \ file_size bigint, \ \ CONSTRAINT document_pk PRIMARY KEY (uuid, tenant_uuid), \ - \ CONSTRAINT document_questionnaire_uuid_fk FOREIGN KEY (questionnaire_uuid, tenant_uuid) REFERENCES questionnaire (uuid, tenant_uuid), \ \ CONSTRAINT document_document_template_id_fk FOREIGN KEY (document_template_id, tenant_uuid) REFERENCES document_template (id, tenant_uuid), \ \ CONSTRAINT document_created_by_fk FOREIGN KEY (created_by, tenant_uuid) REFERENCES user_entity (uuid, tenant_uuid), \ \ CONSTRAINT document_tenant_uuid_fk FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) \ 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 e15bd122b..8cb5774a6 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 @@ -18,6 +18,7 @@ wizardDocumentTemplateDraftData = DocumentTemplateDraftData { documentTemplateId = wizardDocumentTemplateDraft.tId , questionnaireUuid = Just questionnaire1.uuid + , branchUuid = Nothing , formatUuid = Just formatJson.uuid , tenantUuid = wizardDocumentTemplateDraft.tenantUuid , createdAt = wizardDocumentTemplateDraft.createdAt @@ -47,13 +48,16 @@ wizardDocumentTemplateDraftDataDTO :: DocumentTemplateDraftDataDTO wizardDocumentTemplateDraftDataDTO = DocumentTemplateDraftDataDTO { questionnaireUuid = wizardDocumentTemplateDraftDataEdited.questionnaireUuid - , formatUuid = wizardDocumentTemplateDraftDataEdited.formatUuid , questionnaire = Just . QuestionnaireMapper.toSuggestion $ questionnaire2 + , branchUuid = Nothing + , branch = Nothing + , formatUuid = wizardDocumentTemplateDraftDataEdited.formatUuid } wizardDocumentTemplateDraftDataChangeDTO :: DocumentTemplateDraftDataChangeDTO wizardDocumentTemplateDraftDataChangeDTO = DocumentTemplateDraftDataChangeDTO { questionnaireUuid = wizardDocumentTemplateDraftDataEdited.questionnaireUuid + , branchUuid = Nothing , formatUuid = wizardDocumentTemplateDraftDataEdited.formatUuid } diff --git a/wizard-server/src/Wizard/Database/Migration/Development/DocumentTemplate/Data/DocumentTemplateFolders.hs b/wizard-server/src/Wizard/Database/Migration/Development/DocumentTemplate/Data/DocumentTemplateFolders.hs index 8d35741f5..1aca2bd11 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/DocumentTemplate/Data/DocumentTemplateFolders.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/DocumentTemplate/Data/DocumentTemplateFolders.hs @@ -1,5 +1,6 @@ module Wizard.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplateFolders where +import Wizard.Api.Resource.DocumentTemplate.Folder.DocumentTemplateFolderDeleteDTO import Wizard.Api.Resource.DocumentTemplate.Folder.DocumentTemplateFolderMoveDTO folderMoveDto :: DocumentTemplateFolderMoveDTO @@ -8,3 +9,9 @@ folderMoveDto = { current = "src" , new = "src-new" } + +folderDeleteDto :: DocumentTemplateFolderDeleteDTO +folderDeleteDto = + DocumentTemplateFolderDeleteDTO + { path = "src" + } 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 5718e5c25..4ef769b69 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/DocumentTemplate/DocumentTemplateSchemaMigration.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/DocumentTemplate/DocumentTemplateSchemaMigration.hs @@ -115,8 +115,10 @@ createDraftDataTable = do \ tenant_uuid uuid NOT NULL, \ \ created_at timestamptz NOT NULL, \ \ updated_at timestamptz NOT NULL, \ + \ branch_uuid uuid, \ \ CONSTRAINT document_template_draft_data_pk PRIMARY KEY (document_template_id, tenant_uuid), \ \ CONSTRAINT document_template_draft_data_questionnaire_uuid_fk FOREIGN KEY (questionnaire_uuid, tenant_uuid) REFERENCES questionnaire (uuid, tenant_uuid), \ + \ CONSTRAINT document_template_draft_data_branch_uuid_fk FOREIGN KEY (branch_uuid, tenant_uuid) REFERENCES branch (uuid, tenant_uuid), \ \ CONSTRAINT document_template_draft_data_tenant_uuid_fk FOREIGN KEY (tenant_uuid) REFERENCES tenant (uuid) \ \);" let action conn = execute_ conn sql diff --git a/wizard-server/src/Wizard/Database/Migration/Development/User/Data/UserTokens.hs b/wizard-server/src/Wizard/Database/Migration/Development/User/Data/UserTokens.hs index 0bbeee550..b9018abdf 100644 --- a/wizard-server/src/Wizard/Database/Migration/Development/User/Data/UserTokens.hs +++ b/wizard-server/src/Wizard/Database/Migration/Development/User/Data/UserTokens.hs @@ -15,11 +15,11 @@ import WizardLib.Public.Service.UserToken.UserTokenMapper albertToken :: UserToken albertToken = UserToken - { uuid = u' "43d44c6a-d22e-4954-bee6-0fedc8c990df" + { uuid = u' "54ea072d-b5f9-4251-b3a4-ae177360509c" , name = "Token" , tType = LoginUserTokenType , userUuid = userAlbert.uuid - , value = "eyJhbGciOiJSUzI1NiJ9.eyJleHAiOjE3MzU4ODQyOTAsInRlbmFudFV1aWQiOiIwMDAwMDAwMC0wMDAwLTAwMDAtMDAwMC0wMDAwMDAwMDAwMDAiLCJ0b2tlblV1aWQiOiI0M2Q0NGM2YS1kMjJlLTQ5NTQtYmVlNi0wZmVkYzhjOTkwZGYiLCJ1c2VyVXVpZCI6ImVjNmY4ZTkwLTJhOTEtNDllYy1hYTNmLTllYWIyMjY3ZmM2NiIsInZlcnNpb24iOjR9.I39ofNurjfjDgeCgh3zFfrK6tC4KEQSOnxmvxY8lWFoO1szsKqKzWXQPfAnJzZF6tw6hS2Fj3p6xtvjHT-dzMcfP8DDzTO8bUua0l86u1jsVyNoqzM1V1SWcvfALah7_6WFcO9izXKvYV1VyL8ouTkaiTNxc365qeKFru6_wH5ts9vz3wcwvJaimeUEsacEacZXpmZGhs8zjVhzw9fluTyu_gOrx-58ci2JQJfQbP0JBfGhfhIxaVqBR25E-U8Zn1Tut-2mYHIcHx99iO6mbtllfOZHaUuwrrQYc6SLjY7ZNXFTFsjoagEVOdjeaU8MKLHvGum3cV7m7UVq8QMNi3KpRrLB7JRW8zG-GWZ1MRCRPrY9Otuevsb-jldQpJ6u-0fboYKHrJBIaQoCT0kEbtCS-hkgWeoCdezs-J94tJ7X5qNpjNrGl3aL6Z1xu01QH0DqpPKUatVPFleGcaaJmNWASHZWxN1_YZ6ZdlsYwFeiOm7MRGp8eY_LL0zDhJXEye0ridb0FG_PTbea_ztEbrcEulDffZWMhW4mJjkvDvrgwAvbkOMVfZJUwjbEsxp58KfRaJ6LTdIMSy69UNDl0k7HqF_v1Un84HchhZUmd_8nNV_EezMmV9an1wmzzjmQ0PhoZP0JQ05u96s7ciJo6mt0m8kz9YuYrHL0SN1HMA_E" + , value = "eyJhbGciOiJSUzI1NiJ9.eyJleHAiOjE3NzIxNTE2NzYsInRlbmFudFV1aWQiOiIwMDAwMDAwMC0wMDAwLTAwMDAtMDAwMC0wMDAwMDAwMDAwMDAiLCJ0b2tlblV1aWQiOiI1NGVhMDcyZC1iNWY5LTQyNTEtYjNhNC1hZTE3NzM2MDUwOWMiLCJ1c2VyVXVpZCI6ImVjNmY4ZTkwLTJhOTEtNDllYy1hYTNmLTllYWIyMjY3ZmM2NiIsInZlcnNpb24iOjR9.VRCclpdJZnvlVt3fLoHsyHeIKgcRP2ZKNOSH04pU_2LgnWCxoz7Ka3EAGhuDrkHBgzGJNSAAvXQ4NKeAYNp_CvRgNBRV1zab4oVB2xnyCIXuzOAR_Y2QQ2MTBsGiYhiPzwifqr1DoAXz9TGSqeEIwtkUQophBAmwvvTvD4u66WtejEllWPOcJYo6oODMIuhaa-tFpStr0SbnVjv6wRUsh6yqgcQ0NA_2_rbAQ7AwQP02FLrBGhTZJYWPmchqeH3KnZPUgbw9fq0gwwUVwhZ9m6UKz71jRjpYjk02nUc3qZK-R8FOmfwIqg70c6ymqWXNqp2n4UJnZPvXyOY9gzLcUPiiO0i1B8CkRqTcqH425BW-CCdAgYFEOCkiJlaDTDbeYMenetYz64gPSHVx9fezCFwp-hP7GN5TcIX5X59m82bSe2DrvL6fw3gMes34b22WyAa-w-sf0-FxRYLZ5eMzG0zdcQeDmN3W128o5cnVgMTntG779YX-L9ixz0YNt88wQgMzVyfZDXFQpLBSkR-aTSa-ZA__8r79oc9qBb10v1ChBAWyyUlzruzTOKe1h9sViAmGf-eUArkHXCvgnKSu-_40JxVs2DW0gdfX4ZY5gaUBuz38PsA9cgJue1pjDQCmp20UwwPaX8d-lS2GC8leDXNHhxT8yQbgBI-EqoHd-xk" , userAgent = "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/111.0.0.0 Safari/537.36" , sessionState = Nothing , expiresAt = dt' 2052 1 21 @@ -90,11 +90,11 @@ alternativeAlbertToken = nikolaToken :: UserToken nikolaToken = UserToken - { uuid = u' "82d27684-d6a2-4d25-a736-11110f1094ef" + { uuid = u' "240a04e9-3c8c-4631-8921-ccb1ae3ddfa3" , name = "Token" , tType = LoginUserTokenType , userUuid = userNikola.uuid - , value = "eyJhbGciOiJSUzI1NiJ9.eyJleHAiOjE3MzU4ODQyMzksInRlbmFudFV1aWQiOiIwMDAwMDAwMC0wMDAwLTAwMDAtMDAwMC0wMDAwMDAwMDAwMDAiLCJ0b2tlblV1aWQiOiI4MmQyNzY4NC1kNmEyLTRkMjUtYTczNi0xMTExMGYxMDk0ZWYiLCJ1c2VyVXVpZCI6IjMwZDQ4Y2Y0LThjOGEtNDk2Zi1iYWZlLTU4NWJkMjM4Zjc5OCIsInZlcnNpb24iOjR9.h8URlC98RayY9RmrPXNbP-P_mHBeLVD4qn-FqcApmCg0JZ7yQGIYUxS-KKrcjpVVw3iPq_rtXNtuHnrEqo6SNtH3zxArd9Eu0yMT9SDQE0UKRtc-czKu_7O1ZOg4ESphg5rZ1-mRxqPQnqnmnWAfauvpfVzOI8ctR_yTZ5lwxJ1h1loPb2ic1um8S727rFhYKHy7_E4wjSKV-WHIh5tMyx4M_7JsFIPrhLmPAIyULWgbvpzV9kwFeQP5l7NHxhdun2IQBEZGrNQRDyhsrScvsi9Z_cAqj4NXPf_f6qJRJy3nhOdZWoAVN4WAPhLA-j6Z2rCL1klu5q9h058hQ5kevJ13lFQ2dr3h9RFjHi42xCuziSnhgcIIYGjSii1gyURBNbnNVz3JqjmMPQ-ZTuUYenJlhTVcg2-iDqjy7LWqJ_y6nZeDjiPweofV6NAr1ZhWGspEjXRU-A2JzXUmZWM1ca3n3xgdIT8PWtVTcINBGaJS-p_ZG7-UVwmdsJsHMCPGEaPe25SQhoX18Ed7WbXivj3T928y7D9qg8Hh-n-dA1zk5RKjEXuArRfy2Zy-At4dXwp6bDzgLrj4TIfoKty5s78FFFMTDiudRnYjp9OmuuQoKvwk7-8il3HTM7QsJ1q2ZWW5Br8BNgevPAzuSCGWGuKFB7Eg_1C3waCaa8jtw0Q" + , value = "eyJhbGciOiJSUzI1NiJ9.eyJleHAiOjE3NzIxNTE0ODIsInRlbmFudFV1aWQiOiIwMDAwMDAwMC0wMDAwLTAwMDAtMDAwMC0wMDAwMDAwMDAwMDAiLCJ0b2tlblV1aWQiOiIyNDBhMDRlOS0zYzhjLTQ2MzEtODkyMS1jY2IxYWUzZGRmYTMiLCJ1c2VyVXVpZCI6IjMwZDQ4Y2Y0LThjOGEtNDk2Zi1iYWZlLTU4NWJkMjM4Zjc5OCIsInZlcnNpb24iOjR9.XuIEsqe7wyMY5TCPAyVjRgeInbqoBC0jFsbMfxZGhjofs5Fkmmw6wYMMUTnjBuCpReXdheJh3XIHDbtNCnAImkeIKdNKcQmagRgjZwIu-hvGMeGdRa5cC6O2Rycn_17LqqcHX4Oqz-xCXuoMK6zhrHH5InibRSfdWcPYuT3pVSwGFM1_CBA7FZxUjUoltVI7xPlGIHzYzmQsG_LM0_t_LuxRIq9hxKaGCEzM8f8R3jUgMW9dmcwiPF15rT1xCi_zlttd18MOOm5vogn_JssL2m9ckoOOz4LQKeE2KAiyEyb9ZJq_6enk7CiO02mkvWA1SvSNifcSV9zSY_rT1GAcmQxeMlQlx-9mD2cAZzcYq0guviyWlIlXCR8Ho6eHkGBMuubUIku8ZrNta-NRh-UUvfZ53H0LuBESVFNyJ8d0iVSmSIXYv0DHpWK4sCTOs4y7yFZEK6pMGXAJajg8z9bnZAYFhTkHAhnm30XOgt3qnt_0dy4B5XLv21g4-cfc_XjlSiqdPSAhh9eeznbzxpJCCEHLBUVWzgkRW9rbRPA49sgTAcIt36bZKjVsNqHtbiQEAg54ON4ZVQkRDMiVZKWVFIZIEBhRJxpy6bJ04V8p9WyPH1Losb9-dVUsFGfeDnDRErpCgteauWvpZWO6HnCiSZEiwCsIxXKpe61Zgk3atxM" , userAgent = "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/111.0.0.0 Safari/537.36" , sessionState = Nothing , expiresAt = dt' 2052 1 21 @@ -109,11 +109,11 @@ nikolaCreateToken = isaacToken :: UserToken isaacToken = UserToken - { uuid = u' "375c8f62-23d5-4d48-97af-c13f3e12a753" + { uuid = u' "a352fdfe-70ff-4ba1-a98e-4d5cf0c5da4e" , name = "Token" , tType = LoginUserTokenType , userUuid = userIsaac.uuid - , value = "eyJhbGciOiJSUzI1NiJ9.eyJleHAiOjE3MzU4ODQxNTYsInRlbmFudFV1aWQiOiIwMDAwMDAwMC0wMDAwLTAwMDAtMDAwMC0wMDAwMDAwMDAwMDAiLCJ0b2tlblV1aWQiOiIzNzVjOGY2Mi0yM2Q1LTRkNDgtOTdhZi1jMTNmM2UxMmE3NTMiLCJ1c2VyVXVpZCI6ImUxYzU4ZTUyLTA4MjQtNDUyNi04ZWJlLWVjMzhlZWM2NzAzMCIsInZlcnNpb24iOjR9.2JOxUk56morspsoQQedYPdZ9jK5KAa4Mftj1ZSfvsfhBzxyr--aWK-kirX_m8rkJSn8pjFY476qD13ulQWyO7b_YzlhacCrRpoezkqUmzH-a9vI1WqyeApXAsFCLF0XAFke7Yg9HzzS4QQ5MIKQPGyTUi_-VSGtM1xvX1g1IOXZpHs5k5Re2VH76IXt0RXjOXb0LyhYJNFf9uVSKhgjmNb76dTKY5d2fr-Q3Ztjns_C0zpMzZykTvGOI-J3JFqa9if_E6zXwb9GL-_dpjR1yPw36NL8GxKvFHsogPFUUBUc6-Or2Wk8G6o3ifKXzl78MN2sKJwc6iwxxaITq3gB435kWG-yijhmNlPynjzer9o2XXNqUB0Kg2PtV_U9V_VIwB0RGGM_Le1YKSXxvroftQaBP8O62zL_o0bHkH6Ip6rVCotUpO4r3V4aUpGTsy_MhjrUxO5P8To1Ac6FX31petgtIquQKdMAcAeZrkc6NeEEEXtsTrxVE1QnWBsszhao1NUCh9XuRIhtpOirUoJ0mP8RZCDTrIEEDzZXbPRm-D-A_BhH1NV7uuVMdHPz8EtplKmAZ-PQjlnXG8awtz4PO77KDW1amLQHjvhF2WyQvzRdXndr-EOOu3ppSBvwiTmx0hJHXhS2o5eGmuOblKYnZt-GtPXJKqTj4O4Zrpxm7vzg" + , value = "eyJhbGciOiJSUzI1NiJ9.eyJleHAiOjE3NzIxNTE1ODQsInRlbmFudFV1aWQiOiIwMDAwMDAwMC0wMDAwLTAwMDAtMDAwMC0wMDAwMDAwMDAwMDAiLCJ0b2tlblV1aWQiOiJhMzUyZmRmZS03MGZmLTRiYTEtYTk4ZS00ZDVjZjBjNWRhNGUiLCJ1c2VyVXVpZCI6ImUxYzU4ZTUyLTA4MjQtNDUyNi04ZWJlLWVjMzhlZWM2NzAzMCIsInZlcnNpb24iOjR9.2KKh8adCGkpoQxOsHIpxEwkAPXzXGo6s5rWqbije2YpafCY2a9-pUFGktQUTf88FL1rIvo6MKtKGag3FkG6s2jnazyIdQqCfqzmxfyo5KphRHywEHaHJ39PXtxsHspvE4nZ367K9uz6XHU6f7MLo5-3WiIqB1RSwelUDt1rBVzbOFo3TrP7FLlawmDMvbGTojiBq4VO98Y8X3c6TIq_6h807CNNumm7d1yOee1Nao7BCPbUokncAvRiDJ4qkUWhdYesYz0KgSbdgTqUPcy5IjO_une00IECI9H2Rl2k6wjxqgrkKqdI36I-kDDFsUeRmrEWSt-EPfkRNZjXbAxyms-4UfTnRwv-BFgTo5S_xGdPiuAYdODdNgLzO2qbjMaUbPPFO2qIBeiV1X54veIb5D6H7WY7YRJH7Z8NhHLT8_941cTctAmvwvYWsOEOdN1rSXbEbk-wC6-ODvgCW6HbCddbZr0tIRNF3BZTbi6CX3apl4OcUE-nSU494qD1FAwYWux-hlNy-r1nMjmDoB0BKMNHgRv6AjobnWjQFru9s4iXZ3tdqXcfPifS16FHd_OYWLQOyVf2W-vnW9AznstqyMDjn_jjCtvjGh2ClTtrlLypO_U0n_TLlHihyJgnQRstWOcUqZJb8SVcnXDDLeyoRwZtTv-0vexywcq-Iogw5870" , userAgent = "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/111.0.0.0 Safari/537.36" , sessionState = Nothing , expiresAt = dt' 2052 1 21 diff --git a/wizard-server/src/Wizard/Database/Migration/Production/Migration.hs b/wizard-server/src/Wizard/Database/Migration/Production/Migration.hs index 90382631d..b0f098dbd 100644 --- a/wizard-server/src/Wizard/Database/Migration/Production/Migration.hs +++ b/wizard-server/src/Wizard/Database/Migration/Production/Migration.hs @@ -52,6 +52,7 @@ import qualified Wizard.Database.Migration.Production.Migration_0047_qtnCommentA import qualified Wizard.Database.Migration.Production.Migration_0048_jsonb.Migration as M_0048 import qualified Wizard.Database.Migration.Production.Migration_0049_questionnaireFile.Migration as M_0049 import qualified Wizard.Database.Migration.Production.Migration_0050_kmValidation.Migration as M_0050 +import qualified Wizard.Database.Migration.Production.Migration_0051_branchState.Migration as M_0051 migrationDefinitions :: [MigrationDefinition] migrationDefinitions = @@ -105,4 +106,5 @@ migrationDefinitions = , M_0048.definition , M_0049.definition , M_0050.definition + , M_0051.definition ] diff --git a/wizard-server/src/Wizard/Database/Migration/Production/Migration_0051_branchState/Migration.hs b/wizard-server/src/Wizard/Database/Migration/Production/Migration_0051_branchState/Migration.hs new file mode 100644 index 000000000..6a72d2051 --- /dev/null +++ b/wizard-server/src/Wizard/Database/Migration/Production/Migration_0051_branchState/Migration.hs @@ -0,0 +1,74 @@ +module Wizard.Database.Migration.Production.Migration_0051_branchState.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 = 51, mmName = "Branch State", mmDescription = "Fix branch get state"} + +migrate :: Pool Connection -> LoggingT IO (Maybe Error) +migrate dbPool = do + fixBranchGetStateFn dbPool + addRepliesToBranchData dbPool + removeDocumentQuestionnaireForeignKey dbPool + addBranchUuidtoDraftData dbPool + updateMetamodelVersionForDocumentTemplateEditor dbPool + +fixBranchGetStateFn dbPool = do + let sql = + "CREATE or REPLACE FUNCTION get_branch_state(knowledge_model_migration knowledge_model_migration, \ + \ branch_data branch_data, \ + \ fork_of_package_id varchar, \ + \ tenant_uuid uuid) \ + \ RETURNS varchar \ + \ LANGUAGE plpgsql \ + \AS \ + \$$ \ + \DECLARE \ + \ state varchar; \ + \BEGIN \ + \ SELECT CASE \ + \ WHEN knowledge_model_migration.migration_state ->> 'stateType' IS NOT NULL AND \ + \ knowledge_model_migration.migration_state ->> 'stateType' != 'CompletedState' THEN 'BSMigrating' \ + \ WHEN knowledge_model_migration.migration_state ->> 'stateType' IS NOT NULL AND \ + \ knowledge_model_migration.migration_state ->> 'stateType' = 'CompletedState' THEN 'BSMigrated' \ + \ WHEN jsonb_array_length(branch_data.events) > 0 THEN 'BSEdited' \ + \ WHEN fork_of_package_id != get_newest_package_2(fork_of_package_id, tenant_uuid, ARRAY['ReleasedPackagePhase', 'DeprecatedPackagePhase']) THEN 'BSOutdated' \ + \ WHEN True THEN 'BSDefault' END \ + \ INTO state; \ + \ RETURN state; \ + \END; \ + \$$;" + let action conn = execute_ conn sql + liftIO $ withResource dbPool action + return Nothing + +addRepliesToBranchData dbPool = do + let sql = "ALTER TABLE branch_data ADD COLUMN replies json NOT NULL DEFAULT '{}';" + let action conn = execute_ conn sql + liftIO $ withResource dbPool action + return Nothing + +removeDocumentQuestionnaireForeignKey dbPool = do + let sql = "ALTER TABLE document DROP CONSTRAINT document_questionnaire_uuid_fk;" + let action conn = execute_ conn sql + liftIO $ withResource dbPool action + return Nothing + +addBranchUuidtoDraftData dbPool = do + let sql = "ALTER TABLE document_template_draft_data ADD COLUMN branch_uuid uuid;" + let action conn = execute_ conn sql + liftIO $ withResource dbPool action + return Nothing + +updateMetamodelVersionForDocumentTemplateEditor dbPool = do + let sql = "UPDATE document_template SET metamodel_version = 16 WHERE phase = 'DraftDocumentTemplatePhase';" + let action conn = execute_ conn sql + liftIO $ withResource dbPool action + return Nothing diff --git a/wizard-server/src/Wizard/Model/Branch/BranchData.hs b/wizard-server/src/Wizard/Model/Branch/BranchData.hs index f985d99ec..04dbb4766 100644 --- a/wizard-server/src/Wizard/Model/Branch/BranchData.hs +++ b/wizard-server/src/Wizard/Model/Branch/BranchData.hs @@ -1,15 +1,18 @@ module Wizard.Model.Branch.BranchData where +import qualified Data.Map.Strict as M import Data.Time import qualified Data.UUID as U import GHC.Generics +import Wizard.Model.Questionnaire.QuestionnaireReply import WizardLib.KnowledgeModel.Model.Event.Event data BranchData = BranchData { branchUuid :: U.UUID , metamodelVersion :: Int , events :: [Event] + , replies :: M.Map String Reply , squashed :: Bool , tenantUuid :: U.UUID , createdAt :: UTCTime diff --git a/wizard-server/src/Wizard/Model/Branch/BranchSuggestion.hs b/wizard-server/src/Wizard/Model/Branch/BranchSuggestion.hs new file mode 100644 index 000000000..9b749c2df --- /dev/null +++ b/wizard-server/src/Wizard/Model/Branch/BranchSuggestion.hs @@ -0,0 +1,10 @@ +module Wizard.Model.Branch.BranchSuggestion where + +import qualified Data.UUID as U +import GHC.Generics + +data BranchSuggestion = BranchSuggestion + { uuid :: U.UUID + , name :: String + } + deriving (Generic, Eq, Show) diff --git a/wizard-server/src/Wizard/Model/DocumentTemplate/DocumentTemplateDraftData.hs b/wizard-server/src/Wizard/Model/DocumentTemplate/DocumentTemplateDraftData.hs index 55a8310af..c9636c808 100644 --- a/wizard-server/src/Wizard/Model/DocumentTemplate/DocumentTemplateDraftData.hs +++ b/wizard-server/src/Wizard/Model/DocumentTemplate/DocumentTemplateDraftData.hs @@ -11,6 +11,7 @@ data DocumentTemplateDraftData = DocumentTemplateDraftData , tenantUuid :: U.UUID , createdAt :: UTCTime , updatedAt :: UTCTime + , branchUuid :: Maybe U.UUID } deriving (Show, Generic) @@ -18,5 +19,6 @@ instance Eq DocumentTemplateDraftData where a == b = a.documentTemplateId == b.documentTemplateId && a.questionnaireUuid == b.questionnaireUuid + && a.branchUuid == b.branchUuid && 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 eb79fc4fe..072f0a44b 100644 --- a/wizard-server/src/Wizard/Model/DocumentTemplate/DocumentTemplateDraftDetail.hs +++ b/wizard-server/src/Wizard/Model/DocumentTemplate/DocumentTemplateDraftDetail.hs @@ -4,6 +4,7 @@ import Data.Time import qualified Data.UUID as U import GHC.Generics +import Wizard.Model.Branch.BranchSuggestion import Wizard.Model.Questionnaire.QuestionnaireSuggestion import WizardLib.DocumentTemplate.Model.DocumentTemplate.DocumentTemplate import WizardLib.KnowledgeModel.Model.Package.PackagePattern @@ -19,8 +20,10 @@ data DocumentTemplateDraftDetail = DocumentTemplateDraftDetail , allowedPackages :: [PackagePattern] , formats :: [DocumentTemplateFormat] , questionnaireUuid :: Maybe U.UUID - , formatUuid :: Maybe U.UUID , questionnaire :: Maybe QuestionnaireSuggestion + , branchUuid :: Maybe U.UUID + , branch :: Maybe BranchSuggestion + , formatUuid :: Maybe U.UUID , createdAt :: UTCTime , updatedAt :: UTCTime } diff --git a/wizard-server/src/Wizard/Service/Branch/BranchMapper.hs b/wizard-server/src/Wizard/Service/Branch/BranchMapper.hs index 5be96ac60..ce21a88ab 100644 --- a/wizard-server/src/Wizard/Service/Branch/BranchMapper.hs +++ b/wizard-server/src/Wizard/Service/Branch/BranchMapper.hs @@ -1,5 +1,6 @@ module Wizard.Service.Branch.BranchMapper where +import qualified Data.Map.Strict as M import Data.Time import qualified Data.UUID as U @@ -45,6 +46,7 @@ toDetailDTO branch branchData knowledgeModel mForkOfPackageId mForkOfPackage sta , forkOfPackageId = mForkOfPackageId , forkOfPackage = fmap toSimpleDTO mForkOfPackage , events = branchData.events + , replies = branchData.replies , knowledgeModel = knowledgeModel , createdBy = branch.createdBy , createdAt = branch.createdAt @@ -57,6 +59,7 @@ toBranchData branch = { branchUuid = branch.uuid , metamodelVersion = kmMetamodelVersion , events = [] + , replies = M.empty , squashed = True , tenantUuid = branch.tenantUuid , createdAt = branch.createdAt diff --git a/wizard-server/src/Wizard/Service/Branch/BranchService.hs b/wizard-server/src/Wizard/Service/Branch/BranchService.hs index 03945267b..867884828 100644 --- a/wizard-server/src/Wizard/Service/Branch/BranchService.hs +++ b/wizard-server/src/Wizard/Service/Branch/BranchService.hs @@ -18,11 +18,13 @@ import Wizard.Api.Resource.User.UserDTO import Wizard.Database.DAO.Branch.BranchDAO import Wizard.Database.DAO.Branch.BranchDataDAO import Wizard.Database.DAO.Common +import Wizard.Database.DAO.DocumentTemplate.DocumentTemplateDraftDataDAO import Wizard.Database.DAO.Migration.KnowledgeModel.MigratorDAO import Wizard.Model.Branch.Branch import Wizard.Model.Branch.BranchData import Wizard.Model.Branch.BranchList import Wizard.Model.Branch.BranchState +import Wizard.Model.Branch.BranchSuggestion import Wizard.Model.Context.AclContext import Wizard.Model.Context.AppContext import Wizard.Model.Context.AppContextHelpers @@ -43,6 +45,11 @@ getBranchesPage mQuery pageable sort = do checkPermission _KM_PERM findBranchesPage mQuery pageable sort +getBranchSuggestionsPage :: Maybe String -> Pageable -> [Sort] -> AppContextM (Page BranchSuggestion) +getBranchSuggestionsPage mQuery pageable sort = do + checkPermission _KM_PERM + findBranchSuggestionsPage mQuery pageable sort + createBranch :: BranchCreateDTO -> AppContextM BranchList createBranch reqDto = runInTransaction $ do @@ -137,6 +144,7 @@ deleteBranch branchUuid = runInTransaction $ do checkPermission _KM_PERM branch <- findBranchByUuid branchUuid + unsetBranchFromDocumentTemplate branchUuid deleteMigratorStateByBranchUuid branchUuid deleteBranchDataById branchUuid deleteBranchByUuid branchUuid diff --git a/wizard-server/src/Wizard/Service/Branch/Collaboration/CollaborationMapper.hs b/wizard-server/src/Wizard/Service/Branch/Collaboration/CollaborationMapper.hs index 0689d4ec4..ee4aaab25 100644 --- a/wizard-server/src/Wizard/Service/Branch/Collaboration/CollaborationMapper.hs +++ b/wizard-server/src/Wizard/Service/Branch/Collaboration/CollaborationMapper.hs @@ -1,6 +1,7 @@ module Wizard.Service.Branch.Collaboration.CollaborationMapper where import Wizard.Api.Resource.Branch.Event.BranchEventDTO +import Wizard.Api.Resource.Branch.Event.SetRepliesDTO import Wizard.Api.Resource.Websocket.BranchActionDTO import Wizard.Api.Resource.Websocket.WebsocketActionDTO import Wizard.Model.Websocket.WebsocketMessage @@ -27,3 +28,7 @@ toAddBranchMessage :: AddBranchEventDTO -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerBranchActionDTO) toAddBranchMessage reqDto record = toWebsocketMessage record $ Success_ServerActionDTO . SetContent_ServerBranchActionDTO . AddBranchEventDTO' $ reqDto + +toSetRepliesMessage :: SetRepliesDTO -> WebsocketRecord -> WebsocketMessage (Success_ServerActionDTO ServerBranchActionDTO) +toSetRepliesMessage reqDto record = + toWebsocketMessage record $ Success_ServerActionDTO . SetReplies_ServerBranchActionDTO $ reqDto diff --git a/wizard-server/src/Wizard/Service/Branch/Collaboration/CollaborationService.hs b/wizard-server/src/Wizard/Service/Branch/Collaboration/CollaborationService.hs index ec05dd43a..1b4769ab2 100644 --- a/wizard-server/src/Wizard/Service/Branch/Collaboration/CollaborationService.hs +++ b/wizard-server/src/Wizard/Service/Branch/Collaboration/CollaborationService.hs @@ -9,6 +9,7 @@ import Network.WebSockets (Connection) import Shared.Common.Model.Error.Error import Shared.Common.Util.Uuid import Wizard.Api.Resource.Branch.Event.BranchEventDTO +import Wizard.Api.Resource.Branch.Event.SetRepliesDTO import Wizard.Api.Resource.Websocket.BranchActionJM () import Wizard.Api.Resource.Websocket.WebsocketActionJM () import Wizard.Cache.BranchWebsocketCache @@ -70,6 +71,15 @@ addBranchEvent branchUuid connectionUuid reqDto = do records <- getAllFromCache broadcast (U.toString branchUuid) records (toAddBranchMessage reqDto) disconnectUser +-- -------------------------------- +setReplies :: U.UUID -> U.UUID -> SetRepliesDTO -> AppContextM () +setReplies branchUuid connectionUuid reqDto = do + myself <- getFromCache' connectionUuid + checkEditPermission myself + updateRepliesByBranchUuid branchUuid reqDto.replies + records <- getAllFromCache + broadcast (U.toString branchUuid) records (toSetRepliesMessage reqDto) disconnectUser + -- -------------------------------- disconnectUser :: ToJSON resDto => WebsocketMessage resDto -> AppContextM () disconnectUser msg = deleteUser (u' msg.entityId) msg.connectionUuid diff --git a/wizard-server/src/Wizard/Service/Document/Context/DocumentContextMapper.hs b/wizard-server/src/Wizard/Service/Document/Context/DocumentContextMapper.hs index 90e729050..d05b51d10 100644 --- a/wizard-server/src/Wizard/Service/Document/Context/DocumentContextMapper.hs +++ b/wizard-server/src/Wizard/Service/Document/Context/DocumentContextMapper.hs @@ -1,5 +1,6 @@ module Wizard.Service.Document.Context.DocumentContextMapper where +import qualified Data.Map.Strict as M import qualified Data.UUID as U import Wizard.Api.Resource.Package.PackageSimpleDTO @@ -7,8 +8,8 @@ import Wizard.Api.Resource.Questionnaire.Version.QuestionnaireVersionDTO import Wizard.Model.Document.Document import Wizard.Model.Document.DocumentContext import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireContent import Wizard.Model.Questionnaire.QuestionnaireFileSimple +import Wizard.Model.Questionnaire.QuestionnaireReply import Wizard.Model.Report.Report import Wizard.Model.Tenant.Config.TenantConfig import Wizard.Model.User.User @@ -22,7 +23,9 @@ toDocumentContext :: Document -> String -> Questionnaire - -> QuestionnaireContent + -> Maybe U.UUID + -> M.Map String Reply + -> M.Map String [U.UUID] -> Maybe U.UUID -> [QuestionnaireVersionDTO] -> [QuestionnaireFileSimple] @@ -35,7 +38,7 @@ toDocumentContext -> [DocumentContextUserPerm] -> [DocumentContextUserGroupPerm] -> DocumentContext -toDocumentContext doc appClientUrl qtn qtnCtn qtnVersion qtnVersionDtos qtnFiles km report pkg org mQtnCreatedBy mDocCreatedBy users groups = +toDocumentContext doc appClientUrl qtn phaseUuid replies labels qtnVersion qtnVersionDtos qtnFiles km report pkg org mQtnCreatedBy mDocCreatedBy users groups = DocumentContext { config = DocumentContextConfig {clientUrl = appClientUrl} , document = @@ -52,9 +55,9 @@ toDocumentContext doc appClientUrl qtn qtnCtn qtnVersion qtnVersionDtos qtnFiles { uuid = qtn.uuid , name = qtn.name , description = qtn.description - , replies = qtnCtn.replies - , phaseUuid = qtnCtn.phaseUuid - , labels = qtnCtn.labels + , replies = replies + , phaseUuid = phaseUuid + , labels = labels , versionUuid = qtnVersion , versions = qtnVersionDtos , projectTags = qtn.projectTags diff --git a/wizard-server/src/Wizard/Service/Document/Context/DocumentContextService.hs b/wizard-server/src/Wizard/Service/Document/Context/DocumentContextService.hs index 2b23cc593..47bc62785 100644 --- a/wizard-server/src/Wizard/Service/Document/Context/DocumentContextService.hs +++ b/wizard-server/src/Wizard/Service/Document/Context/DocumentContextService.hs @@ -5,14 +5,12 @@ module Wizard.Service.Document.Context.DocumentContextService ( import Control.Monad (forM) import Control.Monad.Reader (liftIO) import Data.Either (partitionEithers) +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 -import Wizard.Api.Resource.Acl.MemberDTO -import Wizard.Api.Resource.Questionnaire.QuestionnairePermDTO -import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO import Wizard.Database.DAO.Questionnaire.QuestionnaireFileDAO import Wizard.Database.DAO.User.UserDAO import Wizard.Model.Context.AppContext @@ -21,53 +19,59 @@ import Wizard.Model.Document.DocumentContext import Wizard.Model.Document.DocumentContextJM () import Wizard.Model.Questionnaire.Questionnaire import Wizard.Model.Questionnaire.QuestionnaireContent -import Wizard.Model.Questionnaire.QuestionnaireDetailSettings +import Wizard.Model.Questionnaire.QuestionnairePerm +import Wizard.Model.Questionnaire.QuestionnaireReply import Wizard.Model.Questionnaire.QuestionnaireVersion import Wizard.Model.Tenant.Config.TenantConfig import Wizard.Service.Document.Context.DocumentContextMapper import Wizard.Service.KnowledgeModel.KnowledgeModelService -import Wizard.Service.Package.PackageService import Wizard.Service.Questionnaire.Compiler.CompilerService import Wizard.Service.Questionnaire.QuestionnaireUtil import Wizard.Service.Report.ReportGenerator import Wizard.Service.Tenant.Config.ConfigService import Wizard.Service.Tenant.TenantHelper import qualified Wizard.Service.User.UserMapper as USR_Mapper +import WizardLib.KnowledgeModel.Model.Event.Event +import WizardLib.KnowledgeModel.Model.Package.Package 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 -> AppContextM DocumentContext -createDocumentContext doc = do - qtn <- findQuestionnaireByUuid doc.questionnaireUuid - qtnSettings <- findQuestionnaireDetailSettings doc.questionnaireUuid - pkg <- getPackageById qtn.packageId - km <- compileKnowledgeModel [] (Just qtn.packageId) qtn.selectedQuestionTagUuids +createDocumentContext :: Document -> Package -> [Event] -> Questionnaire -> Maybe (M.Map String Reply) -> AppContextM DocumentContext +createDocumentContext doc pkg branchEvents qtn mReplies = do + km <- compileKnowledgeModelWithCaching' branchEvents (Just qtn.packageId) qtn.selectedQuestionTagUuids (not . null $ branchEvents) mQtnCreatedBy <- forM qtn.creatorUuid findUserByUuid mDocCreatedBy <- forM doc.createdBy findUserByUuid tenantConfig <- getCurrentTenantConfig clientUrl <- getClientUrl let org = tenantConfig.organization now <- liftIO getCurrentTime - let qtnEvents = - case doc.questionnaireEventUuid of - Just eventUuid -> takeWhileInclusive (\e -> getUuid e /= eventUuid) qtn.events - Nothing -> qtn.events - qtnCtn <- compileQuestionnairePreview qtnEvents - report <- generateReport qtnCtn.phaseUuid km qtnCtn.replies + (phaseUuid, replies, labels) <- + case mReplies of + Just replies -> return (Nothing, replies, M.empty) + _ -> do + let qtnEvents = + case doc.questionnaireEventUuid of + Just eventUuid -> takeWhileInclusive (\e -> getUuid e /= eventUuid) qtn.events + Nothing -> qtn.events + qtnCtn <- compileQuestionnairePreview qtnEvents + return (qtnCtn.phaseUuid, qtnCtn.replies, qtnCtn.labels) + report <- generateReport phaseUuid km replies let qtnVersion = case doc.questionnaireEventUuid of (Just eventUuid) -> findQuestionnaireVersionUuid eventUuid qtn.versions _ -> Nothing qtnVersionDtos <- traverse enhanceQuestionnaireVersion qtn.versions qtnFiles <- findQuestionnaireFilesByQuestionnaire doc.questionnaireUuid - (users, groups) <- heSettingsToPerms qtnSettings + (users, groups) <- heSettingsToPerms qtn return $ toDocumentContext doc clientUrl qtn - qtnCtn + phaseUuid + replies + labels qtnVersion qtnVersionDtos qtnFiles @@ -89,24 +93,26 @@ findQuestionnaireVersionUuid desiredEventUuid (version : rest) | desiredEventUuid == version.eventUuid = Just $ version.uuid | otherwise = findQuestionnaireVersionUuid desiredEventUuid rest -heSettingsToPerms :: QuestionnaireDetailSettings -> AppContextM ([DocumentContextUserPerm], [DocumentContextUserGroupPerm]) -heSettingsToPerms qtnSettings = do - perms <- traverse heToDocumentContextPerm qtnSettings.permissions +heSettingsToPerms :: Questionnaire -> AppContextM ([DocumentContextUserPerm], [DocumentContextUserGroupPerm]) +heSettingsToPerms qtn = do + perms <- traverse heToDocumentContextPerm qtn.permissions return $ partitionEithers perms -heToDocumentContextPerm :: QuestionnairePermDTO -> AppContextM (Either DocumentContextUserPerm DocumentContextUserGroupPerm) -heToDocumentContextPerm perm@(QuestionnairePermDTO {perms = perms, member = UserMemberDTO {uuid = uuid}}) = do - user <- findUserByUuid uuid - return . Left $ - DocumentContextUserPerm - { user = USR_Mapper.toDTO user - , perms = perms - } -heToDocumentContextPerm perm@(QuestionnairePermDTO {perms = perms, member = UserGroupMemberDTO {uuid = uuid}}) = do - userGroup <- findUserGroupByUuid uuid - members <- findUsersByUserGroupUuid userGroup.uuid - return . Right $ - DocumentContextUserGroupPerm - { group = UGR_Mapper.toDetailDTO userGroup members - , perms = perms - } +heToDocumentContextPerm :: QuestionnairePerm -> AppContextM (Either DocumentContextUserPerm DocumentContextUserGroupPerm) +heToDocumentContextPerm perm = + case perm.memberType of + UserQuestionnairePermType -> do + user <- findUserByUuid perm.memberUuid + return . Left $ + DocumentContextUserPerm + { user = USR_Mapper.toDTO user + , perms = perm.perms + } + UserGroupQuestionnairePermType -> do + userGroup <- findUserGroupByUuid perm.memberUuid + members <- findUsersByUserGroupUuid userGroup.uuid + return . Right $ + DocumentContextUserGroupPerm + { group = UGR_Mapper.toDetailDTO userGroup members + , perms = perm.perms + } diff --git a/wizard-server/src/Wizard/Service/Document/DocumentMapper.hs b/wizard-server/src/Wizard/Service/Document/DocumentMapper.hs index ab5d3cef6..df8437f40 100644 --- a/wizard-server/src/Wizard/Service/Document/DocumentMapper.hs +++ b/wizard-server/src/Wizard/Service/Document/DocumentMapper.hs @@ -1,6 +1,7 @@ module Wizard.Service.Document.DocumentMapper where import qualified Data.List as L +import Data.Maybe (fromMaybe) import Data.Time import qualified Data.UUID as U @@ -14,8 +15,9 @@ import Wizard.Api.Resource.Document.DocumentCreateDTO import Wizard.Api.Resource.Document.DocumentDTO import Wizard.Api.Resource.Submission.SubmissionDTO import Wizard.Api.Resource.User.UserDTO +import Wizard.Model.Branch.Branch import Wizard.Model.Document.Document -import Wizard.Model.Document.DocumentContext (DocumentContext) +import Wizard.Model.Document.DocumentContext import Wizard.Model.Document.DocumentContextJM () import Wizard.Model.Document.DocumentList import Wizard.Model.Questionnaire.Questionnaire @@ -24,6 +26,8 @@ import Wizard.Model.Questionnaire.QuestionnaireEventLenses () import Wizard.Model.Questionnaire.QuestionnaireSimple import WizardLib.DocumentTemplate.Model.DocumentTemplate.DocumentTemplate import WizardLib.DocumentTemplate.Service.DocumentTemplate.DocumentTemplateMapper +import WizardLib.KnowledgeModel.Constant.KnowledgeModel +import WizardLib.KnowledgeModel.Model.Package.Package toDTO :: DocumentList -> [SubmissionDTO] -> DocumentDTO toDTO doc submissions = @@ -118,6 +122,51 @@ fromTemporallyCreateDTO docUuid qtn documentTemplateId formatUuid repliesHash mC , createdAt = now } +toTemporaryPackage :: U.UUID -> UTCTime -> Package +toTemporaryPackage tenantUuid createdAt = + Package + { pId = "org.example:km-example:1.0.0" + , name = "Example Knowledge Model" + , organizationId = "org.example" + , kmId = "km-example" + , version = "1.0.0" + , phase = ReleasedPackagePhase + , metamodelVersion = kmMetamodelVersion + , description = "Example description" + , readme = "# Example Knowledge Model\n\nThis is an example knowledge model." + , license = "Apache-2.0" + , previousPackageId = Nothing + , forkOfPackageId = Nothing + , mergeCheckpointPackageId = Nothing + , nonEditable = False + , tenantUuid = tenantUuid + , createdAt = createdAt + } + +toTemporaryQuestionnaire :: Branch -> Package -> Maybe UserDTO -> Questionnaire +toTemporaryQuestionnaire branch package mCurrentUser = + Questionnaire + { uuid = branch.uuid + , name = branch.name + , description = Just branch.description + , visibility = PrivateQuestionnaire + , sharing = RestrictedQuestionnaire + , packageId = fromMaybe package.pId branch.previousPackageId + , selectedQuestionTagUuids = [] + , projectTags = [] + , documentTemplateId = Nothing + , formatUuid = Nothing + , creatorUuid = fmap (.uuid) mCurrentUser + , permissions = [] + , events = [] + , versions = [] + , isTemplate = False + , squashed = True + , tenantUuid = branch.tenantUuid + , createdAt = branch.createdAt + , updatedAt = branch.updatedAt + } + toDocPersistentCommand :: U.UUID -> DocumentContext -> Document -> PersistentCommand U.UUID toDocPersistentCommand uuid docContext doc = toPersistentCommand diff --git a/wizard-server/src/Wizard/Service/Document/DocumentService.hs b/wizard-server/src/Wizard/Service/Document/DocumentService.hs index 71db5a225..309b0e686 100644 --- a/wizard-server/src/Wizard/Service/Document/DocumentService.hs +++ b/wizard-server/src/Wizard/Service/Document/DocumentService.hs @@ -7,6 +7,7 @@ import Data.Maybe (fromMaybe) import Data.Time import qualified Data.UUID as U +import qualified Data.Map as M import Shared.Common.Constant.Component import Shared.Common.Model.Common.Lens import Shared.Common.Model.Common.Page @@ -20,6 +21,8 @@ import Shared.PersistentCommand.Database.DAO.PersistentCommand.PersistentCommand import Wizard.Api.Resource.Document.DocumentCreateDTO import Wizard.Api.Resource.Document.DocumentDTO import Wizard.Api.Resource.TemporaryFile.TemporaryFileDTO +import Wizard.Database.DAO.Branch.BranchDAO +import Wizard.Database.DAO.Branch.BranchDataDAO import Wizard.Database.DAO.Common import Wizard.Database.DAO.Document.DocumentDAO import Wizard.Database.DAO.DocumentTemplate.DocumentTemplateDraftDAO @@ -27,11 +30,14 @@ import Wizard.Database.DAO.DocumentTemplate.DocumentTemplateDraftDataDAO import Wizard.Database.DAO.Questionnaire.QuestionnaireDAO import Wizard.Database.DAO.Submission.SubmissionDAO import Wizard.Localization.Messages.Public +import Wizard.Model.Branch.BranchData import Wizard.Model.Context.AclContext import Wizard.Model.Context.AppContext import Wizard.Model.Document.Document import Wizard.Model.DocumentTemplate.DocumentTemplateDraftData import Wizard.Model.Questionnaire.Questionnaire +import Wizard.Model.Questionnaire.QuestionnaireContent +import Wizard.Model.Questionnaire.QuestionnaireReply import Wizard.Model.Tenant.Config.TenantConfig import Wizard.S3.Document.DocumentS3 import Wizard.Service.Document.Context.DocumentContextService @@ -40,6 +46,7 @@ import Wizard.Service.Document.DocumentMapper import Wizard.Service.Document.DocumentUtil import Wizard.Service.DocumentTemplate.DocumentTemplateService import Wizard.Service.DocumentTemplate.DocumentTemplateValidation +import Wizard.Service.Package.PackageService import Wizard.Service.Questionnaire.Compiler.CompilerService import Wizard.Service.Questionnaire.QuestionnaireAcl import qualified Wizard.Service.TemporaryFile.TemporaryFileMapper as TemporaryFileMapper @@ -47,6 +54,8 @@ import Wizard.Service.TemporaryFile.TemporaryFileService import Wizard.Service.Tenant.Config.ConfigService import Wizard.Service.Tenant.Limit.LimitService import WizardLib.DocumentTemplate.Model.DocumentTemplate.DocumentTemplate +import WizardLib.KnowledgeModel.Model.Event.Event +import WizardLib.KnowledgeModel.Model.Package.Package getDocumentsPageDto :: Maybe U.UUID -> Maybe String -> Maybe String -> Pageable -> [Sort] -> AppContextM (Page DocumentDTO) getDocumentsPageDto mQuestionnaireUuid mDocumentTemplateId mQuery pageable sort = do @@ -83,10 +92,11 @@ createDocument reqDto = Nothing -> qtn.events qtnCtn <- compileQuestionnairePreview qtnEvents tenantConfig <- getCurrentTenantConfig - let repliesHash = computeHash qtn qtnCtn tenantConfig mCurrentUser - let doc = fromCreateDTO reqDto dUuid repliesHash qtn.events mCurrentUser tenantUuid now + let docContextHash = computeHash [] qtn qtnCtn.phaseUuid qtnCtn.replies tenantConfig mCurrentUser + let doc = fromCreateDTO reqDto dUuid docContextHash qtn.events mCurrentUser tenantUuid now insertDocument doc - publishToPersistentCommandQueue doc + pkg <- getPackageById qtn.packageId + publishToPersistentCommandQueue doc pkg [] qtn Nothing return $ toDTOWithDocTemplate doc (Just qtnSimple) Nothing [] tml deleteDocument :: U.UUID -> AppContextM () @@ -117,28 +127,40 @@ createDocumentPreviewForQtn qtnUuid = case (qtn.documentTemplateId, qtn.formatUuid) of (Just tmlId, Just formatUuid) -> do tml <- getDocumentTemplateByUuidAndPackageId tmlId (Just qtn.packageId) - createDocumentPreview tml qtn formatUuid + pkg <- getPackageById qtn.packageId + qtnCtn <- compileQuestionnaire qtn + createDocumentPreview tml pkg [] qtn qtnCtn.phaseUuid qtnCtn.replies formatUuid _ -> 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.formatUuid) of - (Just qtnUuid, Just formatUuid) -> do + case (draftData.questionnaireUuid, draftData.branchUuid, draftData.formatUuid) of + (Just qtnUuid, _, Just formatUuid) -> do draft <- findDraftById tmlId qtn <- findQuestionnaireByUuid qtnUuid + pkg <- getPackageById qtn.packageId checkViewPermissionToQtn qtn.visibility qtn.sharing qtn.permissions - createDocumentPreview draft qtn formatUuid + qtnCtn <- compileQuestionnaire qtn + createDocumentPreview draft pkg [] qtn qtnCtn.phaseUuid qtnCtn.replies formatUuid + (_, Just branchUuid, Just formatUuid) -> do + draft <- findDraftById tmlId + let pkg = toTemporaryPackage draft.tenantUuid draft.createdAt + branch <- findBranchByUuid branchUuid + branchData <- findBranchDataById branchUuid + checkPermission _KM_PERM + mCurrentUser <- asks currentUser + let qtn = toTemporaryQuestionnaire branch pkg mCurrentUser + createDocumentPreview draft pkg branchData.events qtn Nothing branchData.replies formatUuid _ -> throwError $ UserError _ERROR_SERVICE_DOCUMENT__QUESTIONNAIRE_OR_FORMAT_NOT_SET_UP -createDocumentPreview :: DocumentTemplate -> Questionnaire -> U.UUID -> AppContextM (Document, TemporaryFileDTO) -createDocumentPreview tml qtn formatUuid = do +createDocumentPreview :: DocumentTemplate -> Package -> [Event] -> Questionnaire -> Maybe U.UUID -> M.Map String Reply -> U.UUID -> AppContextM (Document, TemporaryFileDTO) +createDocumentPreview tml pkg branchEvents qtn phaseUuid replies formatUuid = do docs <- findDocumentsForCurrentTenantFiltered [("questionnaire_uuid", U.toString qtn.uuid), ("durability", "TemporallyDocumentDurability")] - qtnCtn <- compileQuestionnaire qtn tenantConfig <- getCurrentTenantConfig mCurrentUser <- asks currentUser - let repliesHash = computeHash qtn qtnCtn tenantConfig mCurrentUser + let repliesHash = computeHash branchEvents qtn phaseUuid replies tenantConfig mCurrentUser logDebugI _CMP_SERVICE ("Replies hash: " ++ show repliesHash) let matchingDocs = filter (\d -> d.questionnaireRepliesHash == repliesHash) docs case filter (filterAlreadyDoneDocument tml.tId formatUuid) matchingDocs of @@ -162,12 +184,12 @@ createDocumentPreview tml qtn formatUuid = do now <- liftIO getCurrentTime let doc = fromTemporallyCreateDTO dUuid qtn tml.tId formatUuid repliesHash mCurrentUser tenantConfig.uuid now insertDocument doc - publishToPersistentCommandQueue doc + publishToPersistentCommandQueue doc pkg branchEvents qtn (Just replies) return (doc, TemporaryFileMapper.emptyFileDTO) -publishToPersistentCommandQueue :: Document -> AppContextM () -publishToPersistentCommandQueue doc = do - docContext <- createDocumentContext doc +publishToPersistentCommandQueue :: Document -> Package -> [Event] -> Questionnaire -> Maybe (M.Map String Reply) -> AppContextM () +publishToPersistentCommandQueue doc pkg branchEvents qtn mReplies = do + docContext <- createDocumentContext doc pkg branchEvents qtn 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 3ed749979..7336f4dd9 100644 --- a/wizard-server/src/Wizard/Service/Document/DocumentUtil.hs +++ b/wizard-server/src/Wizard/Service/Document/DocumentUtil.hs @@ -10,10 +10,11 @@ import Wizard.Model.Context.AppContext import Wizard.Model.Document.Document import Wizard.Model.Document.DocumentList import Wizard.Model.Questionnaire.Questionnaire -import Wizard.Model.Questionnaire.QuestionnaireContent +import Wizard.Model.Questionnaire.QuestionnaireReply import Wizard.Model.Tenant.Config.TenantConfig import Wizard.Service.Document.DocumentMapper import Wizard.Service.Submission.SubmissionService +import WizardLib.KnowledgeModel.Model.Event.Event enhanceDocument :: TenantConfig -> DocumentList -> AppContextM DocumentDTO enhanceDocument tenantConfig doc = do @@ -27,15 +28,16 @@ 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 :: Questionnaire -> QuestionnaireContent -> TenantConfig -> Maybe UserDTO -> Int -computeHash qtn qtnCtn tenantConfig mCurrentUser = +computeHash :: [Event] -> Questionnaire -> Maybe U.UUID -> M.Map String Reply -> TenantConfig -> Maybe UserDTO -> Int +computeHash branchEvents qtn phaseUuid replies tenantConfig mCurrentUser = sum - [ hash $ qtn.name - , hash $ qtn.description - , hash $ qtn.versions - , hash $ qtn.projectTags - , hash $ tenantConfig.organization - , hash . M.toList $ qtnCtn.replies - , maybe 0 hash qtnCtn.phaseUuid + [ hash branchEvents + , hash qtn.name + , hash qtn.description + , hash qtn.versions + , hash qtn.projectTags + , maybe 0 hash phaseUuid + , hash . M.toList $ replies + , hash tenantConfig.organization , maybe 0 hash mCurrentUser ] diff --git a/wizard-server/src/Wizard/Service/DocumentTemplate/Draft/DocumentTemplateDraftMapper.hs b/wizard-server/src/Wizard/Service/DocumentTemplate/Draft/DocumentTemplateDraftMapper.hs index def61036c..6df964eb6 100644 --- a/wizard-server/src/Wizard/Service/DocumentTemplate/Draft/DocumentTemplateDraftMapper.hs +++ b/wizard-server/src/Wizard/Service/DocumentTemplate/Draft/DocumentTemplateDraftMapper.hs @@ -7,6 +7,7 @@ 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.Model.Branch.BranchSuggestion import Wizard.Model.DocumentTemplate.DocumentTemplateDraftData import Wizard.Model.DocumentTemplate.DocumentTemplateDraftDetail import Wizard.Model.DocumentTemplate.DocumentTemplateDraftList @@ -28,8 +29,8 @@ toDraftList tml = , updatedAt = tml.updatedAt } -toDraftDetail :: DocumentTemplate -> DocumentTemplateDraftData -> Maybe QuestionnaireSuggestion -> DocumentTemplateDraftDetail -toDraftDetail draft draftData mQestionnaire = +toDraftDetail :: DocumentTemplate -> DocumentTemplateDraftData -> Maybe QuestionnaireSuggestion -> Maybe BranchSuggestion -> DocumentTemplateDraftDetail +toDraftDetail draft draftData mQuestionnaire mBranch = DocumentTemplateDraftDetail { tId = draft.tId , name = draft.name @@ -41,8 +42,10 @@ toDraftDetail draft draftData mQestionnaire = , allowedPackages = draft.allowedPackages , formats = draft.formats , questionnaireUuid = draftData.questionnaireUuid + , questionnaire = mQuestionnaire + , branchUuid = draftData.branchUuid + , branch = mBranch , formatUuid = draftData.formatUuid - , questionnaire = mQestionnaire , createdAt = draft.createdAt , updatedAt = draft.updatedAt } @@ -60,18 +63,22 @@ toDraftDetail' draft = , allowedPackages = draft.allowedPackages , formats = draft.formats , questionnaireUuid = Nothing - , formatUuid = Nothing , questionnaire = Nothing + , branchUuid = Nothing + , branch = Nothing + , formatUuid = Nothing , createdAt = draft.createdAt , updatedAt = draft.updatedAt } -toDraftDataDTO :: DocumentTemplateDraftData -> Maybe QuestionnaireSuggestion -> DocumentTemplateDraftDataDTO -toDraftDataDTO draftData mQestionnaire = +toDraftDataDTO :: DocumentTemplateDraftData -> Maybe QuestionnaireSuggestion -> Maybe BranchSuggestion -> DocumentTemplateDraftDataDTO +toDraftDataDTO draftData mQuestionnaire mBranch = DocumentTemplateDraftDataDTO { questionnaireUuid = draftData.questionnaireUuid + , questionnaire = mQuestionnaire + , branchUuid = draftData.branchUuid + , branch = mBranch , formatUuid = draftData.formatUuid - , questionnaire = mQestionnaire } toChangeDTO :: DocumentTemplate -> DocumentTemplateDraftChangeDTO @@ -156,6 +163,7 @@ fromCreateDraftData draft = DocumentTemplateDraftData { documentTemplateId = draft.tId , questionnaireUuid = Nothing + , branchUuid = Nothing , formatUuid = Nothing , tenantUuid = draft.tenantUuid , createdAt = draft.createdAt @@ -167,6 +175,7 @@ fromDraftDataChangeDTO draftData reqDto = DocumentTemplateDraftData { documentTemplateId = draftData.documentTemplateId , questionnaireUuid = reqDto.questionnaireUuid + , branchUuid = reqDto.branchUuid , formatUuid = reqDto.formatUuid , tenantUuid = draftData.tenantUuid , createdAt = draftData.createdAt diff --git a/wizard-server/src/Wizard/Service/DocumentTemplate/Draft/DocumentTemplateDraftService.hs b/wizard-server/src/Wizard/Service/DocumentTemplate/Draft/DocumentTemplateDraftService.hs index af378d212..6bc1c3a7c 100644 --- a/wizard-server/src/Wizard/Service/DocumentTemplate/Draft/DocumentTemplateDraftService.hs +++ b/wizard-server/src/Wizard/Service/DocumentTemplate/Draft/DocumentTemplateDraftService.hs @@ -14,6 +14,7 @@ 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.DAO.Branch.BranchDAO import Wizard.Database.DAO.Common import Wizard.Database.DAO.Document.DocumentDAO import Wizard.Database.DAO.DocumentTemplate.DocumentTemplateDraftDAO @@ -85,7 +86,11 @@ getDraft tmlId = do case draftData.questionnaireUuid of Just qtnUuid -> findQuestionnaireSuggestionByUuid' qtnUuid Nothing -> return Nothing - return $ toDraftDetail draft draftData mQtnSuggestion + mBranchSuggestion <- + case draftData.branchUuid of + Just branchUuid -> findBranchSuggestionByUuid' branchUuid + Nothing -> return Nothing + return $ toDraftDetail draft draftData mQtnSuggestion mBranchSuggestion modifyDraft :: String -> DocumentTemplateDraftChangeDTO -> AppContextM DocumentTemplateDraftDetail modifyDraft tmlId reqDto = @@ -126,7 +131,11 @@ modifyDraftData tmlId reqDto = case updatedDraftData.questionnaireUuid of Just qtnUuid -> findQuestionnaireSuggestionByUuid' qtnUuid Nothing -> return Nothing - return $ toDraftDataDTO updatedDraftData mQtnSuggestion + mBranchSuggestion <- + case draftData.branchUuid of + Just branchUuid -> findBranchSuggestionByUuid' branchUuid + Nothing -> return Nothing + return $ toDraftDataDTO updatedDraftData mQtnSuggestion mBranchSuggestion deleteDraft :: String -> AppContextM () deleteDraft tmlId = diff --git a/wizard-server/src/Wizard/Service/DocumentTemplate/Folder/DocumentTemplateFolderService.hs b/wizard-server/src/Wizard/Service/DocumentTemplate/Folder/DocumentTemplateFolderService.hs index 5b854e1fe..89452c9bd 100644 --- a/wizard-server/src/Wizard/Service/DocumentTemplate/Folder/DocumentTemplateFolderService.hs +++ b/wizard-server/src/Wizard/Service/DocumentTemplate/Folder/DocumentTemplateFolderService.hs @@ -1,5 +1,6 @@ module Wizard.Service.DocumentTemplate.Folder.DocumentTemplateFolderService where +import Wizard.Api.Resource.DocumentTemplate.Folder.DocumentTemplateFolderDeleteDTO import Wizard.Api.Resource.DocumentTemplate.Folder.DocumentTemplateFolderMoveDTO import Wizard.Database.DAO.Common import Wizard.Database.DAO.Document.DocumentDAO @@ -17,3 +18,12 @@ moveDraftFolder documentTemplateId reqDto = touchDocumentTemplateById documentTemplateId deleteTemporalDocumentsByDocumentTemplateId documentTemplateId return () + +deleteDraftFolder :: String -> DocumentTemplateFolderDeleteDTO -> AppContextM () +deleteDraftFolder documentTemplateId reqDto = + runInTransaction $ do + checkPermission _DOC_TML_WRITE_PERM + deleteFolder documentTemplateId reqDto.path + touchDocumentTemplateById documentTemplateId + deleteTemporalDocumentsByDocumentTemplateId documentTemplateId + return () diff --git a/wizard-server/src/Wizard/Service/KnowledgeModel/KnowledgeModelService.hs b/wizard-server/src/Wizard/Service/KnowledgeModel/KnowledgeModelService.hs index e61c7cde7..34098d9cb 100644 --- a/wizard-server/src/Wizard/Service/KnowledgeModel/KnowledgeModelService.hs +++ b/wizard-server/src/Wizard/Service/KnowledgeModel/KnowledgeModelService.hs @@ -1,5 +1,6 @@ module Wizard.Service.KnowledgeModel.KnowledgeModelService where +import Control.Monad (when) import Control.Monad.Except (liftEither) import Control.Monad.Reader (asks) import qualified Data.UUID as U @@ -24,19 +25,27 @@ createKnowledgeModelPreview reqDto = do compileKnowledgeModel reqDto.events mResolvedPackageId reqDto.tagUuids compileKnowledgeModel :: [Event] -> Maybe String -> [U.UUID] -> AppContextM KnowledgeModel -compileKnowledgeModel events mPackageId tagUuids = do +compileKnowledgeModel events mPackageId tagUuids = compileKnowledgeModelWithCaching' events mPackageId tagUuids True + +compileKnowledgeModelWithCaching' :: [Event] -> Maybe String -> [U.UUID] -> Bool -> AppContextM KnowledgeModel +compileKnowledgeModelWithCaching' events mPackageId tagUuids useCache = do mResolvedPackageId <- traverse resolvePackageId mPackageId case (events, mResolvedPackageId) of ([], Just resolvedPackageId) -> do tenantUuid <- asks currentTenantUuid - mKm <- getFromCache (resolvedPackageId, tagUuids, tenantUuid) + mKm <- + if useCache + then getFromCache (resolvedPackageId, tagUuids, tenantUuid) + else return Nothing case mKm of Just km -> return km Nothing -> do allEvents <- getEvents mResolvedPackageId km <- liftEither $ compile Nothing allEvents let filteredKm = filterKnowledgeModel tagUuids km - addToCache (resolvedPackageId, tagUuids, tenantUuid) filteredKm + when + useCache + (addToCache (resolvedPackageId, tagUuids, tenantUuid) filteredKm) return filteredKm _ -> do allEvents <- getEvents mPackageId diff --git a/wizard-server/src/Wizard/Service/User/Profile/UserProfileMapper.hs b/wizard-server/src/Wizard/Service/User/Profile/UserProfileMapper.hs index 97be9990f..dd8843fd4 100644 --- a/wizard-server/src/Wizard/Service/User/Profile/UserProfileMapper.hs +++ b/wizard-server/src/Wizard/Service/User/Profile/UserProfileMapper.hs @@ -1,12 +1,10 @@ module Wizard.Service.User.Profile.UserProfileMapper where import Data.Char (toLower) -import qualified Data.Map.Strict as M import Data.Time (UTCTime) import Wizard.Api.Resource.User.UserProfileChangeDTO import Wizard.Api.Resource.User.UserSubmissionPropsDTO -import Wizard.Model.Tenant.Config.TenantConfig import Wizard.Model.User.User toUserSubmissionPropsDTO :: UserSubmissionProps -> String -> UserSubmissionPropsDTO @@ -45,19 +43,3 @@ fromUserSubmissionPropsDTO user submissionProps now = { submissionProps = fmap (\sp -> UserSubmissionProps {sId = sp.sId, values = sp.values}) submissionProps , updatedAt = now } - -fromService :: TenantConfigSubmissionService -> UserSubmissionPropsDTO -fromService service = - UserSubmissionPropsDTO - { sId = service.sId - , name = service.name - , values = M.fromList (fmap (\v -> (v, "")) service.props) - } - -fromUserSubmissionProps :: UserSubmissionProps -> UserSubmissionPropsDTO -fromUserSubmissionProps props = - UserSubmissionPropsDTO - { sId = props.sId - , name = "" - , values = props.values - } diff --git a/wizard-server/src/Wizard/Service/User/Profile/UserProfileService.hs b/wizard-server/src/Wizard/Service/User/Profile/UserProfileService.hs index 964d73873..fd281d8b4 100644 --- a/wizard-server/src/Wizard/Service/User/Profile/UserProfileService.hs +++ b/wizard-server/src/Wizard/Service/User/Profile/UserProfileService.hs @@ -1,13 +1,12 @@ module Wizard.Service.User.Profile.UserProfileService where import Control.Monad.Reader (asks, liftIO) +import qualified Data.List as L import qualified Data.Map.Strict as M -import Data.Maybe (fromMaybe) import Data.Time import qualified Data.UUID as U import Shared.Common.Model.Common.SensitiveData -import Shared.Common.Util.List (groupBy) import Wizard.Api.Resource.User.UserDTO import Wizard.Api.Resource.User.UserPasswordDTO import Wizard.Api.Resource.User.UserProfileChangeDTO @@ -50,16 +49,18 @@ getUserProfileSubmissionProps :: U.UUID -> AppContextM [UserSubmissionPropsDTO] getUserProfileSubmissionProps userUuid = do userDecrypted <- getDecryptedUser userUuid tenantConfig <- getCurrentTenantConfig - let userPropsFromService = fmap fromService tenantConfig.submission.services - let userPropsFromUser = fmap fromUserSubmissionProps userDecrypted.submissionProps - let groupedProps = groupBy (\p1 p2 -> p1.sId == p2.sId) (userPropsFromService ++ userPropsFromUser) - return $ fmap merge groupedProps + return . fmap (mapFn userDecrypted) $ tenantConfig.submission.services where - merge :: [UserSubmissionPropsDTO] -> UserSubmissionPropsDTO - merge [p] = p - merge [pFromService, pFromUser] = pFromService {values = M.mapWithKey (mergeFn pFromUser) pFromService.values} - mergeFn :: UserSubmissionPropsDTO -> String -> String -> String - mergeFn pFromUser k v = fromMaybe "" (M.lookup k pFromUser.values) + mapFn :: User -> TenantConfigSubmissionService -> UserSubmissionPropsDTO + mapFn userDecrypted service = + UserSubmissionPropsDTO + { sId = service.sId + , name = service.name + , values = + let defaultProps = M.fromList . fmap (\v -> (v, "")) $ service.props + userProps = maybe M.empty ((.values)) . L.find (\s -> s.sId == service.sId) $ userDecrypted.submissionProps + in M.union userProps defaultProps + } modifyUserProfileSubmissionProps :: [UserSubmissionPropsDTO] -> AppContextM [UserSubmissionPropsDTO] modifyUserProfileSubmissionProps reqDto = do diff --git a/wizard-server/src/Wizard/Service/User/UserService.hs b/wizard-server/src/Wizard/Service/User/UserService.hs index 7802ace34..56705ea2a 100644 --- a/wizard-server/src/Wizard/Service/User/UserService.hs +++ b/wizard-server/src/Wizard/Service/User/UserService.hs @@ -32,6 +32,7 @@ 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.QuestionnaireFileDAO import Wizard.Database.DAO.Questionnaire.QuestionnairePermDAO import Wizard.Database.DAO.User.UserDAO import Wizard.Database.Mapping.ActionKey.ActionKeyType () @@ -281,6 +282,7 @@ deleteUser userUuid = _ <- findUserByUuid userUuid deleteAuditByCreatedBy userUuid clearBranchCreatedBy userUuid + clearQuestionnaireFileCreatedBy userUuid deleteQuestionnairePermUserByUserUuid userUuid clearQuestionnaireCommentThreadAssignedTo userUuid clearQuestionnaireCommentThreadAssignedBy userUuid 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 37409e535..519b3c5f9 100644 --- a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Detail_GET.hs +++ b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Detail_GET.hs @@ -58,7 +58,7 @@ test_200 appContext = do -- GIVEN: Prepare expectation let expStatus = 200 let expHeaders = resCtHeader : resCorsHeaders - let expDto = toDraftDetail wizardDocumentTemplateDraft wizardDocumentTemplateDraftData (Just . toSuggestion $ questionnaire1) + let expDto = toDraftDetail wizardDocumentTemplateDraft wizardDocumentTemplateDraftData (Just . toSuggestion $ questionnaire1) Nothing let expBody = encode expDto -- AND: Run migrations runInContextIO TML_Migration.runMigration appContext diff --git a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Folder/APISpec.hs b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Folder/APISpec.hs index e3093cad3..28efe35ef 100644 --- a/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Folder/APISpec.hs +++ b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Folder/APISpec.hs @@ -4,9 +4,11 @@ import Test.Hspec import Test.Hspec.Wai hiding (shouldRespondWith) import Wizard.Specs.API.Common +import Wizard.Specs.API.DocumentTemplateDraft.Folder.List_Delete_POST import Wizard.Specs.API.DocumentTemplateDraft.Folder.List_Move_POST documentTemplateDraftFolderAPI baseContext appContext = with (startWebApp baseContext appContext) $ - describe "DOCUMENT TEMPLATE DRAFT FOLDER API Spec" $ + describe "DOCUMENT TEMPLATE DRAFT FOLDER API Spec" $ do + list_delete_POST appContext list_move_POST appContext 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 new file mode 100644 index 000000000..8247c500f --- /dev/null +++ b/wizard-server/test/Wizard/Specs/API/DocumentTemplateDraft/Folder/List_Delete_POST.hs @@ -0,0 +1,86 @@ +module Wizard.Specs.API.DocumentTemplateDraft.Folder.List_Delete_POST ( + list_delete_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 Wizard.Api.Resource.DocumentTemplate.File.DocumentTemplateFileChangeJM () +import Wizard.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplateFolders +import qualified Wizard.Database.Migration.Development.DocumentTemplate.DocumentTemplateMigration as TML_Migration +import Wizard.Model.Context.AppContext +import WizardLib.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplateAssets +import WizardLib.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplateFiles +import WizardLib.DocumentTemplate.Database.Migration.Development.DocumentTemplate.Data.DocumentTemplates +import WizardLib.DocumentTemplate.Model.DocumentTemplate.DocumentTemplate +import WizardLib.DocumentTemplate.Model.DocumentTemplate.DocumentTemplateJM () + +import SharedTest.Specs.API.Common +import Wizard.Specs.API.Common +import Wizard.Specs.API.DocumentTemplateDraft.Asset.Common +import Wizard.Specs.API.DocumentTemplateDraft.File.Common +import Wizard.Specs.Common + +-- ------------------------------------------------------------------------ +-- POST /wizard-api/document-template-drafts/{documentTemplateId}/folders/delete +-- ------------------------------------------------------------------------ +list_delete_POST :: AppContext -> SpecWith ((), Application) +list_delete_POST appContext = + describe "POST /wizard-api/document-template-drafts/{documentTemplateId}/folders/delete" $ do + test_204 appContext + test_401 appContext + test_403 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +reqMethod = methodPost + +reqUrl = "/wizard-api/document-template-drafts/global:questionnaire-report:1.0.0/folders/delete" + +reqHeadersT reqAuthHeader = [reqCtHeader, reqAuthHeader] + +reqDto = folderDeleteDto + +reqBody = encode reqDto + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_204 appContext = create_test_204 "HTTP 201 CREATED (user token)" appContext reqAuthHeader + +create_test_204 title appContext reqAuthHeader = + it title $ + -- GIVEN: Prepare request + do + let reqHeaders = reqHeadersT reqAuthHeader + -- AND: Prepare expectation + let expStatus = 204 + let expHeaders = resCtHeader : resCorsHeaders + let expBody = "" + -- AND: Run migrations + runInContextIO TML_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 result in DB and compare with expectation state + assertAbsenceOfTemplateFileInDB appContext fileDefaultHtml + assertExistenceOfTemplateFileInDB appContext fileDefaultCss wizardDocumentTemplate.tId + assertExistenceOfTemplateAssetInDB appContext assetLogo + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_401 appContext = createAuthTest reqMethod reqUrl [reqCtHeader] reqBody + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test_403 appContext = createNoPermissionTest appContext reqMethod reqUrl [reqCtHeader] reqBody "DOC_TML_WRITE_PERM" diff --git a/wizard-server/test/Wizard/Specs/API/Token/Detail_DELETE.hs b/wizard-server/test/Wizard/Specs/API/Token/Detail_DELETE.hs index 1b16f6ff0..bb609f0c6 100644 --- a/wizard-server/test/Wizard/Specs/API/Token/Detail_DELETE.hs +++ b/wizard-server/test/Wizard/Specs/API/Token/Detail_DELETE.hs @@ -30,7 +30,7 @@ detail_DELETE appContext = -- ---------------------------------------------------- reqMethod = methodDelete -reqUrl = "/wizard-api/tokens/43d44c6a-d22e-4954-bee6-0fedc8c990df" +reqUrl = "/wizard-api/tokens/54ea072d-b5f9-4251-b3a4-ae177360509c" reqHeaders = [reqAuthHeader] diff --git a/wizard-server/test/Wizard/Specs/Service/Document/DocumentServiceSpec.hs b/wizard-server/test/Wizard/Specs/Service/Document/DocumentServiceSpec.hs index 8a96aa330..c7f76faec 100644 --- a/wizard-server/test/Wizard/Specs/Service/Document/DocumentServiceSpec.hs +++ b/wizard-server/test/Wizard/Specs/Service/Document/DocumentServiceSpec.hs @@ -4,11 +4,14 @@ import Test.Hspec hiding (shouldBe) 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 qualified Wizard.Database.Migration.Development.User.UserMigration as USR import Wizard.Model.Document.DocumentContext import Wizard.Model.Report.Report import Wizard.Service.Document.Context.DocumentContextService +import WizardLib.KnowledgeModel.Database.Migration.Development.Package.Data.Packages +import qualified WizardLib.KnowledgeModel.Service.Package.PackageMapper as SP_Mapper import Wizard.Specs.Common import Wizard.Specs.Service.Document.Common @@ -25,6 +28,6 @@ documentIntegrationSpec appContext = runInContextIO TML.runMigration appContext runInContextIO QTN.runMigration appContext -- WHEN: - (Right result) <- runInContext (createDocumentContext doc1) appContext + (Right result) <- runInContext (createDocumentContext doc1 (SP_Mapper.toPackage germanyPackage) [] questionnaire1 Nothing) appContext -- THEN: compareDocumentContexts result expectation diff --git a/wizard-server/test/Wizard/Specs/Websocket/Branch/Detail/SetRepliesSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Branch/Detail/SetRepliesSpec.hs new file mode 100644 index 000000000..1be498e1c --- /dev/null +++ b/wizard-server/test/Wizard/Specs/Websocket/Branch/Detail/SetRepliesSpec.hs @@ -0,0 +1,55 @@ +module Wizard.Specs.Websocket.Branch.Detail.SetRepliesSpec where + +import Data.Aeson +import Network.WebSockets +import Test.Hspec hiding (shouldBe) +import Test.Hspec.Expectations.Pretty + +import Wizard.Api.Resource.Websocket.BranchActionDTO +import Wizard.Api.Resource.Websocket.WebsocketActionDTO +import Wizard.Database.Migration.Development.Branch.Data.BranchEvents +import Wizard.Database.Migration.Development.Branch.Data.Branches +import Wizard.Model.Branch.Branch +import Wizard.Model.Branch.BranchList + +import Wizard.Specs.Websocket.Branch.Detail.Common +import Wizard.Specs.Websocket.Common + +setRepliesSpec appContext = describe "setReplies" $ test200 appContext + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +test200 appContext = + it "WS 200 OK" $ + -- GIVEN: Prepare database + do + let branch = amsterdamBranch + let branchData = amsterdamBranchData + insertBranchAndUsers appContext branch branchData + -- AND: Connect to websocket + ((c1, s1), (c2, s2)) <- connectTestWebsocketUsers appContext branch.uuid + ((c3, s3), (c4, s4)) <- connectTestWebsocketUsers appContext leidenBranch.uuid + -- WHEN: + write_SetReplies c1 setRepliesDTO + -- THEN: + read_SetReplies c1 setRepliesDTO + read_SetReplies c2 setRepliesDTO + nothingWasReceived c3 + nothingWasReceived c4 + -- AND: Close sockets + closeSockets [s1, s2] + closeSockets [s1, s2, s3, s4] + +-- ---------------------------------------------------- +-- ---------------------------------------------------- +-- ---------------------------------------------------- +write_SetReplies connection replyDto = do + let reqDto = SetReplies_ClientBranchActionDTO replyDto + sendMessage connection reqDto + +read_SetReplies connection expRepliesDto = do + resDto <- receiveData connection + let eResult = eitherDecode resDto :: Either String (Success_ServerActionDTO ServerBranchActionDTO) + let (Right (Success_ServerActionDTO (SetReplies_ServerBranchActionDTO replyDto))) = eResult + expRepliesDto `shouldBe` replyDto diff --git a/wizard-server/test/Wizard/Specs/Websocket/Branch/Detail/WebsocketSpec.hs b/wizard-server/test/Wizard/Specs/Websocket/Branch/Detail/WebsocketSpec.hs index 36b084ed4..7bd72a106 100644 --- a/wizard-server/test/Wizard/Specs/Websocket/Branch/Detail/WebsocketSpec.hs +++ b/wizard-server/test/Wizard/Specs/Websocket/Branch/Detail/WebsocketSpec.hs @@ -6,9 +6,11 @@ import Wizard.Model.Context.AppContext import Wizard.Specs.Websocket.Branch.Detail.GeneralSpec import Wizard.Specs.Websocket.Branch.Detail.SetEventSpec +import Wizard.Specs.Websocket.Branch.Detail.SetRepliesSpec branchesWebsocketAPI :: AppContext -> SpecWith () branchesWebsocketAPI appContext = describe "WS /wizard-api/branches/{bUuid}/websocket" $ do generalSpec appContext setEventSpec appContext + setRepliesSpec appContext