-- |
-- Module      : Zuul.Tenant
-- Description : Helper for Zuul tenant config main.yaml
-- Copyright   : (c) Red Hat, 2022
-- License     : Apache-2.0
--
-- Maintainer  : tdecacqu@redhat.com, fboucher@redhat.com
-- Stability   : provisional
-- Portability : portable
--
-- The Zuul Tenants configuration (main.yaml)
module Zuul.Tenant
  ( TenantsConfig (..),
    TenantConfig (..),
    TenantConnectionConfig (..),
    TenantProject (..),
    decodeTenantsConfig,
    TenantResolver (..),
    mkResolver,
  )
where

import Data.Aeson (Object)
import Data.Aeson qualified
import Data.Aeson.Key qualified
import Data.Aeson.KeyMap qualified as HM (lookup, toList)
import Data.Aeson.Types qualified
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as Text
import Zuul.Config
import Zuul.ServiceConfig (ServiceConfig (..))
import Zuul.ZooKeeper (ZKTenantsConfig (..))
import ZuulWeeder.Prelude

allItems :: Set ZuulConfigType
allItems :: Set ZuulConfigType
allItems = [ZuulConfigType] -> Set ZuulConfigType
forall a. Ord a => [a] -> Set a
Set.fromList [ZuulConfigType
forall a. Bounded a => a
minBound .. ZuulConfigType
forall a. Bounded a => a
maxBound]

toItemType :: Text -> ZuulConfigType
toItemType :: Text -> ZuulConfigType
toItemType Text
name = case Text
name of
  Text
"pipeline" -> ZuulConfigType
PipelineT
  Text
"job" -> ZuulConfigType
JobT
  Text
"semaphore" -> ZuulConfigType
SemaphoreT
  Text
"project" -> ZuulConfigType
ProjectT
  Text
"project-template" -> ZuulConfigType
ProjectTemplateT
  Text
"nodeset" -> ZuulConfigType
NodesetT
  Text
"secret" -> ZuulConfigType
SecretT
  Text
_type -> [Char] -> ZuulConfigType
forall a. HasCallStack => [Char] -> a
error ([Char] -> ZuulConfigType) -> [Char] -> ZuulConfigType
forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected configuration item type: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
Text.unpack Text
_type

-- | The project configuration for a tenant.
data TenantProject = TenantProject
  { -- | The project name.
    TenantProject -> ProjectName
name :: ProjectName,
    -- | The list of included elements.
    TenantProject -> Set ZuulConfigType
includedConfigElements :: Set ZuulConfigType,
    -- | The list of config location prefix, default to: [".zuul.yaml", "zuul.yaml", "zuul.d", ".zuul.d"]
    TenantProject -> [FilePathT]
configPaths :: [FilePathT]
  }
  deriving (Int -> TenantProject -> [Char] -> [Char]
[TenantProject] -> [Char] -> [Char]
TenantProject -> [Char]
(Int -> TenantProject -> [Char] -> [Char])
-> (TenantProject -> [Char])
-> ([TenantProject] -> [Char] -> [Char])
-> Show TenantProject
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [TenantProject] -> [Char] -> [Char]
$cshowList :: [TenantProject] -> [Char] -> [Char]
show :: TenantProject -> [Char]
$cshow :: TenantProject -> [Char]
showsPrec :: Int -> TenantProject -> [Char] -> [Char]
$cshowsPrec :: Int -> TenantProject -> [Char] -> [Char]
Show, TenantProject -> TenantProject -> Bool
(TenantProject -> TenantProject -> Bool)
-> (TenantProject -> TenantProject -> Bool) -> Eq TenantProject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TenantProject -> TenantProject -> Bool
$c/= :: TenantProject -> TenantProject -> Bool
== :: TenantProject -> TenantProject -> Bool
$c== :: TenantProject -> TenantProject -> Bool
Eq, Eq TenantProject
Eq TenantProject
-> (TenantProject -> TenantProject -> Ordering)
-> (TenantProject -> TenantProject -> Bool)
-> (TenantProject -> TenantProject -> Bool)
-> (TenantProject -> TenantProject -> Bool)
-> (TenantProject -> TenantProject -> Bool)
-> (TenantProject -> TenantProject -> TenantProject)
-> (TenantProject -> TenantProject -> TenantProject)
-> Ord TenantProject
TenantProject -> TenantProject -> Bool
TenantProject -> TenantProject -> Ordering
TenantProject -> TenantProject -> TenantProject
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TenantProject -> TenantProject -> TenantProject
$cmin :: TenantProject -> TenantProject -> TenantProject
max :: TenantProject -> TenantProject -> TenantProject
$cmax :: TenantProject -> TenantProject -> TenantProject
>= :: TenantProject -> TenantProject -> Bool
$c>= :: TenantProject -> TenantProject -> Bool
> :: TenantProject -> TenantProject -> Bool
$c> :: TenantProject -> TenantProject -> Bool
<= :: TenantProject -> TenantProject -> Bool
$c<= :: TenantProject -> TenantProject -> Bool
< :: TenantProject -> TenantProject -> Bool
$c< :: TenantProject -> TenantProject -> Bool
compare :: TenantProject -> TenantProject -> Ordering
$ccompare :: TenantProject -> TenantProject -> Ordering
Ord, (forall x. TenantProject -> Rep TenantProject x)
-> (forall x. Rep TenantProject x -> TenantProject)
-> Generic TenantProject
forall x. Rep TenantProject x -> TenantProject
forall x. TenantProject -> Rep TenantProject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TenantProject x -> TenantProject
$cfrom :: forall x. TenantProject -> Rep TenantProject x
Generic)

