Add not-seeded state for tenant

vknaisl · vknaisl · commit 7a7d21d45424 · 2025-02-13T12:18:10.000+01:00
diff --git a/shared-common/src/Shared/Common/Api/Resource/Common/FromHttpApiData.hs b/shared-common/src/Shared/Common/Api/Resource/Common/FromHttpApiData.hs
@@ -0,0 +1,30 @@
+module Shared.Common.Api.Resource.Common.FromHttpApiData where
+
+import qualified Data.Text as T
+import qualified Data.UUID as U
+import Servant.API
+import Text.Read (readMaybe)
+
+import Shared.Common.Util.String
+
+instance FromHttpApiData [String] where
+  parseQueryParam = Right . splitOn "," . T.unpack
+
+instance FromHttpApiData [U.UUID] where
+  parseQueryParam = genericParseQueryParams
+
+genericParseQueryParam :: Read a => T.Text -> Either T.Text a
+genericParseQueryParam x =
+  case readMaybe (T.unpack x) of
+    Just phase -> Right phase
+    Nothing -> Left . T.pack . f' "Unable to parse %s" $ [T.unpack x]
+
+genericParseQueryParams :: Read a => T.Text -> Either T.Text [a]
+genericParseQueryParams xs =
+  let foldFn :: Read a => Either T.Text [a] -> String -> Either T.Text [a]
+      foldFn (Left err) _ = Left err
+      foldFn (Right acc) x =
+        case readMaybe x of
+          Just sharing -> Right $ sharing : acc
+          Nothing -> Left . T.pack . f' "Unable to parse %s" $ [x]
+   in foldl foldFn (Right []) . splitOn "," . T.unpack $ xs
diff --git a/wizard-server/src/Wizard/Api/Handler/Tenant/List_GET.hs b/wizard-server/src/Wizard/Api/Handler/Tenant/List_GET.hs
@@ -10,13 +10,15 @@ import Wizard.Api.Handler.Common
 import Wizard.Api.Resource.Tenant.TenantDTO
 import Wizard.Api.Resource.Tenant.TenantJM ()
 import Wizard.Model.Context.BaseContext
+import Wizard.Model.Tenant.Tenant
 import Wizard.Service.Tenant.TenantService
 
 type List_GET =
   Header "Authorization" String
     :> Header "Host" String
     :> "tenants"
     :> QueryParam "q" String
+    :> QueryParam "states" [TenantState]
     :> QueryParam "enabled" Bool
     :> QueryParam "page" Int
     :> QueryParam "size" Int
@@ -27,12 +29,13 @@ list_GET
   :: Maybe String
   -> Maybe String
   -> Maybe String
