-- |
-- Module      : Zuul.ConfigLoader
-- Description : Parse configuration items
-- Copyright   : (c) Red Hat, 2022
-- License     : Apache-2.0
--
-- Maintainer  : tdecacqu@redhat.com, fboucher@redhat.com
-- Stability   : provisional
-- Portability : portable
--
-- This module contains the logic to decode configuration file content.
module Zuul.ConfigLoader
  ( -- * The resulting configuration
    ConfigMap,
    Config (..),
    ConfigError,
    loadConfig,
    mergeConfig,
    emptyConfig,
    TenantResolver,
    ConnectionUrlMap,

    -- * Test helper
    decodeConfig,
  )
where

import Data.Aeson (Object, Value (Array, Bool, Null, String))
import Data.Aeson.Key qualified
import Data.Aeson.KeyMap qualified as HM (keys, lookup, toList)
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as Text
import Data.Vector qualified as V
import Zuul.Config
import Zuul.Tenant (TenantResolver (..))
import Zuul.ZooKeeper (ConfigError (..), ZKFile (..))
import ZuulWeeder.Prelude

-- | A config map contains the list of every variants associated with their location.
type ConfigMap a b = Map a [(ConfigLoc, b)]

-- | The global configuration map.
data Config = Config
  { -- | The jobs.
    Config -> ConfigMap JobName Job
jobs :: ConfigMap JobName Job,
    -- | The nodesets.
    Config -> ConfigMap NodesetName Nodeset
nodesets :: ConfigMap NodesetName Nodeset,
    -- | The node labels.
    Config -> ConfigMap NodeLabelName NodeLabelName
nodeLabels :: ConfigMap NodeLabelName NodeLabelName,
    -- | The projects.
    Config -> ConfigMap CanonicalProjectName Project
projects :: ConfigMap CanonicalProjectName Project,
    -- | The projects regexp.
    Config -> ConfigMap ProjectRegex Project
projectRegexs :: ConfigMap ProjectRegex Project,
    -- | The project-templates.
    Config -> ConfigMap ProjectTemplateName ProjectTemplate
projectTemplates :: ConfigMap ProjectTemplateName ProjectTemplate,
    -- | The pipelines.
    Config -> ConfigMap PipelineName Pipeline
pipelines :: ConfigMap PipelineName Pipeline,
    -- | The secrets.
    Config -> ConfigMap SecretName SecretName
secrets :: ConfigMap SecretName SecretName,
    -- | The queues.
    Config -> ConfigMap QueueName QueueName
queues :: ConfigMap QueueName QueueName,
    -- | The semaphores.
    Config -> ConfigMap SemaphoreName SemaphoreName
semaphores :: ConfigMap SemaphoreName SemaphoreName,
    -- | The pipeline triggers.
    Config -> ConfigMap ConnectionName ConnectionName
triggers :: ConfigMap ConnectionName ConnectionName,
    -- | The pipeline reporters.
    Config -> ConfigMap ConnectionName ConnectionName
reporters :: ConfigMap ConnectionName ConnectionName,
    -- | Configuration errors.
    Config -> [ConfigError]
configErrors :: [ConfigError],
    -- | The list of all tenants
    Config -> Set TenantName
tenants :: Set TenantName
  }
  deriving (Int -> Config -> ShowS
[Config] -> ShowS
Config -> [Char]
(Int -> Config -> ShowS)
-> (Config -> [Char]) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> [Char]
$cshow :: Config -> [Char]
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show, (forall x. Config -> Rep Config x)
-> (forall x. Rep Config x -> Config) -> Generic Config
forall x. Rep Config x -> Config
forall x. Config -> Rep Config x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Config x -> Config
$cfrom :: forall x. Config -> Rep Config x
Generic, Value -> Parser [Config]
Value -> Parser Config
(Value -> Parser Config)
-> (Value -> Parser [Config]) -> FromJSON Config
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Config]
$cparseJSONList :: Value -> Parser [Config]
parseJSON :: Value -> Parser Config
$cparseJSON :: Value -> Parser Config
FromJSON, [Config] -> Encoding
[Config] -> Value
Config -> Encoding
Config -> Value
(Config -> Value)
-> (Config -> Encoding)
-> ([Config] -> Value)
-> ([Config] -> Encoding)
-> ToJSON Config
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Config] -> Encoding
$ctoEncodingList :: [Config] -> Encoding
toJSONList :: [Config] -> Value
$ctoJSONList :: [Config] -> Value
toEncoding :: Config -> Encoding
$ctoEncoding :: Config -> Encoding
toJSON :: Config -> Value
$ctoJSON :: Config -> Value
ToJSON)

-- | Merge two configurations by assigning unique tenant names.
mergeConfig :: Config -> Config -> Config
mergeConfig :: Config -> Config -> Config
mergeConfig Config
c1 Config
c2 =
  Config
    { $sel:jobs:Config :: ConfigMap JobName Job
jobs = Config
c1.jobs ConfigMap JobName Job
-> ConfigMap JobName Job -> ConfigMap JobName Job
forall a b.
(Ord a, Eq b) =>
ConfigMap a b -> ConfigMap a b -> ConfigMap a b
`mergeMap` Config
c2.jobs,
      $sel:nodesets:Config :: ConfigMap NodesetName Nodeset
nodesets = Config
c1.nodesets ConfigMap NodesetName Nodeset
-> ConfigMap NodesetName Nodeset -> ConfigMap NodesetName Nodeset
forall a b.
(Ord a, Eq b) =>
ConfigMap a b -> ConfigMap a b -> ConfigMap a b
`mergeMap` Config
c2.nodesets,
      $sel:nodeLabels:Config :: ConfigMap NodeLabelName NodeLabelName
nodeLabels = Config
c1.nodeLabels ConfigMap NodeLabelName NodeLabelName
-> ConfigMap NodeLabelName NodeLabelName
-> ConfigMap NodeLabelName NodeLabelName
forall a b.
(Ord a, Eq b) =>
ConfigMap a b -> ConfigMap a b -> ConfigMap a b
`mergeMap` Config
c2.nodeLabels,
      $sel:projects:Config :: ConfigMap CanonicalProjectName Project
projects = Config
c1.projects ConfigMap CanonicalProjectName Project
-> ConfigMap CanonicalProjectName Project
-> ConfigMap CanonicalProjectName Project
forall a b.
(Ord a, Eq b) =>
ConfigMap a b -> ConfigMap a b -> ConfigMap a b
`mergeMap` Config
c2.projects,
      $sel:projectRegexs:Config :: ConfigMap ProjectRegex Project
projectRegexs = Config
c1.projectRegexs ConfigMap ProjectRegex Project
-> ConfigMap ProjectRegex Project -> ConfigMap ProjectRegex Project
forall a b.
(Ord a, Eq b) =>
ConfigMap a b -> ConfigMap a b -> ConfigMap a b
`mergeMap` Config
c2.projectRegexs,
      $sel:projectTemplates:Config :: ConfigMap ProjectTemplateName ProjectTemplate
projectTemplates = Config
c1.projectTemplates ConfigMap ProjectTemplateName ProjectTemplate
-> ConfigMap ProjectTemplateName ProjectTemplate
-> ConfigMap ProjectTemplateName ProjectTemplate
forall a b.
(Ord a, Eq b) =>
ConfigMap a b -> ConfigMap a b -> ConfigMap a b
`mergeMap` Config
c2.projectTemplates,
      $sel:pipelines:Config :: ConfigMap PipelineName Pipeline
pipelines = Config
c1.pipelines ConfigMap PipelineName Pipeline
-> ConfigMap PipelineName Pipeline
-> ConfigMap PipelineName Pipeline
forall a b.
(Ord a, Eq b) =>
ConfigMap a b -> ConfigMap a b -> ConfigMap a b
`mergeMap` Config
c2.pipelines,
      $sel:secrets:Config :: ConfigMap SecretName SecretName
secrets = Config
c1.secrets ConfigMap SecretName SecretName
-> ConfigMap SecretName SecretName
-> ConfigMap SecretName SecretName
forall a b.
(Ord a, Eq b) =>
ConfigMap a b -> ConfigMap a b -> ConfigMap a b
`mergeMap` Config
c2.secrets,
      $sel:queues:Config :: ConfigMap QueueName QueueName
queues = Config
c1.queues ConfigMap QueueName QueueName
-> ConfigMap QueueName QueueName -> ConfigMap QueueName QueueName
forall a b.
(Ord a, Eq b) =>
ConfigMap a b -> ConfigMap a b -> ConfigMap a b
`mergeMap` Config
c2.queues,
      $sel:semaphores:Config :: ConfigMap SemaphoreName SemaphoreName
semaphores = Config
c1.semaphores ConfigMap SemaphoreName SemaphoreName
-> ConfigMap SemaphoreName SemaphoreName
-> ConfigMap SemaphoreName SemaphoreName
forall a b.
(Ord a, Eq b) =>
ConfigMap a b -> ConfigMap a b -> ConfigMap a b
`mergeMap` Config
c2.semaphores,
      $sel:triggers:Config :: ConfigMap ConnectionName ConnectionName
triggers = Config
c1.triggers ConfigMap ConnectionName ConnectionName
-> ConfigMap ConnectionName ConnectionName
-> ConfigMap ConnectionName ConnectionName
forall a b.
(Ord a, Eq b) =>
ConfigMap a b -> ConfigMap a b -> ConfigMap a b
`mergeMap` Config
c2.triggers,
      $sel:reporters:Config :: ConfigMap ConnectionName ConnectionName
reporters = Config
c1.reporters ConfigMap ConnectionName ConnectionName
-> ConfigMap ConnectionName ConnectionName
-> ConfigMap ConnectionName ConnectionName
forall a b.
(Ord a, Eq b) =>
ConfigMap a b -> ConfigMap a b -> ConfigMap a b
`mergeMap` Config
c2.reporters,
      $sel:configErrors:Config :: [ConfigError]
configErrors = [ConfigError] -> [ConfigError]
forall a. Eq a => [a] -> [a]
nub ([ConfigError] -> [ConfigError]) -> [ConfigError] -> [ConfigError]
forall a b. (a -> b) -> a -> b
$ Config
c1.configErrors [ConfigError] -> [ConfigError] -> [ConfigError]
forall a. Semigroup a => a -> a -> a
<> Config
c2.configErrors,
      $sel:tenants:Config :: Set TenantName
tenants = Set TenantName
newTenants
    }
  where
    -- The new tenants list with unique name
    newTenants :: Set TenantName