-- | The tenant connection source configuration.
data TenantConnectionConfig = TenantConnectionConfig
  { -- | The config projects
    TenantConnectionConfig -> [TenantProject]
configProjects :: [TenantProject],
    -- | The untrusted projects
    TenantConnectionConfig -> [TenantProject]
untrustedProjects :: [TenantProject]
  }
  deriving (Int -> TenantConnectionConfig -> [Char] -> [Char]
[TenantConnectionConfig] -> [Char] -> [Char]
TenantConnectionConfig -> [Char]
(Int -> TenantConnectionConfig -> [Char] -> [Char])
-> (TenantConnectionConfig -> [Char])
-> ([TenantConnectionConfig] -> [Char] -> [Char])
-> Show TenantConnectionConfig
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [TenantConnectionConfig] -> [Char] -> [Char]
$cshowList :: [TenantConnectionConfig] -> [Char] -> [Char]
show :: TenantConnectionConfig -> [Char]
$cshow :: TenantConnectionConfig -> [Char]
showsPrec :: Int -> TenantConnectionConfig -> [Char] -> [Char]
$cshowsPrec :: Int -> TenantConnectionConfig -> [Char] -> [Char]
Show, TenantConnectionConfig -> TenantConnectionConfig -> Bool
(TenantConnectionConfig -> TenantConnectionConfig -> Bool)
-> (TenantConnectionConfig -> TenantConnectionConfig -> Bool)
-> Eq TenantConnectionConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TenantConnectionConfig -> TenantConnectionConfig -> Bool
$c/= :: TenantConnectionConfig -> TenantConnectionConfig -> Bool
== :: TenantConnectionConfig -> TenantConnectionConfig -> Bool
$c== :: TenantConnectionConfig -> TenantConnectionConfig -> Bool
Eq, Eq TenantConnectionConfig
Eq TenantConnectionConfig
-> (TenantConnectionConfig -> TenantConnectionConfig -> Ordering)
-> (TenantConnectionConfig -> TenantConnectionConfig -> Bool)
-> (TenantConnectionConfig -> TenantConnectionConfig -> Bool)
-> (TenantConnectionConfig -> TenantConnectionConfig -> Bool)
-> (TenantConnectionConfig -> TenantConnectionConfig -> Bool)
-> (TenantConnectionConfig
    -> TenantConnectionConfig -> TenantConnectionConfig)
-> (TenantConnectionConfig
    -> TenantConnectionConfig -> TenantConnectionConfig)
-> Ord TenantConnectionConfig
TenantConnectionConfig -> TenantConnectionConfig -> Bool
TenantConnectionConfig -> TenantConnectionConfig -> Ordering
TenantConnectionConfig
-> TenantConnectionConfig -> TenantConnectionConfig
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TenantConnectionConfig
-> TenantConnectionConfig -> TenantConnectionConfig
$cmin :: TenantConnectionConfig
-> TenantConnectionConfig -> TenantConnectionConfig
max :: TenantConnectionConfig
-> TenantConnectionConfig -> TenantConnectionConfig
$cmax :: TenantConnectionConfig
-> TenantConnectionConfig -> TenantConnectionConfig
>= :: TenantConnectionConfig -> TenantConnectionConfig -> Bool
$c>= :: TenantConnectionConfig -> TenantConnectionConfig -> Bool
> :: TenantConnectionConfig -> TenantConnectionConfig -> Bool
$c> :: TenantConnectionConfig -> TenantConnectionConfig -> Bool
<= :: TenantConnectionConfig -> TenantConnectionConfig -> Bool
$c<= :: TenantConnectionConfig -> TenantConnectionConfig -> Bool
< :: TenantConnectionConfig -> TenantConnectionConfig -> Bool
$c< :: TenantConnectionConfig -> TenantConnectionConfig -> Bool
compare :: TenantConnectionConfig -> TenantConnectionConfig -> Ordering
$ccompare :: TenantConnectionConfig -> TenantConnectionConfig -> Ordering
Ord, (forall x. TenantConnectionConfig -> Rep TenantConnectionConfig x)
-> (forall x.
    Rep TenantConnectionConfig x -> TenantConnectionConfig)
-> Generic TenantConnectionConfig
forall x. Rep TenantConnectionConfig x -> TenantConnectionConfig
forall x. TenantConnectionConfig -> Rep TenantConnectionConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TenantConnectionConfig x -> TenantConnectionConfig
$cfrom :: forall x. TenantConnectionConfig -> Rep TenantConnectionConfig x
Generic)