+  -> Maybe [TenantState]
   -> Maybe Bool
   -> Maybe Int
   -> Maybe Int
   -> Maybe String
   -> BaseContextM (Headers '[Header "x-trace-uuid" String] (Page TenantDTO))
-list_GET mTokenHeader mServerUrl mQuery mEnabled mPage mSize mSort =
+list_GET mTokenHeader mServerUrl mQuery mStates mEnabled mPage mSize mSort =
   getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService ->
     runInAuthService NoTransaction $
-      addTraceUuidHeader =<< getTenantsPage mQuery mEnabled (Pageable mPage mSize) (parseSortQuery mSort)
+      addTraceUuidHeader =<< getTenantsPage mQuery mStates mEnabled (Pageable mPage mSize) (parseSortQuery mSort)
diff --git a/wizard-server/src/Wizard/Api/Resource/Config/ClientConfigDTO.hs b/wizard-server/src/Wizard/Api/Resource/Config/ClientConfigDTO.hs
@@ -8,7 +8,10 @@ import Wizard.Model.Tenant.Config.TenantConfig
 import Wizard.Model.User.UserProfile
 
 data ClientConfigDTO
-  = HousekeepingInProgressClientConfigDTO
+  = NotSeededClientConfigDTO
+      { message :: String
+      }
+  | HousekeepingInProgressClientConfigDTO
       { message :: String
       }
   | ClientConfigDTO
diff --git a/wizard-server/src/Wizard/Api/Resource/Tenant/TenantDTO.hs b/wizard-server/src/Wizard/Api/Resource/Tenant/TenantDTO.hs
@@ -4,13 +4,16 @@ import Data.Time
 import qualified Data.UUID as U
 import GHC.Generics
 
+import Wizard.Model.Tenant.Tenant
+
 data TenantDTO = TenantDTO
   { uuid :: U.UUID
   , tenantId :: String
   , name :: String
   , serverDomain :: String
   , serverUrl :: String
   , clientUrl :: String
+  , state :: TenantState
   , enabled :: Bool
   , logoUrl :: Maybe String
   , primaryColor :: Maybe String
diff --git a/wizard-server/src/Wizard/Api/Resource/Tenant/TenantDetailDTO.hs b/wizard-server/src/Wizard/Api/Resource/Tenant/TenantDetailDTO.hs
@@ -5,6 +5,7 @@ import qualified Data.UUID as U
 import GHC.Generics
 
 import Wizard.Api.Resource.User.UserDTO
+import Wizard.Model.Tenant.Tenant
 import WizardLib.Public.Api.Resource.Tenant.Usage.WizardUsageDTO
 
 data TenantDetailDTO = TenantDetailDTO
@@ -14,6 +15,7 @@ data TenantDetailDTO = TenantDetailDTO
   , serverDomain :: String
   , serverUrl :: String
   , clientUrl :: String
+  , state :: TenantState
   , enabled :: Bool
   , logoUrl :: Maybe String
   , primaryColor :: Maybe String
diff --git a/wizard-server/src/Wizard/Api/Resource/Tenant/TenantDetailJM.hs b/wizard-server/src/Wizard/Api/Resource/Tenant/TenantDetailJM.hs
@@ -4,6 +4,7 @@ import Data.Aeson
 
 import Shared.Common.Util.Aeson
 import Wizard.Api.Resource.Tenant.TenantDetailDTO
+import Wizard.Api.Resource.Tenant.TenantJM ()
 import Wizard.Api.Resource.User.UserJM ()
 import WizardLib.Public.Api.Resource.Tenant.Usage.WizardUsageJM ()
 
diff --git a/wizard-server/src/Wizard/Api/Resource/Tenant/TenantDetailSM.hs b/wizard-server/src/Wizard/Api/Resource/Tenant/TenantDetailSM.hs
@@ -5,6 +5,7 @@ import Data.Swagger
 import Shared.Common.Util.Swagger
 import Wizard.Api.Resource.Tenant.TenantDetailDTO
 import Wizard.Api.Resource.Tenant.TenantDetailJM ()
+import Wizard.Api.Resource.Tenant.TenantSM ()
 import Wizard.Api.Resource.User.UserSM ()
 import Wizard.Database.Migration.Development.Tenant.Data.Tenants
 import Wizard.Service.Tenant.TenantMapper
diff --git a/wizard-server/src/Wizard/Api/Resource/Tenant/TenantJM.hs b/wizard-server/src/Wizard/Api/Resource/Tenant/TenantJM.hs
@@ -1,7 +1,9 @@
 module Wizard.Api.Resource.Tenant.TenantJM where
 
 import Data.Aeson
+import Servant.API
 
+import Shared.Common.Api.Resource.Common.FromHttpApiData
 import Shared.Common.Util.Aeson
 import Wizard.Api.Resource.Tenant.TenantDTO
 import Wizard.Model.Tenant.Tenant
@@ -18,6 +20,9 @@ instance FromJSON TenantState where
 instance ToJSON TenantState where
   toJSON = genericToJSON jsonOptions
 
+instance FromHttpApiData [TenantState] where
+  parseQueryParam = genericParseQueryParams
+
 instance FromJSON TenantDTO where
   parseJSON = genericParseJSON jsonOptions
 
diff --git a/wizard-server/src/Wizard/Api/Resource/Tenant/TenantSM.hs b/wizard-server/src/Wizard/Api/Resource/Tenant/TenantSM.hs
@@ -15,5 +15,7 @@ instance ToSchema Tenant where
 instance ToSchema TenantState where
   declareNamedSchema = toSwagger ReadyForUseTenantState
 
+instance ToParamSchema TenantState
+
 instance ToSchema TenantDTO where
   declareNamedSchema = toSwagger (toDTO defaultTenant Nothing Nothing)
diff --git a/wizard-server/src/Wizard/Database/DAO/Tenant/TenantDAO.hs b/wizard-server/src/Wizard/Database/DAO/Tenant/TenantDAO.hs
@@ -1,6 +1,7 @@
 module Wizard.Database.DAO.Tenant.TenantDAO where
 
 import Control.Monad.Reader (liftIO)
+import qualified Data.List as L
 import Data.String
 import Data.Time
 import qualified Data.UUID as U
@@ -26,14 +27,21 @@ pageLabel = "tenants"
 findTenants :: AppContextM [Tenant]
 findTenants = createFindEntitiesFn entityName
 
-findTenantsPage :: Maybe String -> Maybe Bool -> Pageable -> [Sort] -> AppContextM (Page Tenant)
-findTenantsPage mQuery mEnabled pageable sort = do
+findTenantsPage :: Maybe String -> Maybe [TenantState] -> Maybe Bool -> Pageable -> [Sort] -> AppContextM (Page Tenant)
+findTenantsPage mQuery mStates mEnabled pageable sort = do
+  let statesCondition =
+        case mStates of
+          Nothing -> ""
+          Just [] -> ""
+          Just states ->
+            let xs = fmap (\s -> f' "state = '%s'" [show s]) states
+             in " AND (" ++ L.intercalate " OR " xs ++ ")"
   let enabledCondition =
         case mEnabled of
           Nothing -> ""
           Just True -> " AND enabled = true"
           Just False -> " AND enabled = false"
-  let condition = f' "WHERE (name ~* ? OR tenant_id ~* ?) %s" [enabledCondition]
+  let condition = f' "WHERE (name ~* ? OR tenant_id ~* ?) %s %s" [statesCondition, enabledCondition]
   createFindEntitiesPageableQuerySortFn entityName pageLabel pageable sort "*" condition [regexM mQuery, regexM mQuery]
 
 findTenantByUuid :: U.UUID -> AppContextM Tenant
diff --git a/wizard-server/src/Wizard/Model/Tenant/Tenant.hs b/wizard-server/src/Wizard/Model/Tenant/Tenant.hs
@@ -26,7 +26,8 @@ data Tenant = Tenant
   deriving (Show, Eq, Generic)
 
 data TenantState
-  = PendingHousekeepingTenantState
+  = NotSeededTenantState
+  | PendingHousekeepingTenantState
   | HousekeepingInProgressTenantState
   | ReadyForUseTenantState
   deriving (Show, Eq, Generic, Read)
diff --git a/wizard-server/src/Wizard/Service/Config/Client/ClientConfigService.hs b/wizard-server/src/Wizard/Service/Config/Client/ClientConfigService.hs
@@ -32,6 +32,8 @@ getClientConfig mServerUrl mClientUrl = do
       else getCurrentTenant
   unless tenant.enabled (throwError . NotExistsError $ _ERROR_VALIDATION__TENANT_OR_ACTIVE_PLAN_ABSENCE (fromMaybe "not-provided" mServerUrl))
   case tenant.state of
+    NotSeededTenantState -> do
+      return $ NotSeededClientConfigDTO {message = "We’re currently preparing the instance for you"}
     PendingHousekeepingTenantState -> do
       let mCreatedByUuid = fmap (.uuid) mCurrentUser
       migrateToLatestMetamodelVersionCommand tenant mCreatedByUuid
diff --git a/wizard-server/src/Wizard/Service/Tenant/TenantMapper.hs b/wizard-server/src/Wizard/Service/Tenant/TenantMapper.hs
@@ -26,6 +26,7 @@ toDTO tenant mLogoUrl mPrimaryColor =
     , serverDomain = tenant.serverDomain
     , serverUrl = tenant.serverUrl
     , clientUrl = tenant.clientUrl
+    , state = tenant.state
     , enabled = tenant.enabled
     , logoUrl = mLogoUrl
     , primaryColor = mPrimaryColor
@@ -42,6 +43,7 @@ toDetailDTO tenant mLogoUrl mPrimaryColor usage users =
     , serverDomain = tenant.serverDomain
     , serverUrl = tenant.serverUrl
     , clientUrl = tenant.clientUrl
+    , state = tenant.state
     , enabled = tenant.enabled
     , logoUrl = mLogoUrl
     , primaryColor = mPrimaryColor
@@ -100,8 +102,8 @@ fromAdminCreateDTO reqDto aUuid serverConfig now =
         , updatedAt = now
         }
 
-fromCommand :: CreateOrUpdateTenantCommand -> ServerConfig -> UTCTime -> UTCTime -> Tenant
-fromCommand command serverConfig createdAt updatedAt =
+fromCommand :: CreateOrUpdateTenantCommand -> TenantState -> ServerConfig -> UTCTime -> UTCTime -> Tenant
+fromCommand command state serverConfig createdAt updatedAt =
   let (serverDomain, url) =
         case command.customDomain of
           Just customDomain -> (customDomain, f' "https://%s" [customDomain])
@@ -121,7 +123,7 @@ fromCommand command serverConfig createdAt updatedAt =
         , analyticsClientUrl = Just $ createReportingClientUrl url
         , signalBridgeUrl = serverConfig.cloud.signalBridgeUrl
         , enabled = command.enabled
-        , state = ReadyForUseTenantState
+        , state = state
         , createdAt = createdAt
         , updatedAt = updatedAt
         }
@@ -144,7 +146,7 @@ fromChangeDTO tenant reqDto serverConfig =
         , analyticsClientUrl = Just $ createReportingClientUrl url
         , signalBridgeUrl = tenant.signalBridgeUrl
         , enabled = tenant.enabled
-        , state = ReadyForUseTenantState
+        , state = tenant.state
         , createdAt = tenant.createdAt
         , updatedAt = tenant.updatedAt
         }
diff --git a/wizard-server/src/Wizard/Service/Tenant/TenantService.hs b/wizard-server/src/Wizard/Service/Tenant/TenantService.hs
@@ -35,10 +35,10 @@ import qualified Wizard.Service.User.UserMapper as U_Mapper
 import Wizard.Service.User.UserService
 import WizardLib.Public.Model.PersistentCommand.Tenant.CreateOrUpdateTenantCommand
 
-getTenantsPage :: Maybe String -> Maybe Bool -> Pageable -> [Sort] -> AppContextM (Page TenantDTO)
-getTenantsPage mQuery mEnabled pageable sort = do
+getTenantsPage :: Maybe String -> Maybe [TenantState] -> Maybe Bool -> Pageable -> [Sort] -> AppContextM (Page TenantDTO)
+getTenantsPage mQuery mStates mEnabled pageable sort = do
   checkPermission _TENANT_PERM
-  tenants <- findTenantsPage mQuery mEnabled pageable sort
+  tenants <- findTenantsPage mQuery mStates mEnabled pageable sort
   traverse enhanceTenant tenants
 
 registerTenant :: TenantCreateDTO -> AppContextM TenantDTO
@@ -81,7 +81,7 @@ createTenantByCommand :: CreateOrUpdateTenantCommand -> AppContextM ()
 createTenantByCommand command = do
   now <- liftIO getCurrentTime
   serverConfig <- asks serverConfig
-  let tenant = fromCommand command serverConfig now now
+  let tenant = fromCommand command NotSeededTenantState serverConfig now now
   insertTenant tenant
   createConfig tenant.uuid now
   createLimitBundle tenant.uuid now
@@ -115,7 +115,7 @@ modifyTenantFromCommand command =
     now <- liftIO getCurrentTime
     serverConfig <- asks serverConfig
     tenant <- findTenantByUuid command.uuid
-    let updatedTenant = fromCommand command serverConfig tenant.createdAt now
+    let updatedTenant = fromCommand command tenant.state serverConfig tenant.createdAt now
     updateTenantByUuid updatedTenant
     modifyLimitBundle command.uuid command.limits
     return updatedTenant