newTenants = Set TenantName -> Set TenantName -> Set TenantName
forall a. Ord a => Set a -> Set a -> Set a
Set.union Config
c1.tenants ((TenantName -> TenantName) -> Set TenantName -> Set TenantName
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map TenantName -> TenantName
renameTenant Config
c2.tenants)

    mergeMap :: (Ord a, Eq b) => ConfigMap a b -> ConfigMap a b -> ConfigMap a b
    mergeMap :: forall a b.
(Ord a, Eq b) =>
ConfigMap a b -> ConfigMap a b -> ConfigMap a b
mergeMap = ([(ConfigLoc, b)] -> [(ConfigLoc, b)] -> [(ConfigLoc, b)])
-> Map a [(ConfigLoc, b)]
-> Map a [(ConfigLoc, b)]
-> Map a [(ConfigLoc, b)]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [(ConfigLoc, b)] -> [(ConfigLoc, b)] -> [(ConfigLoc, b)]
forall b.
Eq b =>
[(ConfigLoc, b)] -> [(ConfigLoc, b)] -> [(ConfigLoc, b)]
mergeLocs

    mergeLocs :: (Eq b) => [(ConfigLoc, b)] -> [(ConfigLoc, b)] -> [(ConfigLoc, b)]
    mergeLocs :: forall b.
Eq b =>
[(ConfigLoc, b)] -> [(ConfigLoc, b)] -> [(ConfigLoc, b)]
mergeLocs [(ConfigLoc, b)]
cm1 [(ConfigLoc, b)]
cm2 = ([(ConfigLoc, b)] -> (ConfigLoc, b) -> [(ConfigLoc, b)])
-> [(ConfigLoc, b)] -> [(ConfigLoc, b)] -> [(ConfigLoc, b)]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [(ConfigLoc, b)] -> (ConfigLoc, b) -> [(ConfigLoc, b)]
forall b.
Eq b =>
[(ConfigLoc, b)] -> (ConfigLoc, b) -> [(ConfigLoc, b)]
mergeConfigLoc [] ([(ConfigLoc, b)] -> [(ConfigLoc, b)])
-> [(ConfigLoc, b)] -> [(ConfigLoc, b)]
forall a b. (a -> b) -> a -> b
$ [(ConfigLoc, b)]
cm1 [(ConfigLoc, b)] -> [(ConfigLoc, b)] -> [(ConfigLoc, b)]
forall a. Semigroup a => a -> a -> a
<> ((ConfigLoc -> ConfigLoc) -> (ConfigLoc, b) -> (ConfigLoc, b)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ConfigLoc -> ConfigLoc
renameLoc ((ConfigLoc, b) -> (ConfigLoc, b))
-> [(ConfigLoc, b)] -> [(ConfigLoc, b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ConfigLoc, b)]
cm2)
      where
        renameLoc :: ConfigLoc -> ConfigLoc
        renameLoc :: ConfigLoc -> ConfigLoc
renameLoc ConfigLoc
loc = ConfigLoc
loc ConfigLoc -> (ConfigLoc -> ConfigLoc) -> ConfigLoc
forall a b. a -> (a -> b) -> b
& ASetter ConfigLoc ConfigLoc (Set TenantName) (Set TenantName)
#tenants ASetter ConfigLoc ConfigLoc (Set TenantName) (Set TenantName)
-> Set TenantName -> ConfigLoc -> ConfigLoc
forall s t a b. ASetter s t a b -> b -> s -> t
`set` (TenantName -> TenantName) -> Set TenantName -> Set TenantName
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map TenantName -> TenantName
renameTenant ConfigLoc
loc.tenants

    mergeConfigLoc :: Eq b => [(ConfigLoc, b)] -> (ConfigLoc, b) -> [(ConfigLoc, b)]
    mergeConfigLoc :: forall b.
Eq b =>
[(ConfigLoc, b)] -> (ConfigLoc, b) -> [(ConfigLoc, b)]
mergeConfigLoc [(ConfigLoc, b)]
xs x :: (ConfigLoc, b)
x@(ConfigLoc
loc2, b
obj2) = Bool -> [(ConfigLoc, b)] -> [(ConfigLoc, b)]
go Bool
False [(ConfigLoc, b)]
xs
      where
        -- The object was not found in c1
        go :: Bool -> [(ConfigLoc, b)] -> [(ConfigLoc, b)]
go Bool
False [] = [(ConfigLoc, b)
x]
        -- The object was merged
        go Bool
True [] = []
        -- Check if the object can be merged
        go Bool
merged ((ConfigLoc
loc1, b
obj1) : [(ConfigLoc, b)]
rest)
          | b
obj1 b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
obj2 Bool -> Bool -> Bool
&& ConfigLoc
loc1 ConfigLoc -> ConfigLoc -> Bool
`sameLoc` ConfigLoc
loc2 = (ConfigLoc
loc1 ConfigLoc -> ConfigLoc -> ConfigLoc
`mergeLoc` ConfigLoc
loc2, b
obj1) (ConfigLoc, b) -> [(ConfigLoc, b)] -> [(ConfigLoc, b)]
forall a. a -> [a] -> [a]
: Bool -> [(ConfigLoc, b)] -> [(ConfigLoc, b)]
go Bool
True [(ConfigLoc, b)]
rest
          | Bool
otherwise = (ConfigLoc
loc1, b
obj1) (ConfigLoc, b) -> [(ConfigLoc, b)] -> [(ConfigLoc, b)]
forall a. a -> [a] -> [a]
: Bool -> [(ConfigLoc, b)] -> [(ConfigLoc, b)]
go Bool
merged [(ConfigLoc, b)]
rest

        sameLoc :: ConfigLoc -> ConfigLoc -> Bool
        sameLoc :: ConfigLoc -> ConfigLoc -> Bool