-- | Single tenant configuration.
data TenantConfig = TenantConfig
  { -- | The default base job name, default to "base".
    TenantConfig -> JobName
defaultParent :: JobName,
    -- | The list of project grouped per source connection.
    TenantConfig -> Map ConnectionName TenantConnectionConfig
connections :: Map ConnectionName TenantConnectionConfig
  }
  deriving (Int -> TenantConfig -> [Char] -> [Char]
[TenantConfig] -> [Char] -> [Char]
TenantConfig -> [Char]
(Int -> TenantConfig -> [Char] -> [Char])
-> (TenantConfig -> [Char])
-> ([TenantConfig] -> [Char] -> [Char])
-> Show TenantConfig
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [TenantConfig] -> [Char] -> [Char]
$cshowList :: [TenantConfig] -> [Char] -> [Char]
show :: TenantConfig -> [Char]
$cshow :: TenantConfig -> [Char]
showsPrec :: Int -> TenantConfig -> [Char] -> [Char]
$cshowsPrec :: Int -> TenantConfig -> [Char] -> [Char]
Show, TenantConfig -> TenantConfig -> Bool
(TenantConfig -> TenantConfig -> Bool)
-> (TenantConfig -> TenantConfig -> Bool) -> Eq TenantConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TenantConfig -> TenantConfig -> Bool
$c/= :: TenantConfig -> TenantConfig -> Bool
== :: TenantConfig -> TenantConfig -> Bool
$c== :: TenantConfig -> TenantConfig -> Bool
Eq, Eq TenantConfig
Eq TenantConfig
-> (TenantConfig -> TenantConfig -> Ordering)
-> (TenantConfig -> TenantConfig -> Bool)
-> (TenantConfig -> TenantConfig -> Bool)
-> (TenantConfig -> TenantConfig -> Bool)
-> (TenantConfig -> TenantConfig -> Bool)
-> (TenantConfig -> TenantConfig -> TenantConfig)
-> (TenantConfig -> TenantConfig -> TenantConfig)
-> Ord TenantConfig
TenantConfig -> TenantConfig -> Bool
TenantConfig -> TenantConfig -> Ordering
TenantConfig -> TenantConfig -> TenantConfig
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TenantConfig -> TenantConfig -> TenantConfig
$cmin :: TenantConfig -> TenantConfig -> TenantConfig
max :: TenantConfig -> TenantConfig -> TenantConfig
$cmax :: TenantConfig -> TenantConfig -> TenantConfig
>= :: TenantConfig -> TenantConfig -> Bool
$c>= :: TenantConfig -> TenantConfig -> Bool
> :: TenantConfig -> TenantConfig -> Bool
$c> :: TenantConfig -> TenantConfig -> Bool
<= :: TenantConfig -> TenantConfig -> Bool
$c<= :: TenantConfig -> TenantConfig -> Bool
< :: TenantConfig -> TenantConfig -> Bool
$c< :: TenantConfig -> TenantConfig -> Bool
compare :: TenantConfig -> TenantConfig -> Ordering
$ccompare :: TenantConfig -> TenantConfig -> Ordering
Ord, (forall x. TenantConfig -> Rep TenantConfig x)
-> (forall x. Rep TenantConfig x -> TenantConfig)
-> Generic TenantConfig
forall x. Rep TenantConfig x -> TenantConfig
forall x. TenantConfig -> Rep TenantConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TenantConfig x -> TenantConfig
$cfrom :: forall x. TenantConfig -> Rep TenantConfig x
Generic)

-- | All the tenants configuration.
newtype TenantsConfig = TenantsConfig
  { TenantsConfig -> Map TenantName TenantConfig
tenants :: Map TenantName TenantConfig
  }
  deriving (Int -> TenantsConfig -> [Char] -> [Char]
[TenantsConfig] -> [Char] -> [Char]
TenantsConfig -> [Char]
(Int -> TenantsConfig -> [Char] -> [Char])
-> (TenantsConfig -> [Char])
-> ([TenantsConfig] -> [Char] -> [Char])
-> Show TenantsConfig
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [TenantsConfig] -> [Char] -> [Char]
$cshowList :: [TenantsConfig] -> [Char] -> [Char]
show :: TenantsConfig -> [Char]
$cshow :: TenantsConfig -> [Char]
showsPrec :: Int -> TenantsConfig -> [Char] -> [Char]
$cshowsPrec :: Int -> TenantsConfig -> [Char] -> [Char]
Show, TenantsConfig -> TenantsConfig -> Bool
(TenantsConfig -> TenantsConfig -> Bool)
-> (TenantsConfig -> TenantsConfig -> Bool) -> Eq TenantsConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TenantsConfig -> TenantsConfig -> Bool
$c/= :: TenantsConfig -> TenantsConfig -> Bool
== :: TenantsConfig -> TenantsConfig -> Bool
$c== :: TenantsConfig -> TenantsConfig -> Bool
Eq, Eq TenantsConfig
Eq TenantsConfig
-> (TenantsConfig -> TenantsConfig -> Ordering)
-> (TenantsConfig -> TenantsConfig -> Bool)
-> (TenantsConfig -> TenantsConfig -> Bool)
-> (TenantsConfig -> TenantsConfig -> Bool)
-> (TenantsConfig -> TenantsConfig -> Bool)
-> (TenantsConfig -> TenantsConfig -> TenantsConfig)
-> (TenantsConfig -> TenantsConfig -> TenantsConfig)
-> Ord TenantsConfig
TenantsConfig -> TenantsConfig -> Bool
TenantsConfig -> TenantsConfig -> Ordering
TenantsConfig -> TenantsConfig -> TenantsConfig
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TenantsConfig -> TenantsConfig -> TenantsConfig
$cmin :: TenantsConfig -> TenantsConfig -> TenantsConfig
max :: TenantsConfig -> TenantsConfig -> TenantsConfig
$cmax :: TenantsConfig -> TenantsConfig -> TenantsConfig
>= :: TenantsConfig -> TenantsConfig -> Bool
$c>= :: TenantsConfig -> TenantsConfig -> Bool
> :: TenantsConfig -> TenantsConfig -> Bool
$c> :: TenantsConfig -> TenantsConfig -> Bool
<= :: TenantsConfig -> TenantsConfig -> Bool
$c<= :: TenantsConfig -> TenantsConfig -> Bool
< :: TenantsConfig -> TenantsConfig -> Bool
$c< :: TenantsConfig -> TenantsConfig -> Bool
compare :: TenantsConfig -> TenantsConfig -> Ordering
$ccompare :: TenantsConfig -> TenantsConfig -> Ordering
Ord, (forall x. TenantsConfig -> Rep TenantsConfig x)
-> (forall x. Rep TenantsConfig x -> TenantsConfig)
-> Generic TenantsConfig
forall x. Rep TenantsConfig x -> TenantsConfig
forall x. TenantsConfig -> Rep TenantsConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TenantsConfig x -> TenantsConfig
$cfrom :: forall x. TenantsConfig -> Rep TenantsConfig x
Generic)

