Add Workspace name validation (#834)

CHANGELOG.md

@@ -10,6 +10,8 @@ All notable changes to this project will be documented in this file.
 
 ### Changed
 
+- `workspaceName` is typed as `IndexName`, which respect ElasticSearch constraints
+
 ### Removed
 
 ### Fixed

monocle.cabal

@@ -208,6 +208,7 @@ library
                      , Monocle.Logging
                      , Monocle.Version
                      , Monocle.Config
+                     , Monocle.Config.Generated
                      , Monocle.Effects
                      , Monocle.Effects.Compat
                      , CLI

src/CLI.hs

@@ -6,6 +6,7 @@
 module CLI (main) where
 
 import Control.Concurrent.CGroup qualified
+import Data.Text qualified as T
 import Env hiding (Parser, auto, footer)
 import Env qualified
 import Lentille
@@ -146,10 +147,13 @@ usageJanitor =
  where
   configOption = strOption (long "config" <> O.help "Path to configuration file" <> metavar "MONOCLE_CONFIG")
   elasticOption = strOption (long "elastic" <> O.help "The Elastic endpoint url" <> metavar "MONOCLE_ELASTIC_URL")
-  workspaceOption = strOption (long "workspace" <> O.help "Workspace name" <> metavar "WORKSPACE")
+  workspaceOption =
+    option
+      (eitherReader $ (first T.unpack . Config.mkIndexName) . T.pack)
+      (long "workspace" <> O.help "Workspace name" <> metavar "WORKSPACE")
   crawlerNameOption = strOption (long "crawler-name" <> O.help "The crawler name" <> metavar "CRAWLER_NAME")
   runOnWorkspace env action' workspace = runEff $ runLoggerEffect $ runElasticEffect env $ runEmptyQueryM workspace action'
-  noWorkspace workspaceName = "Unable to find the workspace " <> workspaceName <> " in the Monocle config"
+  noWorkspace workspaceName = "Unable to find the workspace " <> Config.getIndexName workspaceName <> " in the Monocle config"
   janitorUpdateIdent = io <$> parser
    where
     parser = (,,) <$> configOption <*> elasticOption <*> optional workspaceOption

src/Macroscope/Main.hs

@@ -53,7 +53,7 @@ import Monocle.Effects
 
 -- | A structure to carry a single crawler information.
 data InfoCrawler = InfoCrawler
-  { infoWorkspaceName :: Text
+  { infoWorkspaceName :: Config.IndexName
   , infoCrawlerKey :: Text
   , infoCrawler :: Config.Crawler
   , infoIdents :: [Config.Ident]

src/Macroscope/Test.hs

@@ -186,7 +186,7 @@ testGetStream = do
     assertEqual' "Stream group named" expected (map fst $ Macroscope.mkStreamsActions (catMaybes streams))
  where
   conf =
-    [ (Config.mkTenant "test-stream")
+    [ (Config.mkTenant $ hardcodedIndexName "test-stream")
         { Config.crawlers = [gl "org1" "GITLAB_TOKEN", gl "org2" "GITLAB_TOKEN", gl "org3" "OTHER_TOKEN"]
         , Config.crawlers_api_key = Just "CRAWLERS_API_KEY"
         }

src/Monocle/Api/Jwt.hs

@@ -21,6 +21,7 @@ import Data.ByteString.Base64 qualified as B64
 import Data.ByteString.Lazy qualified as BSL
 import Data.Map.Strict qualified as HM
 import Monocle.Config (OIDCProviderConfig (..))
+import Monocle.Config qualified as Config
 import Monocle.Prelude hiding (Error)
 import Network.HTTP.Client (Manager)
 import Servant.Auth.Server (
@@ -41,7 +42,7 @@ doGenJwk keyM = case keyM of
   randomJWK = keyFromBS <$> genRandom
   keyFromBS = fromOctets . take 64 . BSL.unpack . from
 
-type MUidMap = Map Text Text
+type MUidMap = Map Config.IndexName Text
 
 -- Will be added as the 'dat' unregistered claim
 data AuthenticatedUser = AUser

src/Monocle/Api/Server.hs

@@ -517,7 +517,7 @@ searchAuthor auth request = checkAuth auth . const $ do
 
   pure . SearchPB.AuthorResponse $ V.fromList authors
 
-getMuidByIndexName :: Text -> AuthenticatedUser -> Maybe Text
+getMuidByIndexName :: Config.IndexName -> AuthenticatedUser -> Maybe Text
 getMuidByIndexName index = Map.lookup index . aMuidMap
 
 -- | /search/check endpoint
@@ -1058,7 +1058,7 @@ handleLoggedIn cookieSettings err codeM stateM = do
     defaultUserId = sub idToken
 
   -- Given a Claim, get a mapping of index (workspace) name to Monocle UID (mUid)
-  getIdents :: Config -> Text -> Map.Map Text Text
+  getIdents :: Config -> Text -> Map.Map Config.IndexName Text
   getIdents config auid = foldr go Map.empty $ Config.getWorkspaces config
    where
     go index acc = case Config.getIdentByAlias index auid of

src/Monocle/Api/ServerHTMX.hs

@@ -9,6 +9,7 @@ import Monocle.Api.Jwt (AuthenticatedUser)
 import Monocle.Api.Server (searchAuthor)
 import Monocle.Backend.Documents (EDocType (ECachedAuthor))
 import Monocle.Backend.Queries (documentType)
+import Monocle.Config qualified as Config
 import Monocle.Effects (ApiEffects, esCountByIndex)
 import Monocle.Env (tenantIndexName)
 import Monocle.Prelude
@@ -22,7 +23,7 @@ hxTrigger = makeAttribute "hx-trigger"
 hxTarget = makeAttribute "hx-target"
 hxVals = makeAttribute "hx-vals"
 
-searchAuthorsHandler :: ApiEffects es => AuthResult AuthenticatedUser -> Maybe Text -> Maybe Text -> Eff es (Html ())
+searchAuthorsHandler :: ApiEffects es => AuthResult AuthenticatedUser -> Maybe Config.IndexName -> Maybe Text -> Eff es (Html ())
 searchAuthorsHandler _ Nothing _ = pure $ pure ()
 searchAuthorsHandler auth (Just index) queryM = do
   case queryM of

src/Monocle/Backend/Provisioner.hs

@@ -30,28 +30,34 @@ import Faker.TvShow.TheExpanse qualified
 import Google.Protobuf.Timestamp qualified (fromUTCTime)
 import Monocle.Backend.Documents
 import Monocle.Backend.Test qualified as T
-import Monocle.Config (csConfig, getWorkspaces, lookupTenant)
+import Monocle.Config (csConfig, getWorkspaces, lookupTenant, mkIndexName)
 import Monocle.Effects (getReloadConfig, runElasticEffect, runEmptyQueryM, runMonoConfig)
 import Monocle.Env (mkEnv)
 import Monocle.Prelude
 import Monocle.Protob.Search (TaskData (..))
 
 -- | Provision fakedata for a tenant
 runProvisioner :: FilePath -> Text -> Text -> Int -> IO ()
-runProvisioner configPath elasticUrl tenantName docCount = runEff . runMonoConfig configPath . runLoggerEffect $ do
-  conf <- csConfig <$> getReloadConfig
-  let tenantM = lookupTenant (getWorkspaces conf) tenantName
-  case tenantM of
-    Just tenant -> do
-      bhEnv <- mkEnv elasticUrl
-      r <- runRetry $ runFail $ runElasticEffect bhEnv $ do
-        events <- liftIO $ createFakeEvents docCount
-        runEmptyQueryM tenant $ T.indexScenario events
-        logInfo "Provisionned" ["index" .= tenantName, "doc count" .= length events]
-      case r of
-        Left err -> logInfo "Unable to perform the provisionning" ["error" .= err]
-        Right _ -> pure ()
-    Nothing -> pure ()
+runProvisioner configPath elasticUrl tenantName docCount = do
+  indexName <-
+    either
+      (\e -> fail $ "Invalid tenantName " <> show tenantName <> " (" <> show e <> ")")
+      return
+      $ mkIndexName tenantName
+  runEff . runMonoConfig configPath . runLoggerEffect $ do
+    conf <- csConfig <$> getReloadConfig
+    let tenantM = lookupTenant (getWorkspaces conf) indexName
+    case tenantM of
+      Just tenant -> do
+        bhEnv <- mkEnv elasticUrl
+        r <- runRetry $ runFail $ runElasticEffect bhEnv $ do
+          events <- liftIO $ createFakeEvents docCount
+          runEmptyQueryM tenant $ T.indexScenario events
+          logInfo "Provisionned" ["index" .= indexName, "doc count" .= length events]
+        case r of
+          Left err -> logInfo "Unable to perform the provisionning" ["error" .= err]
+          Right _ -> pure ()
+      Nothing -> pure ()
 
 -- | Ensure changes have a unique ID
 setChangeID :: [EChange] -> IO [EChange]

src/Monocle/Backend/Test.hs

@@ -126,7 +126,7 @@ withTenant :: Eff [MonoQuery, ElasticEffect, LoggerEffect, IOE] () -> IO ()
 withTenant = withTenantConfig index
  where
   -- todo: generate random name
-  index = Config.mkTenant "test-tenant"
+  index = Config.mkTenant $ hardcodedIndexName "test-tenant"
 
 testQueryM' :: Config.Index -> Eff [MonoQuery, ElasticEffect, LoggerEffect, E.Fail, IOE] a -> IO a
 testQueryM' config action = do
@@ -400,7 +400,7 @@ testEnsureConfig = withTenantConfig tenantConfig $ localQueryTarget target $ run
   (currentVersion, _) <- I.getConfigVersion
   assertEqual' "Check expected Config Index" I.configVersion currentVersion
  where
-  tenantConfig = Config.mkTenant "test-index"
+  tenantConfig = Config.mkTenant $ hardcodedIndexName "test-index"
   target = QueryConfig $ Config.Config Nothing Nothing Nothing [tenantConfig]
 
 testUpgradeConfigV3 :: Assertion
@@ -512,7 +512,7 @@ testUpgradeConfigV1 = do
   tenantConfig :: Config.Index
   tenantConfig =
     Config.Index
-      { name = "test-tenant"
+      { name = hardcodedIndexName "test-tenant"
       , crawlers = [crawlerGH, crawlerGL]
       , crawlers_api_key = Nothing
       , projects = Nothing
@@ -545,7 +545,7 @@ testJanitorWipeCrawler = withTenant $ localQueryTarget updateEnv doTest
    where
     tenant =
       Config.Index
-        { name = "test-tenant"
+        { name = hardcodedIndexName "test-tenant"
         , crawlers = [workerGerrit]
         , crawlers_api_key = Nothing
         , projects = Nothing
@@ -587,7 +587,7 @@ testJanitorUpdateIdents = do
   tenantConfig :: Config.Index
   tenantConfig =
     Config.Index
-      { name = "test-tenant"
+      { name = hardcodedIndexName "test-tenant"
       , crawlers = []
       , crawlers_api_key = Nothing
       , projects = Nothing
@@ -689,7 +689,7 @@ testAchievements = withTenant doTest
     assertEqual' "event found" (Q.epbType agg) "Change"
     assertEqual' "event count match" (Q.epbCount agg) 1
    where
-    conf = mkConfig "test"
+    conf = mkConfig $ hardcodedIndexName "test"
     query now = case (Q.queryGet $ Q.load now mempty conf "state:merged") id (Just defaultQueryFlavor) of
       [x] -> x
       _ -> error "Could not compile query"
@@ -714,7 +714,7 @@ testGetInfoMetric = withTenantConfig tenant do
       (Just "time_to_merge")
       (getMetricName resp)
  where
-  tenant = Config.mkTenant "demo"
+  tenant = Config.mkTenant $ hardcodedIndexName "demo"
   env = Monocle.Api.Test.mkAppEnv tenant
   getMetricName :: MetricPB.InfoResponse -> Maybe Text
   getMetricName resp = case resp of
@@ -752,7 +752,7 @@ testGetMetrics = withTenantConfig tenant do
       , MetricPB.getRequestOptions = Nothing
       }
   env = Monocle.Api.Test.mkAppEnv tenant
-  tenantName = "test-metric-tenant"
+  tenantName = hardcodedIndexName "test-metric-tenant"
   tenant = Config.mkTenant tenantName
 
 testReposSummary :: Assertion