sameLoc ConfigLoc
l1 ConfigLoc
l2 =
          [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
            [ ConfigLoc
l1.project CanonicalProjectName -> CanonicalProjectName -> Bool
forall a. Eq a => a -> a -> Bool
== ConfigLoc
l2.project,
              ConfigLoc
l1.branch BranchName -> BranchName -> Bool
forall a. Eq a => a -> a -> Bool
== ConfigLoc
l2.branch,
              ConfigLoc
l1.path FilePathT -> FilePathT -> Bool
forall a. Eq a => a -> a -> Bool
== ConfigLoc
l2.path,
              ConfigLoc
l1.url ConnectionUrl -> ConnectionUrl -> Bool
forall a. Eq a => a -> a -> Bool
== ConfigLoc
l2.url
            ]

        mergeLoc :: ConfigLoc -> ConfigLoc -> ConfigLoc
        mergeLoc :: ConfigLoc -> ConfigLoc -> ConfigLoc
mergeLoc ConfigLoc
l1 ConfigLoc
l2 = ConfigLoc
l1 ConfigLoc -> (ConfigLoc -> ConfigLoc) -> ConfigLoc
forall a b. a -> (a -> b) -> b
& ASetter ConfigLoc ConfigLoc (Set TenantName) (Set TenantName)
#tenants ASetter ConfigLoc ConfigLoc (Set TenantName) (Set TenantName)
-> Set TenantName -> ConfigLoc -> ConfigLoc
forall s t a b. ASetter s t a b -> b -> s -> t
`set` Set TenantName -> Set TenantName -> Set TenantName
forall a. Ord a => Set a -> Set a -> Set a
Set.union ConfigLoc
l1.tenants ConfigLoc
l2.tenants

    -- The renameTenant create unique tenant names for c2 locations
    renameTenant :: TenantName -> TenantName
    renameTenant :: TenantName -> TenantName
renameTenant TenantName
tenantName
      | TenantName
tenantName TenantName -> Set TenantName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set TenantName
commonTenants = case (TenantName -> Char -> Either TenantName TenantName)
-> TenantName -> [Char] -> Either TenantName TenantName
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM TenantName -> Char -> Either TenantName TenantName
mkTenantName TenantName
tenantName [Char
'1' .. Char
'9'] of
          Left TenantName
newName -> TenantName
newName
          Right TenantName
_ -> [Char] -> TenantName
forall a. HasCallStack => [Char] -> a
error ([Char] -> TenantName) -> [Char] -> TenantName
forall a b. (a -> b) -> a -> b
$ [Char]
"Can't create a new tenant name for " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> TenantName -> [Char]
forall a. Show a => a -> [Char]
show TenantName
tenantName
      | Bool
otherwise = TenantName
tenantName
    commonTenants :: Set TenantName
commonTenants = Set TenantName -> Set TenantName -> Set TenantName
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Config
c1.tenants Config
c2.tenants

    -- Returns Left if the name is unique, otherwise returns Right
    mkTenantName :: TenantName -> Char -> Either TenantName TenantName
    mkTenantName :: TenantName -> Char -> Either TenantName TenantName
mkTenantName oldName :: TenantName
oldName@(TenantName Text
n) Char
c
      | TenantName
newName TenantName -> Set TenantName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set TenantName
allTenants = TenantName -> Either TenantName TenantName
forall a b. b -> Either a b
Right TenantName
oldName
      | Bool
otherwise = TenantName -> Either TenantName TenantName
forall a b. a -> Either a b
Left TenantName
newName
      where
        newName :: TenantName
newName = Text -> TenantName
TenantName (Text -> TenantName) -> Text -> TenantName
forall a b. (a -> b) -> a -> b
$ Text -> Char -> Text
Text.snoc Text
n Char
c
    allTenants :: Set TenantName
allTenants = Set TenantName -> Set TenantName -> Set TenantName
forall a. Ord a => Set a -> Set a -> Set a
Set.union Config
c1.tenants Config
c2.tenants

doUpdateTopConfig :: TenantResolver -> ConfigLoc -> ZuulConfigElement -> StateT Config IO ()
doUpdateTopConfig :: TenantResolver
-> ConfigLoc -> ZuulConfigElement -> StateT Config IO ()
doUpdateTopConfig TenantResolver
tr ConfigLoc
configLoc ZuulConfigElement
ze = case ZuulConfigElement
ze of
  ZJob Job
job -> ASetter
  Config Config (ConfigMap JobName Job) (ConfigMap JobName Job)
#jobs ASetter
  Config Config (ConfigMap JobName Job) (ConfigMap JobName Job)
-> (ConfigMap JobName Job -> ConfigMap JobName Job)
-> StateT Config IO ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= JobName -> Job -> ConfigMap JobName Job -> ConfigMap JobName Job
forall {k} {b}.
Ord k =>
k -> b -> Map k [(ConfigLoc, b)] -> Map k [(ConfigLoc, b)]
insertConfig Job
job.name Job
job
  ZNodeset Nodeset
node -> do
    #nodesets %= insertConfig node.name node
    traverse_ (\v -> #nodeLabels %= insertConfig v v) $ Set.fromList node.labels
  ZProject Project
project
    | ProjectName -> Bool
isRegex Project
project.name -> ASetter
  Config
  Config
  (ConfigMap ProjectRegex Project)
  (ConfigMap ProjectRegex Project)
#projectRegexs ASetter
  Config
  Config
  (ConfigMap ProjectRegex Project)
  (ConfigMap ProjectRegex Project)
-> (ConfigMap ProjectRegex Project
    -> ConfigMap ProjectRegex Project)
-> StateT Config IO ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ProjectRegex
-> Project
-> ConfigMap ProjectRegex Project
-> ConfigMap ProjectRegex Project
forall {k} {b}.
Ord k =>
k -> b -> Map k [(ConfigLoc, b)] -> Map k [(ConfigLoc, b)]
insertConfig (ProjectName -> ProjectRegex
forall source target. From source target => source -> target
from Project
project.name) Project
project
    | Bool
otherwise -> case TenantResolver
tr.resolveProject ConfigLoc
configLoc Project
project.name of
        Just CanonicalProjectName
pn -> ASetter
  Config
  Config
  (ConfigMap CanonicalProjectName Project)
  (ConfigMap CanonicalProjectName Project)
#projects ASetter
  Config
  Config
  (ConfigMap CanonicalProjectName Project)
  (ConfigMap CanonicalProjectName Project)
-> (ConfigMap CanonicalProjectName Project
    -> ConfigMap CanonicalProjectName Project)
-> StateT Config IO ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= CanonicalProjectName
-> Project
-> ConfigMap CanonicalProjectName Project
-> ConfigMap CanonicalProjectName Project
forall {k} {b}.
Ord k =>
k -> b -> Map k [(ConfigLoc, b)] -> Map k [(ConfigLoc, b)]
insertConfig CanonicalProjectName
pn Project
project
        Maybe CanonicalProjectName
Nothing -> ASetter Config Config [ConfigError] [ConfigError]
#configErrors ASetter Config Config [ConfigError] [ConfigError]
-> ([ConfigError] -> [ConfigError]) -> StateT Config IO ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Text -> ConfigError
AmbiguousName (ProjectName -> Text
forall source target. From source target => source -> target
from Project
project.name) :)
  ZProjectTemplate ProjectTemplate
template -> ASetter
  Config
  Config
  (ConfigMap ProjectTemplateName ProjectTemplate)
  (ConfigMap ProjectTemplateName ProjectTemplate)
#projectTemplates ASetter
  Config
  Config
  (ConfigMap ProjectTemplateName ProjectTemplate)
  (ConfigMap ProjectTemplateName ProjectTemplate)
-> (ConfigMap ProjectTemplateName ProjectTemplate
    -> ConfigMap ProjectTemplateName ProjectTemplate)
-> StateT Config IO ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ProjectTemplateName
-> ProjectTemplate
-> ConfigMap ProjectTemplateName ProjectTemplate
-> ConfigMap ProjectTemplateName ProjectTemplate
forall {k} {b}.
Ord k =>
k -> b -> Map k [(ConfigLoc, b)] -> Map k [(ConfigLoc, b)]
insertConfig ProjectTemplate
template.name ProjectTemplate
template
  ZPipeline Pipeline
pipeline -> do
    #pipelines %= insertConfig pipeline.name pipeline
    traverse_ (\(PipelineTrigger v) -> #triggers %= insertConfig v v) pipeline.triggers
    traverse_ (\(PipelineReporter v) -> #reporters %= insertConfig v v) pipeline.reporters
  ZSecret SecretName
secret -> ASetter
  Config
  Config
  (ConfigMap SecretName SecretName)
  (ConfigMap SecretName SecretName)
#secrets ASetter
  Config
  Config
  (ConfigMap SecretName SecretName)
  (ConfigMap SecretName SecretName)
-> (ConfigMap SecretName SecretName
    -> ConfigMap SecretName SecretName)
-> StateT Config IO ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= SecretName
-> SecretName
-> ConfigMap SecretName SecretName
-> ConfigMap SecretName SecretName
forall {k} {b}.
Ord k =>
k -> b -> Map k [(ConfigLoc, b)] -> Map k [(ConfigLoc, b)]
insertConfig SecretName
secret SecretName
secret
  ZQueue QueueName
queue -> ASetter
  Config
  Config
  (ConfigMap QueueName QueueName)
  (ConfigMap QueueName QueueName)
#queues ASetter
  Config
  Config
  (ConfigMap QueueName QueueName)
  (ConfigMap QueueName QueueName)
-> (ConfigMap QueueName QueueName -> ConfigMap QueueName QueueName)
-> StateT Config IO ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= QueueName
-> QueueName
-> ConfigMap QueueName QueueName
-> ConfigMap QueueName QueueName
forall {k} {b}.
Ord k =>
k -> b -> Map k [(ConfigLoc, b)] -> Map k [(ConfigLoc, b)]
insertConfig QueueName
queue QueueName
queue
  ZSemaphore SemaphoreName
semaphore -> ASetter
  Config
  Config
  (ConfigMap SemaphoreName SemaphoreName)
  (ConfigMap SemaphoreName SemaphoreName)
#semaphores ASetter
  Config
  Config
  (ConfigMap SemaphoreName SemaphoreName)
  (ConfigMap SemaphoreName SemaphoreName)
-> (ConfigMap SemaphoreName SemaphoreName
    -> ConfigMap SemaphoreName SemaphoreName)
-> StateT Config IO ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= SemaphoreName
-> SemaphoreName
-> ConfigMap SemaphoreName SemaphoreName
-> ConfigMap SemaphoreName SemaphoreName
forall {k} {b}.
Ord k =>
k -> b -> Map k [(ConfigLoc, b)] -> Map k [(ConfigLoc, b)]
insertConfig SemaphoreName
semaphore SemaphoreName
semaphore
  where
    isRegex :: ProjectName -> Bool
isRegex (ProjectName Text
n) = Text
"^" Text -> Text -> Bool
`Text.isPrefixOf` Text
n
    insertConfig :: k -> b -> Map k [(ConfigLoc, b)] -> Map k [(ConfigLoc, b)]
insertConfig k
k b
v = ([(ConfigLoc, b)] -> [(ConfigLoc, b)] -> [(ConfigLoc, b)])
-> k
-> [(ConfigLoc, b)]
-> Map k [(ConfigLoc, b)]
-> Map k [(ConfigLoc, b)]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith [(ConfigLoc, b)] -> [(ConfigLoc, b)] -> [(ConfigLoc, b)]
forall a. Monoid a => a -> a -> a
mappend k
k [(ConfigLoc
configLoc, b
v)]

updateTopConfig :: TenantResolver -> ConfigLoc -> Decoder ZuulConfigElement -> StateT Config IO ()
updateTopConfig :: TenantResolver
-> ConfigLoc -> Decoder ZuulConfigElement -> StateT Config IO ()
updateTopConfig TenantResolver
tr ConfigLoc
configLoc (Decoder (Right ZuulConfigElement
ze))
  | Set TenantName -> Bool
forall a. Set a -> Bool
Set.null Set TenantName
tenants = () -> StateT Config IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  | Bool
otherwise = TenantResolver
-> ConfigLoc -> ZuulConfigElement -> StateT Config IO ()
doUpdateTopConfig TenantResolver
tr (ConfigLoc
configLoc ConfigLoc -> (ConfigLoc -> ConfigLoc) -> ConfigLoc
forall a b. a -> (a -> b) -> b
& ASetter ConfigLoc ConfigLoc (Set TenantName) (Set TenantName)
#tenants ASetter ConfigLoc ConfigLoc (Set TenantName) (Set TenantName)
-> Set TenantName -> ConfigLoc -> ConfigLoc
forall s t a b. ASetter s t a b -> b -> s -> t
`set` Set TenantName
tenants) ZuulConfigElement
ze
  where
    tenants :: Set TenantName
tenants = TenantResolver
tr.resolveTenants ConfigLoc
configLoc (ZuulConfigElement -> ZuulConfigType
forall source target. From source target => source -> target
from ZuulConfigElement
ze)
updateTopConfig TenantResolver
_ ConfigLoc
configLoc (Decoder (Left (Text
e, Value
v))) =
  #configErrors %= (DecodeError configLoc.path e v :)

-- | Low level helper to decode a config file into a list of 'ZuulConfigElement'.
decodeConfig :: (CanonicalProjectName, BranchName) -> Value -> [Decoder ZuulConfigElement]
decodeConfig :: (CanonicalProjectName, BranchName)
-> Value -> [Decoder ZuulConfigElement]
decodeConfig (CanonicalProjectName (ProviderName Text
providerName) (ProjectName Text
projectName), BranchName
_branch) Value
zkJSONData =
  case Value
zkJSONData of
    Array Array
vec -> (Value -> Maybe (Decoder ZuulConfigElement))
-> [Value] -> [Decoder ZuulConfigElement]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Decoder (Maybe ZuulConfigElement)
-> Maybe (Decoder ZuulConfigElement)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Decoder (Maybe ZuulConfigElement)
 -> Maybe (Decoder ZuulConfigElement))
-> (Value -> Decoder (Maybe ZuulConfigElement))
-> Value
-> Maybe (Decoder ZuulConfigElement)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Decoder (Maybe ZuulConfigElement)
getConfigElement) ([Value] -> [Decoder ZuulConfigElement])
-> [Value] -> [Decoder ZuulConfigElement]
forall a b. (a -> b) -> a -> b
$ Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
vec
    Value
_ -> [Text -> Value -> Decoder ZuulConfigElement
forall a. Text -> Value -> Decoder a
decodeFail Text
"Unexpected root data structure" Value
zkJSONData]
  where
    getConfigElement :: Value -> Decoder (Maybe ZuulConfigElement)
    getConfigElement :: Value -> Decoder (Maybe ZuulConfigElement)
getConfigElement Value
rootObj = do
      (Text
k, Object
obj) <- Object -> Decoder (Text, Object)
getObjectKey (Object -> Decoder (Text, Object))
-> Decoder Object -> Decoder (Text, Object)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Decoder Object
decodeObject Value
rootObj
      case Text
k of
        Text
"job" -> ZuulConfigElement -> Maybe ZuulConfigElement
forall a. a -> Maybe a
Just (ZuulConfigElement -> Maybe ZuulConfigElement)
-> (Job -> ZuulConfigElement) -> Job -> Maybe ZuulConfigElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Job -> ZuulConfigElement
ZJob (Job -> Maybe ZuulConfigElement)
-> Decoder Job -> Decoder (Maybe ZuulConfigElement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Decoder Job
decodeJob Object
obj
        Text
"nodeset" -> ZuulConfigElement -> Maybe ZuulConfigElement
forall a. a -> Maybe a
Just (ZuulConfigElement -> Maybe ZuulConfigElement)
-> (Nodeset -> ZuulConfigElement)
-> Nodeset
-> Maybe ZuulConfigElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nodeset -> ZuulConfigElement
ZNodeset (Nodeset -> Maybe ZuulConfigElement)
-> Decoder Nodeset -> Decoder (Maybe ZuulConfigElement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Decoder Nodeset
decodeNodeset Object
obj
        Text
"project" -> ZuulConfigElement -> Maybe ZuulConfigElement
forall a. a -> Maybe a
Just (ZuulConfigElement -> Maybe ZuulConfigElement)
-> (Project -> ZuulConfigElement)
-> Project
-> Maybe ZuulConfigElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Project -> ZuulConfigElement
ZProject (Project -> Maybe ZuulConfigElement)
-> Decoder Project -> Decoder (Maybe ZuulConfigElement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Decoder Project
decodeProject Object
obj
        Text
"project-template" -> ZuulConfigElement -> Maybe ZuulConfigElement
forall a. a -> Maybe a
Just (ZuulConfigElement -> Maybe ZuulConfigElement)
-> (ProjectTemplate -> ZuulConfigElement)
-> ProjectTemplate
-> Maybe ZuulConfigElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectTemplate -> ZuulConfigElement
ZProjectTemplate (ProjectTemplate -> Maybe ZuulConfigElement)
-> Decoder ProjectTemplate -> Decoder (Maybe ZuulConfigElement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Decoder ProjectTemplate
decodeProjectTemplate Object
obj
        Text
"pipeline" -> ZuulConfigElement -> Maybe ZuulConfigElement
forall a. a -> Maybe a
Just (ZuulConfigElement -> Maybe ZuulConfigElement)
-> (Pipeline -> ZuulConfigElement)
-> Pipeline
-> Maybe ZuulConfigElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pipeline -> ZuulConfigElement
ZPipeline (Pipeline -> Maybe ZuulConfigElement)
-> Decoder Pipeline -> Decoder (Maybe ZuulConfigElement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Decoder Pipeline
decodePipeline Object
obj
        Text
"queue" -> ZuulConfigElement -> Maybe ZuulConfigElement
forall a. a -> Maybe a
Just (ZuulConfigElement -> Maybe ZuulConfigElement)
-> (Text -> ZuulConfigElement) -> Text -> Maybe ZuulConfigElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueueName -> ZuulConfigElement
ZQueue (QueueName -> ZuulConfigElement)
-> (Text -> QueueName) -> Text -> ZuulConfigElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> QueueName
QueueName (Text -> Maybe ZuulConfigElement)
-> Decoder Text -> Decoder (Maybe ZuulConfigElement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Decoder Text
getName Object
obj
        Text
"semaphore" -> ZuulConfigElement -> Maybe ZuulConfigElement
forall a. a -> Maybe a
Just (ZuulConfigElement -> Maybe ZuulConfigElement)
-> (Text -> ZuulConfigElement) -> Text -> Maybe ZuulConfigElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SemaphoreName -> ZuulConfigElement
ZSemaphore (SemaphoreName -> ZuulConfigElement)
-> (Text -> SemaphoreName) -> Text -> ZuulConfigElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SemaphoreName
SemaphoreName (Text -> Maybe ZuulConfigElement)
-> Decoder Text -> Decoder (Maybe ZuulConfigElement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Decoder Text
getName Object
obj
        Text
"pragma" -> Maybe ZuulConfigElement -> Decoder (Maybe ZuulConfigElement)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ZuulConfigElement
forall a. Maybe a
Nothing
        Text
"secret" -> ZuulConfigElement -> Maybe ZuulConfigElement
forall a. a -> Maybe a
Just (ZuulConfigElement -> Maybe ZuulConfigElement)
-> (Text -> ZuulConfigElement) -> Text -> Maybe ZuulConfigElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretName -> ZuulConfigElement
ZSecret (SecretName -> ZuulConfigElement)
-> (Text -> SecretName) -> Text -> ZuulConfigElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SecretName
SecretName (Text -> Maybe ZuulConfigElement)
-> Decoder Text -> Decoder (Maybe ZuulConfigElement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Decoder Text
getName Object
obj
        Text
_ -> Text -> Value -> Decoder (Maybe ZuulConfigElement)
forall a. Text -> Value -> Decoder a
decodeFail Text
"Unknown root object" (Object -> Value
Object Object
obj)

    decodePipeline :: Object -> Decoder Pipeline
    decodePipeline :: Object -> Decoder Pipeline
decodePipeline Object
va = do
      PipelineName
name <- Text -> PipelineName
PipelineName (Text -> PipelineName) -> Decoder Text -> Decoder PipelineName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Decoder Text
getName Object
va
      [PipelineTrigger]
triggers <- (ConnectionName -> PipelineTrigger)
-> [ConnectionName] -> [PipelineTrigger]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConnectionName -> PipelineTrigger
PipelineTrigger ([ConnectionName] -> [PipelineTrigger])
-> Decoder [ConnectionName] -> Decoder [PipelineTrigger]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Decoder [ConnectionName]
getPipelineConnections Key
"trigger"
      [PipelineReporter]
reporters <-
        (ConnectionName -> PipelineReporter)
-> [ConnectionName] -> [PipelineReporter]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConnectionName -> PipelineReporter
PipelineReporter ([ConnectionName] -> [PipelineReporter])
-> ([[ConnectionName]] -> [ConnectionName])
-> [[ConnectionName]]
-> [PipelineReporter]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[ConnectionName]] -> [ConnectionName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          ([[ConnectionName]] -> [PipelineReporter])
-> Decoder [[ConnectionName]] -> Decoder [PipelineReporter]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Decoder [ConnectionName]] -> Decoder [[ConnectionName]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
            [ Key -> Decoder [ConnectionName]
getPipelineConnections Key
"success",
              Key -> Decoder [ConnectionName]
getPipelineConnections Key
"failure"
            ]
      Pipeline -> Decoder Pipeline
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pipeline -> Decoder Pipeline) -> Pipeline -> Decoder Pipeline
forall a b. (a -> b) -> a -> b
$ Pipeline {PipelineName
$sel:name:Pipeline :: PipelineName
name :: PipelineName
name, [PipelineTrigger]
$sel:triggers:Pipeline :: [PipelineTrigger]
triggers :: [PipelineTrigger]
triggers, [PipelineReporter]
$sel:reporters:Pipeline :: [PipelineReporter]
reporters :: [PipelineReporter]
reporters}
      where
        getPipelineConnections :: Key -> Decoder [ConnectionName]
getPipelineConnections Key
key = case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
HM.lookup Key
key Object
va of
          Just Value
v -> do
            Object
obj <- Value -> Decoder Object
decodeObject Value
v
            [ConnectionName] -> Decoder [ConnectionName]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ConnectionName] -> Decoder [ConnectionName])
-> [ConnectionName] -> Decoder [ConnectionName]
forall a b. (a -> b) -> a -> b
$ Text -> ConnectionName
ConnectionName (Text -> ConnectionName) -> (Key -> Text) -> Key -> ConnectionName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Text
Data.Aeson.Key.toText (Key -> ConnectionName) -> [Key] -> [ConnectionName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> [Key]
forall v. KeyMap v -> [Key]
HM.keys Object
obj
          Maybe Value
Nothing -> [ConnectionName] -> Decoder [ConnectionName]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

    decodeJob :: Object -> Decoder Job
    decodeJob :: Object -> Decoder Job
decodeJob Object
va = do
      JobName
name <- Text -> JobName
JobName (Text -> JobName) -> Decoder Text -> Decoder JobName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Decoder Text
getName Object
va
      JobName -> Object -> Decoder Job
decodeJobContent JobName
name Object
va

    decodeJobContent :: JobName -> Object -> Decoder Job
    decodeJobContent :: JobName -> Object -> Decoder Job
decodeJobContent JobName
name Object
va = do
      JobName
-> Maybe Bool
-> Maybe JobName
-> Maybe JobNodeset
-> Maybe [BranchName]
-> Maybe [JobName]
-> Maybe [SemaphoreName]
-> Maybe [SecretName]
-> Job
Job JobName
name
        (Maybe Bool
 -> Maybe JobName
 -> Maybe JobNodeset
 -> Maybe [BranchName]
 -> Maybe [JobName]
 -> Maybe [SemaphoreName]
 -> Maybe [SecretName]
 -> Job)
-> Decoder (Maybe Bool)
-> Decoder
     (Maybe JobName
      -> Maybe JobNodeset
      -> Maybe [BranchName]
      -> Maybe [JobName]
      -> Maybe [SemaphoreName]
      -> Maybe [SecretName]
      -> Job)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> Maybe Bool) -> Decoder Bool -> Decoder (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Maybe Bool
toMaybe' Decoder Bool
decodeJobAbstract
        Decoder
  (Maybe JobName
   -> Maybe JobNodeset
   -> Maybe [BranchName]
   -> Maybe [JobName]
   -> Maybe [SemaphoreName]
   -> Maybe [SecretName]
   -> Job)
-> Decoder (Maybe JobName)
-> Decoder
     (Maybe JobNodeset
      -> Maybe [BranchName]
      -> Maybe [JobName]
      -> Maybe [SemaphoreName]
      -> Maybe [SecretName]
      -> Job)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder (Maybe JobName)
decodeJobParent
        Decoder
  (Maybe JobNodeset
   -> Maybe [BranchName]
   -> Maybe [JobName]
   -> Maybe [SemaphoreName]
   -> Maybe [SecretName]
   -> Job)
-> Decoder (Maybe JobNodeset)
-> Decoder
     (Maybe [BranchName]
      -> Maybe [JobName]
      -> Maybe [SemaphoreName]
      -> Maybe [SecretName]
      -> Job)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder (Maybe JobNodeset)
decodeJobNodeset
        Decoder
  (Maybe [BranchName]
   -> Maybe [JobName]
   -> Maybe [SemaphoreName]
   -> Maybe [SecretName]
   -> Job)
-> Decoder (Maybe [BranchName])
-> Decoder
     (Maybe [JobName]
      -> Maybe [SemaphoreName] -> Maybe [SecretName] -> Job)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([BranchName] -> Maybe [BranchName])
-> Decoder [BranchName] -> Decoder (Maybe [BranchName])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [BranchName] -> Maybe [BranchName]
forall a. [a] -> Maybe [a]
toMaybe (Key -> (Text -> BranchName) -> Object -> Decoder [BranchName]
forall a. Key -> (Text -> a) -> Object -> Decoder [a]
decodeAsList Key
"branches" Text -> BranchName
BranchName Object
va)
        Decoder
  (Maybe [JobName]
   -> Maybe [SemaphoreName] -> Maybe [SecretName] -> Job)
-> Decoder (Maybe [JobName])
-> Decoder (Maybe [SemaphoreName] -> Maybe [SecretName] -> Job)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([JobName] -> Maybe [JobName])
-> Decoder [JobName] -> Decoder (Maybe [JobName])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [JobName] -> Maybe [JobName]
forall a. [a] -> Maybe [a]
toMaybe Decoder [JobName]
decodeJobDependencies
        Decoder (Maybe [SemaphoreName] -> Maybe [SecretName] -> Job)
-> Decoder (Maybe [SemaphoreName])
-> Decoder (Maybe [SecretName] -> Job)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([SemaphoreName] -> Maybe [SemaphoreName])
-> Decoder [SemaphoreName] -> Decoder (Maybe [SemaphoreName])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [SemaphoreName] -> Maybe [SemaphoreName]
forall a. [a] -> Maybe [a]
toMaybe Decoder [SemaphoreName]
decodeSemaphores
        Decoder (Maybe [SecretName] -> Job)
-> Decoder (Maybe [SecretName]) -> Decoder Job
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([SecretName] -> Maybe [SecretName])
-> Decoder [SecretName] -> Decoder (Maybe [SecretName])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [SecretName] -> Maybe [SecretName]
forall a. [a] -> Maybe [a]
toMaybe Decoder [SecretName]
decodeSecrets
      where
        toMaybe' :: Bool -> Maybe Bool
        toMaybe' :: Bool -> Maybe Bool
toMaybe' = \case
          Bool
False -> Maybe Bool
forall a. Maybe a
Nothing
          Bool
True -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True

        toMaybe :: [a] -> Maybe [a]
        toMaybe :: forall a. [a] -> Maybe [a]
toMaybe = \case
          [] -> Maybe [a]
forall a. Maybe a
Nothing
          [a]
xs -> [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
xs

        decodeJobAbstract :: Decoder Bool
        decodeJobAbstract :: Decoder Bool
decodeJobAbstract = Bool -> Decoder Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Decoder Bool) -> Bool -> Decoder Bool
forall a b. (a -> b) -> a -> b
$ case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
HM.lookup Key
"abstract" Object
va of
          Just (Bool Bool
x) -> Bool
x
          Maybe Value
_ -> Bool
False

        decodeJobParent :: Decoder (Maybe JobName)
        decodeJobParent :: Decoder (Maybe JobName)
decodeJobParent = case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
HM.lookup Key
"parent" Object
va of
          Just (String Text
p) -> Maybe JobName -> Decoder (Maybe JobName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe JobName -> Decoder (Maybe JobName))
-> Maybe JobName -> Decoder (Maybe JobName)
forall a b. (a -> b) -> a -> b
$ JobName -> Maybe JobName
forall a. a -> Maybe a
Just (JobName -> Maybe JobName) -> JobName -> Maybe JobName
forall a b. (a -> b) -> a -> b
$ Text -> JobName
JobName Text
p
          Just Value
Data.Aeson.Null -> Maybe JobName -> Decoder (Maybe JobName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe JobName
forall a. Maybe a
Nothing
          Just Value
x -> Text -> Value -> Decoder (Maybe JobName)
forall a. Text -> Value -> Decoder a
decodeFail Text
"Invalid parent key" Value
x
          Maybe Value
Nothing -> Maybe JobName -> Decoder (Maybe JobName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe JobName
forall a. Maybe a
Nothing

        decodeJobNodeset :: Decoder (Maybe JobNodeset)
        decodeJobNodeset :: Decoder (Maybe JobNodeset)
decodeJobNodeset = case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
HM.lookup Key
"nodeset" Object
va of
          Just (String Text
n) -> Maybe JobNodeset -> Decoder (Maybe JobNodeset)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe JobNodeset -> Decoder (Maybe JobNodeset))
-> Maybe JobNodeset -> Decoder (Maybe JobNodeset)
forall a b. (a -> b) -> a -> b
$ JobNodeset -> Maybe JobNodeset
forall a. a -> Maybe a
Just (JobNodeset -> Maybe JobNodeset)
-> (NodesetName -> JobNodeset) -> NodesetName -> Maybe JobNodeset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodesetName -> JobNodeset
JobNodeset (NodesetName -> Maybe JobNodeset)
-> NodesetName -> Maybe JobNodeset
forall a b. (a -> b) -> a -> b
$ Text -> NodesetName
NodesetName Text
n
          Just (Object Object
nObj) -> do
            Value
v <- Key -> Object -> Decoder Value
decodeObjectAttribute Key
"nodes" Object
nObj
            case Value
v of
              Array Array
nodes -> JobNodeset -> Maybe JobNodeset
forall a. a -> Maybe a
Just (JobNodeset -> Maybe JobNodeset)
-> Decoder JobNodeset -> Decoder (Maybe JobNodeset)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value] -> Decoder JobNodeset
decodeJobNodesetNodes (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
nodes)
              -- that's weird, nodeset.nodes does not have to be a list
              o :: Value
o@(Object Object
_) -> JobNodeset -> Maybe JobNodeset
forall a. a -> Maybe a
Just (JobNodeset -> Maybe JobNodeset)
-> Decoder JobNodeset -> Decoder (Maybe JobNodeset)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value] -> Decoder JobNodeset
decodeJobNodesetNodes [Value
o]
              Value
_ -> Text -> Value -> Decoder (Maybe JobNodeset)
forall a. Text -> Value -> Decoder a
decodeFail Text
"Unexpected nodes structure" (Object -> Value
Object Object
nObj)
          Just Value
_va -> Text -> Value -> Decoder (Maybe JobNodeset)
forall a. Text -> Value -> Decoder a
decodeFail Text
"Unexpected nodeset structure" Value
_va
          Maybe Value
Nothing -> Maybe JobNodeset -> Decoder (Maybe JobNodeset)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe JobNodeset
forall a. Maybe a
Nothing

        decodeJobDependencies :: Decoder [JobName]
        decodeJobDependencies :: Decoder [JobName]
decodeJobDependencies = case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
HM.lookup Key
"dependencies" Object
va of
          Just (String Text
v) -> [JobName] -> Decoder [JobName]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text -> JobName
JobName Text
v]
          Just (Array Array
xs) -> (Value -> Decoder JobName) -> [Value] -> Decoder [JobName]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Decoder JobName
decodeJobDependency (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
xs)
          Just Value
_ -> Text -> Value -> Decoder [JobName]
forall a. Text -> Value -> Decoder a
decodeFail Text
"Unexpected job dependencies value" (Object -> Value
Object Object
va)
          Maybe Value
Nothing -> [JobName] -> Decoder [JobName]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

        decodeJobDependency :: Value -> Decoder JobName
        decodeJobDependency :: Value -> Decoder JobName
decodeJobDependency = \case
          String Text
v -> JobName -> Decoder JobName
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JobName -> Decoder JobName) -> JobName -> Decoder JobName
forall a b. (a -> b) -> a -> b
$ Text -> JobName
JobName Text
v
          Object Object
v -> Text -> JobName
JobName (Text -> JobName) -> Decoder Text -> Decoder JobName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Decoder Text
getName Object
v
          Value
anyOther -> Text -> Value -> Decoder JobName
forall a. Text -> Value -> Decoder a
decodeFail Text
"Unexpected job dependency value" Value
anyOther

        decodeJobNodesetNodes :: [Value] -> Decoder JobNodeset
decodeJobNodesetNodes [Value]
xs = do
          [NodeLabelName]
names <- [Value] -> Decoder [NodeLabelName]
decodeNodesetNodes [Value]
xs
          JobNodeset -> Decoder JobNodeset
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JobNodeset -> Decoder JobNodeset)
-> JobNodeset -> Decoder JobNodeset
forall a b. (a -> b) -> a -> b
$ [NodeLabelName] -> JobNodeset
JobAnonymousNodeset [NodeLabelName]
names

        getListNames :: Text -> Object -> Decoder [Text]
        getListNames :: Text -> Object -> Decoder [Text]
getListNames (Text -> Key
Data.Aeson.Key.fromText -> Key
key) Object
obj = case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
HM.lookup Key
key Object
obj of
          Just (String Text
v) -> [Text] -> Decoder [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text
v]
          Just Value
v -> (Value -> Decoder Text) -> [Value] -> Decoder [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Decoder Text
stringOrName ([Value] -> Decoder [Text]) -> Decoder [Value] -> Decoder [Text]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Decoder [Value]
decodeList Value
v
          Maybe Value
Nothing -> [Text] -> Decoder [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
          where
            stringOrName :: Value -> Decoder Text
stringOrName = \case
              String Text
v -> Text -> Decoder Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
v
              Value
v -> Value -> Decoder Text
decodeString (Value -> Decoder Text) -> Decoder Value -> Decoder Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Key -> Object -> Decoder Value
decodeObjectAttribute Key
"name" (Object -> Decoder Value) -> Decoder Object -> Decoder Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Decoder Object
decodeObject Value
v

        decodeSecrets :: Decoder [SecretName]
decodeSecrets = (Text -> SecretName) -> [Text] -> [SecretName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> SecretName
SecretName ([Text] -> [SecretName]) -> Decoder [Text] -> Decoder [SecretName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Object -> Decoder [Text]
getListNames Text
"secrets" Object
va

        decodeSemaphores :: Decoder [SemaphoreName]
decodeSemaphores = (Text -> SemaphoreName) -> [Text] -> [SemaphoreName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> SemaphoreName
SemaphoreName ([Text] -> [SemaphoreName])
-> ([[Text]] -> [Text]) -> [[Text]] -> [SemaphoreName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> [SemaphoreName])
-> Decoder [[Text]] -> Decoder [SemaphoreName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Decoder [Text]] -> Decoder [[Text]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Decoder [Text]
deprecatedSemaphore, Text -> Object -> Decoder [Text]
getListNames Text
"semaphores" Object
va]
          where
            deprecatedSemaphore :: Decoder [Text]
deprecatedSemaphore = case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
HM.lookup Key
"semaphore" Object
va of
              Just (String Text
v) -> [Text] -> Decoder [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text
v]
              Just Value
v -> do
                Text
x <- Value -> Decoder Text
decodeString (Value -> Decoder Text) -> Decoder Value -> Decoder Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Key -> Object -> Decoder Value
decodeObjectAttribute Key
"name" (Object -> Decoder Value) -> Decoder Object -> Decoder Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Decoder Object
decodeObject Value
v
                [Text] -> Decoder [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text
x]
              Maybe Value
Nothing -> [Text] -> Decoder [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    decodeNodesetNodes :: [Value] -> Decoder [NodeLabelName]
    decodeNodesetNodes :: [Value] -> Decoder [NodeLabelName]
decodeNodesetNodes [Value]
xs = do
      [Text]
names <- (Value -> Decoder Text) -> [Value] -> Decoder [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Value -> Decoder Text
decodeString (Value -> Decoder Text)
-> (Value -> Decoder Value) -> Value -> Decoder Text
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Key -> Object -> Decoder Value
decodeObjectAttribute Key
"label" (Object -> Decoder Value)
-> (Value -> Decoder Object) -> Value -> Decoder Value
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Value -> Decoder Object
decodeObject) [Value]
xs
      [NodeLabelName] -> Decoder [NodeLabelName]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([NodeLabelName] -> Decoder [NodeLabelName])
-> [NodeLabelName] -> Decoder [NodeLabelName]
forall a b. (a -> b) -> a -> b
$ Text -> NodeLabelName
NodeLabelName (Text -> NodeLabelName) -> [Text] -> [NodeLabelName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
names

    decodeNodeset :: Object -> Decoder Nodeset
    decodeNodeset :: Object -> Decoder Nodeset
decodeNodeset Object
va = do
      NodesetName
name <- Text -> NodesetName
NodesetName (Text -> NodesetName) -> Decoder Text -> Decoder NodesetName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Decoder Text
getName Object
va
      [NodeLabelName]
labels <- [Value] -> Decoder [NodeLabelName]
decodeNodesetNodes ([Value] -> Decoder [NodeLabelName])
-> Decoder [Value] -> Decoder [NodeLabelName]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Decoder [Value]
decodeList (Value -> Decoder [Value]) -> Decoder Value -> Decoder [Value]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Key -> Object -> Decoder Value
decodeObjectAttribute Key
"nodes" Object
va
      Nodeset -> Decoder Nodeset
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Nodeset -> Decoder Nodeset) -> Nodeset -> Decoder Nodeset
forall a b. (a -> b) -> a -> b
$ Nodeset {NodesetName
$sel:name:Nodeset :: NodesetName
name :: NodesetName
name, [NodeLabelName]
$sel:labels:Nodeset :: [NodeLabelName]
labels :: [NodeLabelName]
labels}

    decodeProject :: Object -> Decoder Project
    decodeProject :: Object -> Decoder Project
decodeProject Object
va = do
      ProjectName
name <- case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
HM.lookup Key
"name" Object
va of
        (Just Value
x) -> Text -> ProjectName
ProjectName (Text -> ProjectName) -> Decoder Text -> Decoder ProjectName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Decoder Text
decodeString Value
x
        Maybe Value
Nothing -> ProjectName -> Decoder ProjectName
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectName -> Decoder ProjectName)
-> ProjectName -> Decoder ProjectName
forall a b. (a -> b) -> a -> b
$ Text -> ProjectName
ProjectName (Text
providerName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
projectName)
      Maybe QueueName
queue <- Object -> Decoder (Maybe QueueName)
decodeQueueName Object
va
      [ProjectTemplateName]
templates <- Key
-> (Text -> ProjectTemplateName)
-> Object
-> Decoder [ProjectTemplateName]
forall a. Key -> (Text -> a) -> Object -> Decoder [a]
decodeAsList Key
"templates" Text -> ProjectTemplateName
ProjectTemplateName Object
va
      Set ProjectPipeline
pipelines <- [ProjectPipeline] -> Set ProjectPipeline
forall a. Ord a => [a] -> Set a
Set.fromList ([ProjectPipeline] -> Set ProjectPipeline)
-> Decoder [ProjectPipeline] -> Decoder (Set ProjectPipeline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Decoder ProjectPipeline] -> Decoder [ProjectPipeline]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ((Pair -> Maybe (Decoder ProjectPipeline))
-> [Pair] -> [Decoder ProjectPipeline]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Pair -> Maybe (Decoder ProjectPipeline)
decodeProjectPipeline (Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
HM.toList Object
va))
      Project -> Decoder Project
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Project -> Decoder Project) -> Project -> Decoder Project
forall a b. (a -> b) -> a -> b
$ Project {ProjectName
$sel:name:Project :: ProjectName
name :: ProjectName
name, Maybe QueueName
$sel:queue:Project :: Maybe QueueName
queue :: Maybe QueueName
queue, [ProjectTemplateName]
$sel:templates:Project :: [ProjectTemplateName]
templates :: [ProjectTemplateName]
templates, Set ProjectPipeline
$sel:pipelines:Project :: Set ProjectPipeline
pipelines :: Set ProjectPipeline
pipelines}

    decodeQueueName :: Object -> Decoder (Maybe QueueName)
    decodeQueueName :: Object -> Decoder (Maybe QueueName)
decodeQueueName Object
va = case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
HM.lookup Key
"queue" Object
va of
      (Just Value
x) -> QueueName -> Maybe QueueName
forall a. a -> Maybe a
Just (QueueName -> Maybe QueueName)
-> (Text -> QueueName) -> Text -> Maybe QueueName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> QueueName
QueueName (Text -> Maybe QueueName)
-> Decoder Text -> Decoder (Maybe QueueName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Decoder Text
decodeString Value
x
      Maybe Value
_ -> Maybe QueueName -> Decoder (Maybe QueueName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe QueueName
forall a. Maybe a
Nothing

    decodeProjectPipeline :: (Data.Aeson.Key.Key, Value) -> Maybe (Decoder ProjectPipeline)
    decodeProjectPipeline :: Pair -> Maybe (Decoder ProjectPipeline)
decodeProjectPipeline (Key -> Text
Data.Aeson.Key.toText -> Text
pipelineName', Value
va')
      -- These project configuration attribute are not pipelines
      | Text
pipelineName' Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"name", Text
"vars", Text
"description", Text
"default-branch", Text
"merge-mode", Text
"squash-merge"] = Maybe (Decoder ProjectPipeline)
forall a. Maybe a
Nothing
      | Text
pipelineName' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"templates" = Maybe (Decoder ProjectPipeline)
forall a. Maybe a
Nothing -- TODO: decode templates
      | Text
pipelineName' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"queue" = Maybe (Decoder ProjectPipeline)
forall a. Maybe a
Nothing -- TODO: decode project queues
      | Bool
otherwise = Decoder ProjectPipeline -> Maybe (Decoder ProjectPipeline)
forall a. a -> Maybe a
Just (Decoder ProjectPipeline -> Maybe (Decoder ProjectPipeline))
-> Decoder ProjectPipeline -> Maybe (Decoder ProjectPipeline)
forall a b. (a -> b) -> a -> b
$ case Value
va' of
          Object Object
inner -> do
            let name :: PipelineName
name = Text -> PipelineName
PipelineName Text
pipelineName'
            [PipelineJob]
jobs <- case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
HM.lookup Key
"jobs" Object
inner of
              Just (Array Array
jobElems) -> (Value -> Decoder PipelineJob) -> [Value] -> Decoder [PipelineJob]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Decoder PipelineJob
decodeProjectPipelineJob (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
jobElems)
              Maybe Value
_ -> [PipelineJob] -> Decoder [PipelineJob]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [] -- pipeline has no jobs
            ProjectPipeline -> Decoder ProjectPipeline
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectPipeline -> Decoder ProjectPipeline)
-> ProjectPipeline -> Decoder ProjectPipeline
forall a b. (a -> b) -> a -> b
$ ProjectPipeline {PipelineName
$sel:name:ProjectPipeline :: PipelineName
name :: PipelineName
name, [PipelineJob]
$sel:jobs:ProjectPipeline :: [PipelineJob]
jobs :: [PipelineJob]
jobs}
          Value
_ -> Text -> Value -> Decoder ProjectPipeline
forall a. Text -> Value -> Decoder a
decodeFail Text
"Unexpected pipeline" Value
va'
      where
        decodeProjectPipelineJob :: Value -> Decoder PipelineJob
        decodeProjectPipelineJob :: Value -> Decoder PipelineJob
decodeProjectPipelineJob = \case
          String Text
v -> PipelineJob -> Decoder PipelineJob
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PipelineJob -> Decoder PipelineJob)
-> PipelineJob -> Decoder PipelineJob
forall a b. (a -> b) -> a -> b
$ JobName -> PipelineJob
PJName (Text -> JobName
JobName Text
v)
          Object Object
jobObj -> do
            (Text
name, Object
obj) <- Object -> Decoder (Text, Object)
getObjectKey Object
jobObj
            Job -> PipelineJob
PJJob (Job -> PipelineJob) -> Decoder Job -> Decoder PipelineJob
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JobName -> Object -> Decoder Job
decodeJobContent (Text -> JobName
JobName Text
name) Object
obj
          Value
v -> Text -> Value -> Decoder PipelineJob
forall a. Text -> Value -> Decoder a
decodeFail Text
"Unexpected project pipeline jobs format" Value
v

    decodeProjectTemplate :: Object -> Decoder ProjectTemplate
    decodeProjectTemplate :: Object -> Decoder ProjectTemplate
decodeProjectTemplate Object
va = do
      ProjectTemplateName
name <- Text -> ProjectTemplateName
ProjectTemplateName (Text -> ProjectTemplateName)
-> Decoder Text -> Decoder ProjectTemplateName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Decoder Text
getName Object
va
      Maybe QueueName
queue <- Object -> Decoder (Maybe QueueName)
decodeQueueName Object
va
      Set ProjectPipeline
pipelines <- [ProjectPipeline] -> Set ProjectPipeline
forall a. Ord a => [a] -> Set a
Set.fromList ([ProjectPipeline] -> Set ProjectPipeline)
-> Decoder [ProjectPipeline] -> Decoder (Set ProjectPipeline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Decoder ProjectPipeline] -> Decoder [ProjectPipeline]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ((Pair -> Maybe (Decoder ProjectPipeline))
-> [Pair] -> [Decoder ProjectPipeline]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Pair -> Maybe (Decoder ProjectPipeline)
decodeProjectPipeline (Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
HM.toList Object
va))
      ProjectTemplate -> Decoder ProjectTemplate
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectTemplate -> Decoder ProjectTemplate)
-> ProjectTemplate -> Decoder ProjectTemplate
forall a b. (a -> b) -> a -> b
$ ProjectTemplate {ProjectTemplateName
$sel:name:ProjectTemplate :: ProjectTemplateName
name :: ProjectTemplateName
name, Maybe QueueName
$sel:queue:ProjectTemplate :: Maybe QueueName
queue :: Maybe QueueName
queue, Set ProjectPipeline
$sel:pipelines:ProjectTemplate :: Set ProjectPipeline
pipelines :: Set ProjectPipeline
pipelines}

    -- Zuul config elements are object with an unique key
    getObjectKey :: Object -> Decoder (Text, Object)
    getObjectKey :: Object -> Decoder (Text, Object)
getObjectKey Object
hm = case Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
HM.toList Object
hm of
      [(Key -> Text
Data.Aeson.Key.toText -> Text
keyName, Value
keyValue)] -> do
        Object
obj <- Value -> Decoder Object
decodeObject Value
keyValue
        (Text, Object) -> Decoder (Text, Object)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
keyName, Object
obj)
      [Pair]
_ -> Text -> Value -> Decoder (Text, Object)
forall a. Text -> Value -> Decoder a
decodeFail Text
"Top level zuul attribute is not a single key object" (Object -> Value
Object Object
hm)

    getName :: Object -> Decoder Text
    getName :: Object -> Decoder Text
getName = Value -> Decoder Text
decodeString (Value -> Decoder Text)
-> (Object -> Decoder Value) -> Object -> Decoder Text
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Key -> Object -> Decoder Value
decodeObjectAttribute Key
"name"

-- | Convenient alias
type ConnectionUrlMap = Map ProviderName ConnectionUrl

-- | The main function to decode a 'ZKFile'
loadConfig ::
  -- | The map of the connection urls.
  ConnectionUrlMap ->
  -- | The helper to resolve the matching tenant list.
  TenantResolver ->
  -- | The configuration object file to load.
  Either ConfigError ZKFile ->
  -- | The computation to update the config.
  StateT Config IO ()
loadConfig :: ConnectionUrlMap
-> TenantResolver
-> Either ConfigError ZKFile
-> StateT Config IO ()
loadConfig ConnectionUrlMap
urlBuilder TenantResolver
tenantResolver Either ConfigError ZKFile
zkcE = do
  case Either ConfigError ZKFile
zkcE of
    Left ConfigError
e -> ASetter Config Config [ConfigError] [ConfigError]
#configErrors ASetter Config Config [ConfigError] [ConfigError]
-> ([ConfigError] -> [ConfigError]) -> StateT Config IO ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (ConfigError
e :)
    Right ZKFile
zkc ->
      let decodedResults :: [Decoder ZuulConfigElement]
decodedResults = (CanonicalProjectName, BranchName)
-> Value -> [Decoder ZuulConfigElement]
decodeConfig (CanonicalProjectName
canonicalProjectName, BranchName
branchName) ZKFile
zkc.zkJSONData
          providerName :: ProviderName
providerName = Text -> ProviderName
ProviderName (Text -> ProviderName) -> Text -> ProviderName
forall a b. (a -> b) -> a -> b
$ ZKFile
zkc.provider
          canonicalProjectName :: CanonicalProjectName
canonicalProjectName =
            ProviderName -> ProjectName -> CanonicalProjectName
CanonicalProjectName
              ProviderName
providerName
              (Text -> ProjectName
ProjectName ZKFile
zkc.project)
          branchName :: BranchName
branchName = Text -> BranchName
BranchName ZKFile
zkc.branch
          configPath :: FilePathT
configPath = ZKFile
zkc.filePath
          -- tenants info are set in the updateTopConfig function.
          -- this is done per element because a tenant may not include everything.
          tenants :: Set TenantName
tenants = Set TenantName
forall a. Monoid a => a
mempty
          url :: ConnectionUrl
url = ConnectionUrl -> Maybe ConnectionUrl -> ConnectionUrl
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> ConnectionUrl
forall a. HasCallStack => [Char] -> a
error [Char]
"Missing connection provider?!") (Maybe ConnectionUrl -> ConnectionUrl)
-> Maybe ConnectionUrl -> ConnectionUrl
forall a b. (a -> b) -> a -> b
$ ProviderName -> ConnectionUrlMap -> Maybe ConnectionUrl
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ProviderName
providerName ConnectionUrlMap
urlBuilder
          configLoc :: ConfigLoc
configLoc = CanonicalProjectName
-> BranchName
-> FilePathT
-> ConnectionUrl
-> Set TenantName
-> ConfigLoc
ConfigLoc CanonicalProjectName
canonicalProjectName BranchName
branchName FilePathT
configPath ConnectionUrl
url Set TenantName
tenants
       in (Decoder ZuulConfigElement -> StateT Config IO ())
-> [Decoder ZuulConfigElement] -> StateT Config IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (TenantResolver
-> ConfigLoc -> Decoder ZuulConfigElement -> StateT Config IO ()
updateTopConfig TenantResolver
tenantResolver ConfigLoc
configLoc) [Decoder ZuulConfigElement]
decodedResults

-- | An empty config.
emptyConfig :: Set TenantName -> Config
emptyConfig :: Set TenantName -> Config
emptyConfig = ConfigMap JobName Job
-> ConfigMap NodesetName Nodeset
-> ConfigMap NodeLabelName NodeLabelName
-> ConfigMap CanonicalProjectName Project
-> ConfigMap ProjectRegex Project
-> ConfigMap ProjectTemplateName ProjectTemplate
-> ConfigMap PipelineName Pipeline
-> ConfigMap SecretName SecretName
-> ConfigMap QueueName QueueName
-> ConfigMap SemaphoreName SemaphoreName
-> ConfigMap ConnectionName ConnectionName
-> ConfigMap ConnectionName ConnectionName
-> [ConfigError]
-> Set TenantName
-> Config
Config ConfigMap JobName Job
forall a. Monoid a => a
mempty ConfigMap NodesetName Nodeset
forall a. Monoid a => a
mempty ConfigMap NodeLabelName NodeLabelName
forall a. Monoid a => a
mempty ConfigMap CanonicalProjectName Project
forall a. Monoid a => a
mempty ConfigMap ProjectRegex Project
forall a. Monoid a => a
mempty ConfigMap ProjectTemplateName ProjectTemplate
forall a. Monoid a => a
mempty ConfigMap PipelineName Pipeline
forall a. Monoid a => a
mempty ConfigMap SecretName SecretName
forall a. Monoid a => a
mempty ConfigMap QueueName QueueName
forall a. Monoid a => a
mempty ConfigMap SemaphoreName SemaphoreName
forall a. Monoid a => a
mempty ConfigMap ConnectionName ConnectionName
forall a. Monoid a => a
mempty ConfigMap ConnectionName ConnectionName
forall a. Monoid a => a
mempty [ConfigError]
forall a. Monoid a => a
mempty