-- | Decode the 'TenantsConfig' from a ZK data file.
decodeTenantsConfig :: ZKTenantsConfig -> Either Text TenantsConfig
decodeTenantsConfig :: ZKTenantsConfig -> Either Text TenantsConfig
decodeTenantsConfig (ZKTenantsConfig Value
value) = case Decoder TenantsConfig
decoded of
  (Decoder (Right TenantsConfig
x)) -> TenantsConfig -> Either Text TenantsConfig
forall a b. b -> Either a b
Right TenantsConfig
x
  (Decoder (Left (Text, Value)
e)) -> Text -> Either Text TenantsConfig
forall a b. a -> Either a b
Left (Text -> Either Text TenantsConfig)
-> Text -> Either Text TenantsConfig
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
forall source target. From source target => source -> target
from ([Char]
"Decode error:" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> (Text, Value) -> [Char]
forall a. Show a => a -> [Char]
show (Text, Value)
e)
  where
    decoded :: Decoder TenantsConfig
    decoded :: Decoder TenantsConfig
decoded = case Value
value of
      Data.Aeson.Object Object
hm -> do
        Object
abide <- Value -> Decoder Object
decodeObject (Value -> Decoder Object) -> Decoder Value -> Decoder Object
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Key -> Object -> Decoder Value
decodeObjectAttribute Key
"unparsed_abide" Object
hm
        [(Key, Value)]
tenantsValues <- Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
HM.toList (Object -> [(Key, Value)])
-> Decoder Object -> Decoder [(Key, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Decoder Object
decodeObject (Value -> Decoder Object) -> Decoder Value -> Decoder Object
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Key -> Object -> Decoder Value
decodeObjectAttribute Key
"tenants" Object
abide)
        [(TenantName, TenantConfig)]
tenants <- ((Text, Value) -> Decoder (TenantName, TenantConfig))
-> [(Text, Value)] -> Decoder [(TenantName, TenantConfig)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Text, Value) -> Decoder (TenantName, TenantConfig)
decodeTenant ((Key -> Text) -> (Key, Value) -> (Text, Value)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Key -> Text
Data.Aeson.Key.toText ((Key, Value) -> (Text, Value))
-> [(Key, Value)] -> [(Text, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Key, Value)]
tenantsValues)
        TenantsConfig -> Decoder TenantsConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TenantsConfig -> Decoder TenantsConfig)
-> TenantsConfig -> Decoder TenantsConfig
forall a b. (a -> b) -> a -> b
$ Map TenantName TenantConfig -> TenantsConfig
TenantsConfig (Map TenantName TenantConfig -> TenantsConfig)
-> Map TenantName TenantConfig -> TenantsConfig
forall a b. (a -> b) -> a -> b
$ [(TenantName, TenantConfig)] -> Map TenantName TenantConfig
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(TenantName, TenantConfig)]
tenants
      Value
_ -> Text -> Value -> Decoder TenantsConfig
forall a. Text -> Value -> Decoder a
decodeFail Text
"Invalid root tenants config" Value
value

    decodeTenant :: (Text, Data.Aeson.Value) -> Decoder (TenantName, TenantConfig)
    decodeTenant :: (Text, Value) -> Decoder (TenantName, TenantConfig)
decodeTenant (Text -> TenantName
TenantName -> TenantName
name, Value
v) = do
      Object
obj <- Value -> Decoder Object
decodeObject Value
v
      TenantConfig
config <- Object -> Decoder TenantConfig
decodeTenantConfig Object
obj
      (TenantName, TenantConfig) -> Decoder (TenantName, TenantConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TenantName
name, TenantConfig
config)

    decodeTenantConfig :: Object -> Decoder TenantConfig
    decodeTenantConfig :: Object -> Decoder TenantConfig
decodeTenantConfig Object
obj = do
      Object
sources <- Value -> Decoder Object
decodeObject (Value -> Decoder Object) -> Decoder Value -> Decoder Object
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Key -> Object -> Decoder Value
decodeObjectAttribute Key
"source" Object
obj
      Map ConnectionName TenantConnectionConfig
connections <- [(ConnectionName, TenantConnectionConfig)]
-> Map ConnectionName TenantConnectionConfig
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ConnectionName, TenantConnectionConfig)]
 -> Map ConnectionName TenantConnectionConfig)
-> Decoder [(ConnectionName, TenantConnectionConfig)]
-> Decoder (Map ConnectionName TenantConnectionConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, Value) -> Decoder (ConnectionName, TenantConnectionConfig))
-> [(Text, Value)]
-> Decoder [(ConnectionName, TenantConnectionConfig)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Text, Value) -> Decoder (ConnectionName, TenantConnectionConfig)
decodeConnection ((Key -> Text) -> (Key, Value) -> (Text, Value)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Key -> Text
Data.Aeson.Key.toText ((Key, Value) -> (Text, Value))
-> [(Key, Value)] -> [(Text, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
HM.toList Object
sources)
      JobName
defaultParent <-
        Text -> JobName
JobName (Text -> JobName) -> Decoder Text -> Decoder JobName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
HM.lookup Key
"default-parent" Object
obj of
          Just (Data.Aeson.String Text
n) -> Text -> Decoder Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
n
          Just Value
v -> Text -> Value -> Decoder Text
forall a. Text -> Value -> Decoder a
decodeFail Text
"Invalid default-parent value" Value
v
          Maybe Value
Nothing -> Text -> Decoder Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"base"
      TenantConfig -> Decoder TenantConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TenantConfig -> Decoder TenantConfig)
-> TenantConfig -> Decoder TenantConfig
forall a b. (a -> b) -> a -> b
$ TenantConfig {JobName
defaultParent :: JobName
$sel:defaultParent:TenantConfig :: JobName
defaultParent, Map ConnectionName TenantConnectionConfig
connections :: Map ConnectionName TenantConnectionConfig
$sel:connections:TenantConfig :: Map ConnectionName TenantConnectionConfig
connections}

    decodeConnection :: (Text, Data.Aeson.Value) -> Decoder (ConnectionName, TenantConnectionConfig)
    decodeConnection :: (Text, Value) -> Decoder (ConnectionName, TenantConnectionConfig)
decodeConnection (Text -> ConnectionName
ConnectionName -> ConnectionName
cname, Value
v) = do
      Object
va <- Value -> Decoder Object
decodeObject Value
v
      [TenantProject]
configProjects <- Text -> Object -> Decoder [TenantProject]
getProjects Text
"config-projects" Object
va
      [TenantProject]
untrustedProjects <- Text -> Object -> Decoder [TenantProject]
getProjects Text
"untrusted-projects" Object
va
      (ConnectionName, TenantConnectionConfig)
-> Decoder (ConnectionName, TenantConnectionConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionName
cname, TenantConnectionConfig {[TenantProject]
configProjects :: [TenantProject]
$sel:configProjects:TenantConnectionConfig :: [TenantProject]
configProjects, [TenantProject]
untrustedProjects :: [TenantProject]
$sel:untrustedProjects:TenantConnectionConfig :: [TenantProject]
untrustedProjects})
      where
        defaultPaths :: [FilePathT]
defaultPaths = [FilePathT
".zuul.yaml", FilePathT
"zuul.yaml", FilePathT
".zuul.d/", FilePathT
"zuul.d/"]

        getProjects :: Text -> Object -> Decoder [TenantProject]
        getProjects :: Text -> Object -> Decoder [TenantProject]
getProjects (Text -> Key
Data.Aeson.Key.fromText -> Key
k) Object
o =
          case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
HM.lookup Key
k Object
o of
            Just Value
projectList ->
              ((Value -> Decoder [(Text, Value)])
-> [Value] -> Decoder [[(Text, Value)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Decoder [(Text, Value)]
decodeProjects ([Value] -> Decoder [[(Text, Value)]])
-> Decoder [Value] -> Decoder [[(Text, Value)]]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Decoder [Value]
decodeList Value
projectList)
                Decoder [[(Text, Value)]]
-> ([[(Text, Value)]] -> Decoder [TenantProject])
-> Decoder [TenantProject]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((Text, Value) -> Decoder TenantProject)
-> [(Text, Value)] -> Decoder [TenantProject]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Text, Value) -> Decoder TenantProject
decodeProject ([(Text, Value)] -> Decoder [TenantProject])
-> ([[(Text, Value)]] -> [(Text, Value)])
-> [[(Text, Value)]]
-> Decoder [TenantProject]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(Text, Value)]] -> [(Text, Value)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            Maybe Value
Nothing -> [TenantProject] -> Decoder [TenantProject]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

        -- Decode a single project or a project configuration list
        decodeProjects :: Value -> Decoder [(Text, Value)]
        decodeProjects :: Value -> Decoder [(Text, Value)]
decodeProjects = \case
          x :: Value
x@(Data.Aeson.Object Object
o)
            -- Project configuration is a list of project name with a shared config
            | Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
HM.lookup Key
"projects" Object
o) -> (Text -> (Text, Value)) -> [Text] -> [(Text, Value)]
forall a b. (a -> b) -> [a] -> [b]
map (,Value
x) ([Text] -> [(Text, Value)])
-> Decoder [Text] -> Decoder [(Text, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> (Text -> Text) -> Object -> Decoder [Text]
forall a. Key -> (Text -> a) -> Object -> Decoder [a]
decodeAsList Key
"projects" Text -> Text
forall a. a -> a
id Object
o
            -- It's a single project with a custom config
            | Bool
otherwise -> [(Text, Value)] -> Decoder [(Text, Value)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, Value)] -> Decoder [(Text, Value)])
-> [(Text, Value)] -> Decoder [(Text, Value)]
forall a b. (a -> b) -> a -> b
$ (Key -> Text) -> (Key, Value) -> (Text, Value)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Key -> Text
Data.Aeson.Key.toText ((Key, Value) -> (Text, Value))
-> [(Key, Value)] -> [(Text, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
HM.toList Object
o
          -- Project configuration is a single name
          Data.Aeson.String Text
name -> [(Text, Value)] -> Decoder [(Text, Value)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Text
name, Value
Data.Aeson.Types.emptyObject)]
          Value
anyOther -> Text -> Value -> Decoder [(Text, Value)]
forall a. Text -> Value -> Decoder a
decodeFail Text
"Invalid project definition" Value
anyOther

        decodeProject :: (Text, Value) -> Decoder TenantProject
        decodeProject :: (Text, Value) -> Decoder TenantProject
decodeProject (Text
name, Value
options') = do
          Object
options <- Value -> Decoder Object
decodeObject Value
options'
          Set ZuulConfigType
included <- [ZuulConfigType] -> Set ZuulConfigType
forall a. Ord a => [a] -> Set a
Set.fromList ([ZuulConfigType] -> Set ZuulConfigType)
-> Decoder [ZuulConfigType] -> Decoder (Set ZuulConfigType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key
-> (Text -> ZuulConfigType) -> Object -> Decoder [ZuulConfigType]
forall a. Key -> (Text -> a) -> Object -> Decoder [a]
decodeAsList Key
"include" Text -> ZuulConfigType
toItemType Object
options
          Set ZuulConfigType
excluded <- [ZuulConfigType] -> Set ZuulConfigType
forall a. Ord a => [a] -> Set a
Set.fromList ([ZuulConfigType] -> Set ZuulConfigType)
-> Decoder [ZuulConfigType] -> Decoder (Set ZuulConfigType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key
-> (Text -> ZuulConfigType) -> Object -> Decoder [ZuulConfigType]
forall a. Key -> (Text -> a) -> Object -> Decoder [a]
decodeAsList Key
"exclude" Text -> ZuulConfigType
toItemType Object
options
          let includedElements :: Set ZuulConfigType
includedElements
                | Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Value -> Bool) -> Maybe Value -> Bool
forall a b. (a -> b) -> a -> b
$ Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
HM.lookup Key
"include" Object
options = Set ZuulConfigType
included
                | Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Value -> Bool) -> Maybe Value -> Bool
forall a b. (a -> b) -> a -> b
$ Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
HM.lookup Key
"exclude" Object
options = Set ZuulConfigType -> Set ZuulConfigType -> Set ZuulConfigType
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set ZuulConfigType
allItems Set ZuulConfigType
excluded
                | Bool
otherwise = Set ZuulConfigType
allItems
              extraConfigPaths :: [a]
extraConfigPaths = [] -- TODO: decode attribute
          TenantProject -> Decoder TenantProject
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TenantProject -> Decoder TenantProject)
-> TenantProject -> Decoder TenantProject
forall a b. (a -> b) -> a -> b
$ ProjectName -> Set ZuulConfigType -> [FilePathT] -> TenantProject
TenantProject (Text -> ProjectName
ProjectName Text
name) Set ZuulConfigType
includedElements ([FilePathT]
forall a. [a]
extraConfigPaths [FilePathT] -> [FilePathT] -> [FilePathT]
forall a. Semigroup a => a -> a -> a
<> [FilePathT]
defaultPaths)

-- | Tenant information to resolve project location
data TenantResolver = TenantResolver
  { TenantResolver -> ConfigLoc -> ZuulConfigType -> Set TenantName
resolveTenants ::
      -- The config location to resolve
      ConfigLoc ->
      -- The config element type
      ZuulConfigType ->
      -- The list of tenant allowing the element
      Set TenantName,
    TenantResolver
-> ConfigLoc -> ProjectName -> Maybe CanonicalProjectName
resolveProject ::
      -- The project definition config location
      ConfigLoc ->
      -- The project name
      ProjectName ->
      -- The resolved project name
      Maybe CanonicalProjectName
  }

mkResolver ::
  -- | The zuul.conf for the list of connection names
  ServiceConfig ->
  -- | The main.yaml tenants config
  TenantsConfig ->
  TenantResolver
mkResolver :: ServiceConfig -> TenantsConfig -> TenantResolver
mkResolver ServiceConfig
sc TenantsConfig
tc = TenantResolver {$sel:resolveTenants:TenantResolver :: ConfigLoc -> ZuulConfigType -> Set TenantName
resolveTenants = ServiceConfig
-> TenantsConfig -> ConfigLoc -> ZuulConfigType -> Set TenantName
resolveTenant ServiceConfig
sc TenantsConfig
tc, ConfigLoc -> ProjectName -> Maybe CanonicalProjectName
resolveProject :: ConfigLoc -> ProjectName -> Maybe CanonicalProjectName
$sel:resolveProject:TenantResolver :: ConfigLoc -> ProjectName -> Maybe CanonicalProjectName
resolveProject}
  where
    resolveProject :: ConfigLoc -> ProjectName -> Maybe CanonicalProjectName
    resolveProject :: ConfigLoc -> ProjectName -> Maybe CanonicalProjectName
resolveProject ConfigLoc
loc ProjectName
rawName
      | -- The project is already qualified
        ProviderName
provider ProviderName -> Set ProviderName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Map TenantName TenantConfig -> Set ProviderName
allProviders TenantsConfig
tc.tenants =
          CanonicalProjectName -> Maybe CanonicalProjectName
forall a. a -> Maybe a
Just (CanonicalProjectName -> Maybe CanonicalProjectName)
-> CanonicalProjectName -> Maybe CanonicalProjectName
forall a b. (a -> b) -> a -> b
$ ProviderName -> ProjectName -> CanonicalProjectName
CanonicalProjectName ProviderName
provider ProjectName
name
      | -- Otherwise look for a matching project in the tenant configs
        Bool
otherwise = case Set CanonicalProjectName -> [CanonicalProjectName]
forall a. Set a -> [a]
Set.toList ((CanonicalProjectName -> Bool)
-> Set CanonicalProjectName -> Set CanonicalProjectName
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\CanonicalProjectName
cp -> CanonicalProjectName
cp.project ProjectName -> ProjectName -> Bool
forall a. Eq a => a -> a -> Bool
== ProjectName
rawName) (Map TenantName TenantConfig -> Set CanonicalProjectName
allProjects TenantsConfig
tc.tenants)) of
          [CanonicalProjectName
x] -> CanonicalProjectName -> Maybe CanonicalProjectName
forall a. a -> Maybe a
Just CanonicalProjectName
x
          [CanonicalProjectName]
_ -> Maybe CanonicalProjectName
forall a. Maybe a
Nothing
      where
        (Text -> ProviderName
ProviderName -> ProviderName
provider, Text -> ProjectName
ProjectName (Text -> ProjectName) -> (Text -> Text) -> Text -> ProjectName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.tail -> ProjectName
name) = (Char -> Bool) -> Text -> (Text, Text)
Text.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') (ProjectName -> Text
forall source target. From source target => source -> target
from ProjectName
rawName)

        allTenantsConfig :: Map TenantName TenantConfig -> [TenantConfig]
        allTenantsConfig :: Map TenantName TenantConfig -> [TenantConfig]
allTenantsConfig =
          ((TenantName, TenantConfig) -> TenantConfig)
-> [(TenantName, TenantConfig)] -> [TenantConfig]
forall a b. (a -> b) -> [a] -> [b]
map (TenantName, TenantConfig) -> TenantConfig
forall a b. (a, b) -> b
snd
            ([(TenantName, TenantConfig)] -> [TenantConfig])
-> (Map TenantName TenantConfig -> [(TenantName, TenantConfig)])
-> Map TenantName TenantConfig
-> [TenantConfig]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TenantName, TenantConfig) -> Bool)
-> [(TenantName, TenantConfig)] -> [(TenantName, TenantConfig)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(TenantName
tenant, TenantConfig
_) -> TenantName
tenant TenantName -> Set TenantName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` ConfigLoc
loc.tenants)
            ([(TenantName, TenantConfig)] -> [(TenantName, TenantConfig)])
-> (Map TenantName TenantConfig -> [(TenantName, TenantConfig)])
-> Map TenantName TenantConfig
-> [(TenantName, TenantConfig)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TenantName TenantConfig -> [(TenantName, TenantConfig)]
forall k a. Map k a -> [(k, a)]
Map.toList

        allProjects :: Map TenantName TenantConfig -> Set CanonicalProjectName
        allProjects :: Map TenantName TenantConfig -> Set CanonicalProjectName
allProjects =
          [CanonicalProjectName] -> Set CanonicalProjectName
forall a. Ord a => [a] -> Set a
Set.fromList
            ([CanonicalProjectName] -> Set CanonicalProjectName)
-> (Map TenantName TenantConfig -> [CanonicalProjectName])
-> Map TenantName TenantConfig
-> Set CanonicalProjectName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ConnectionName, ProjectName) -> Maybe CanonicalProjectName)
-> [(ConnectionName, ProjectName)] -> [CanonicalProjectName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ConnectionName, ProjectName) -> Maybe CanonicalProjectName
getCanonicalName
            ([(ConnectionName, ProjectName)] -> [CanonicalProjectName])
-> (Map TenantName TenantConfig -> [(ConnectionName, ProjectName)])
-> Map TenantName TenantConfig
-> [CanonicalProjectName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TenantConfig -> [(ConnectionName, ProjectName)])
-> [TenantConfig] -> [(ConnectionName, ProjectName)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TenantConfig -> [(ConnectionName, ProjectName)]
forall {r}.
HasField
  "connections" r (Map ConnectionName TenantConnectionConfig) =>
r -> [(ConnectionName, ProjectName)]
getProjects
            ([TenantConfig] -> [(ConnectionName, ProjectName)])
-> (Map TenantName TenantConfig -> [TenantConfig])
-> Map TenantName TenantConfig
-> [(ConnectionName, ProjectName)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TenantName TenantConfig -> [TenantConfig]
allTenantsConfig
          where
            getProjects :: r -> [(ConnectionName, ProjectName)]
getProjects r
tenantConfig =
              let tenantProjects :: (ConnectionName, TenantConnectionConfig) -> [(ConnectionName, ProjectName)]
                  tenantProjects :: (ConnectionName, TenantConnectionConfig)
-> [(ConnectionName, ProjectName)]
tenantProjects (ConnectionName
conn, TenantConnectionConfig
tcc) =
                    (TenantProject -> (ConnectionName, ProjectName))
-> [TenantProject] -> [(ConnectionName, ProjectName)]
forall a b. (a -> b) -> [a] -> [b]
map TenantProject -> (ConnectionName, ProjectName)
forall {r} {b}. HasField "name" r b => r -> (ConnectionName, b)
toProject TenantConnectionConfig
tcc.configProjects [(ConnectionName, ProjectName)]
-> [(ConnectionName, ProjectName)]
-> [(ConnectionName, ProjectName)]
forall a. Semigroup a => a -> a -> a
<> (TenantProject -> (ConnectionName, ProjectName))
-> [TenantProject] -> [(ConnectionName, ProjectName)]
forall a b. (a -> b) -> [a] -> [b]
map TenantProject -> (ConnectionName, ProjectName)
forall {r} {b}. HasField "name" r b => r -> (ConnectionName, b)
toProject TenantConnectionConfig
tcc.untrustedProjects
                    where
                      toProject :: r -> (ConnectionName, b)
toProject r
tp = (ConnectionName
conn, r
tp.name)
               in ((ConnectionName, TenantConnectionConfig)
 -> [(ConnectionName, ProjectName)])
-> [(ConnectionName, TenantConnectionConfig)]
-> [(ConnectionName, ProjectName)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ConnectionName, TenantConnectionConfig)
-> [(ConnectionName, ProjectName)]
tenantProjects ([(ConnectionName, TenantConnectionConfig)]
 -> [(ConnectionName, ProjectName)])
-> [(ConnectionName, TenantConnectionConfig)]
-> [(ConnectionName, ProjectName)]
forall a b. (a -> b) -> a -> b
$ Map ConnectionName TenantConnectionConfig
-> [(ConnectionName, TenantConnectionConfig)]
forall k a. Map k a -> [(k, a)]
Map.toList r
tenantConfig.connections
            getCanonicalName :: (ConnectionName, ProjectName) -> Maybe CanonicalProjectName
getCanonicalName (ConnectionName
cn, ProjectName
pname) = case ConnectionName
-> Map ConnectionName ProviderName -> Maybe ProviderName
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ConnectionName
cn ServiceConfig
sc.connections of
              Just ProviderName
pn -> CanonicalProjectName -> Maybe CanonicalProjectName
forall a. a -> Maybe a
Just (ProviderName -> ProjectName -> CanonicalProjectName
CanonicalProjectName ProviderName
pn ProjectName
pname)
              Maybe ProviderName
Nothing -> Maybe CanonicalProjectName
forall a. Maybe a
Nothing

        -- The list of provider named based on the available tenants connection.
        allProviders :: Map TenantName TenantConfig -> Set ProviderName
        allProviders :: Map TenantName TenantConfig -> Set ProviderName
allProviders =
          [ProviderName] -> Set ProviderName
forall a. Ord a => [a] -> Set a
Set.fromList
            ([ProviderName] -> Set ProviderName)
-> (Map TenantName TenantConfig -> [ProviderName])
-> Map TenantName TenantConfig
-> Set ProviderName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConnectionName -> Maybe ProviderName)
-> [ConnectionName] -> [ProviderName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\ConnectionName
cn -> ConnectionName
-> Map ConnectionName ProviderName -> Maybe ProviderName
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ConnectionName
cn ServiceConfig
sc.connections)
            ([ConnectionName] -> [ProviderName])
-> (Map TenantName TenantConfig -> [ConnectionName])
-> Map TenantName TenantConfig
-> [ProviderName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TenantConfig -> [ConnectionName])
-> [TenantConfig] -> [ConnectionName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\TenantConfig
tenantConfig -> Map ConnectionName TenantConnectionConfig -> [ConnectionName]
forall k a. Map k a -> [k]
Map.keys TenantConfig
tenantConfig.connections)
            ([TenantConfig] -> [ConnectionName])
-> (Map TenantName TenantConfig -> [TenantConfig])
-> Map TenantName TenantConfig
-> [ConnectionName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TenantName TenantConfig -> [TenantConfig]
allTenantsConfig

resolveTenant ::
  ServiceConfig ->
  TenantsConfig ->
  ConfigLoc ->
  ZuulConfigType ->
  Set TenantName
resolveTenant :: ServiceConfig
-> TenantsConfig -> ConfigLoc -> ZuulConfigType -> Set TenantName
resolveTenant ServiceConfig
serviceConfig TenantsConfig
tenantsConfig ConfigLoc
configLoc ZuulConfigType
zct =
  [TenantName] -> Set TenantName
forall a. Ord a => [a] -> Set a
Set.fromList ([TenantName] -> Set TenantName) -> [TenantName] -> Set TenantName
forall a b. (a -> b) -> a -> b
$ ((TenantName, TenantConfig) -> TenantName)
-> [(TenantName, TenantConfig)] -> [TenantName]
forall a b. (a -> b) -> [a] -> [b]
map (TenantName, TenantConfig) -> TenantName
forall a b. (a, b) -> a
fst ([(TenantName, TenantConfig)] -> [TenantName])
-> [(TenantName, TenantConfig)] -> [TenantName]
forall a b. (a -> b) -> a -> b
$ ((TenantName, TenantConfig) -> Bool)
-> [(TenantName, TenantConfig)] -> [(TenantName, TenantConfig)]
forall a. (a -> Bool) -> [a] -> [a]
filter (TenantConfig -> Bool
containsProject (TenantConfig -> Bool)
-> ((TenantName, TenantConfig) -> TenantConfig)
-> (TenantName, TenantConfig)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TenantName, TenantConfig) -> TenantConfig
forall a b. (a, b) -> b
snd) ([(TenantName, TenantConfig)] -> [(TenantName, TenantConfig)])
-> [(TenantName, TenantConfig)] -> [(TenantName, TenantConfig)]
forall a b. (a -> b) -> a -> b
$ Map TenantName TenantConfig -> [(TenantName, TenantConfig)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map TenantName TenantConfig -> [(TenantName, TenantConfig)])
-> Map TenantName TenantConfig -> [(TenantName, TenantConfig)]
forall a b. (a -> b) -> a -> b
$ TenantsConfig
tenantsConfig.tenants
  where
    containsProject :: TenantConfig -> Bool
    containsProject :: TenantConfig -> Bool
containsProject TenantConfig
tc = ((ConnectionName, TenantConnectionConfig) -> Bool)
-> [(ConnectionName, TenantConnectionConfig)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ConnectionName, TenantConnectionConfig) -> Bool
containsProject' ([(ConnectionName, TenantConnectionConfig)] -> Bool)
-> [(ConnectionName, TenantConnectionConfig)] -> Bool
forall a b. (a -> b) -> a -> b
$ Map ConnectionName TenantConnectionConfig
-> [(ConnectionName, TenantConnectionConfig)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map ConnectionName TenantConnectionConfig
 -> [(ConnectionName, TenantConnectionConfig)])
-> Map ConnectionName TenantConnectionConfig
-> [(ConnectionName, TenantConnectionConfig)]
forall a b. (a -> b) -> a -> b
$ TenantConfig
tc.connections
    containsProject' :: (ConnectionName, TenantConnectionConfig) -> Bool
    containsProject' :: (ConnectionName, TenantConnectionConfig) -> Bool
containsProject' (ConnectionName
cn, TenantConnectionConfig
tcc) = (TenantProject -> Bool) -> [TenantProject] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TenantProject -> Bool
matchProject ([TenantProject] -> Bool) -> [TenantProject] -> Bool
forall a b. (a -> b) -> a -> b
$ TenantConnectionConfig
tcc.configProjects [TenantProject] -> [TenantProject] -> [TenantProject]
forall a. Semigroup a => a -> a -> a
<> TenantConnectionConfig
tcc.untrustedProjects
      where
        matchProject :: TenantProject -> Bool
        matchProject :: TenantProject -> Bool
matchProject TenantProject
tp =
          let providerName :: ProviderName
providerName = case ConnectionName
-> Map ConnectionName ProviderName -> Maybe ProviderName
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ConnectionName
cn ServiceConfig
serviceConfig.connections of
                Just ProviderName
pn -> ProviderName
pn
                Maybe ProviderName
Nothing -> [Char] -> ProviderName
forall a. HasCallStack => [Char] -> a
error [Char]
"Unable to find project connection's provider name"
           in [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
                [ ProviderName -> ProjectName -> CanonicalProjectName
CanonicalProjectName ProviderName
providerName TenantProject
tp.name CanonicalProjectName -> CanonicalProjectName -> Bool
forall a. Eq a => a -> a -> Bool
== ConfigLoc
configLoc.project,
                  ZuulConfigType
zct ZuulConfigType -> Set ZuulConfigType -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` TenantProject
tp.includedConfigElements,
                  (FilePathT -> Bool) -> [FilePathT] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any FilePathT -> Bool
matchPath TenantProject
tp.configPaths
                ]
        matchPath :: FilePathT -> Bool
        matchPath :: FilePathT -> Bool
matchPath FilePathT
fp = FilePathT -> Text
forall source target. From source target => source -> target
from FilePathT
fp Text -> Text -> Bool
`Text.isPrefixOf` FilePathT -> Text
forall source target. From source target => source -> target
from ConfigLoc
configLoc.path