Skip to content

Commit 085576b

Browse files
TristanCacquerayTristanCacqueray
committed
Add Dhall schemas for the CRD
This change introduces a new schemas/package.dhall along with a RenderSchemas hack script to update it based on the openapi definition. Change-Id: I0c88e603b6467785f1977e353c845067fe9620c8
1 parent 39b6a5c commit 085576b

33 files changed

+545
-0
lines changed

‎Makefile

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -286,3 +286,8 @@ endef
286286
define entries_write_fn
287287
$(foreach version,$(AVAILTAGS),$(call entry_fn,$(version),$(prevversion)) $(eval prevversion=$(version)))
288288
endef
289+
290+
.PHONY: render-dhall-schemas
291+
render-dhall-schemas:
292+
@rm -f schemas/*
293+
cabal run

‎hack/RenderSchemas.hs

Lines changed: 126 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,126 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
3+
module Main where
4+
5+
import Data.Char qualified as Char
6+
import Data.Foldable (traverse_)
7+
import Data.Map.Strict (Map)
8+
import Data.Map.Strict qualified as Map
9+
import Data.Text (Text)
10+
import Data.Text qualified as Text
11+
import Data.Text.IO qualified as Text
12+
import Data.Yaml qualified as Yaml
13+
import Dhall.Core (pretty)
14+
import Dhall.Core qualified as Dhall
15+
import Dhall.Kubernetes.Convert qualified as Convert
16+
import Dhall.Kubernetes.Types (Definition (typ), Expr, ModelName (..))
17+
import Dhall.Map qualified as DMap
18+
import Lens.Micro qualified as Lens
19+
20+
main :: IO ()
21+
main = do
22+
-- Read the CRD schemas
23+
crd <- Yaml.decodeFileThrow "config/crd/bases/sf.softwarefactory-project.io_softwarefactories.yaml"
24+
-- Convert into dhall schemas
25+
case Convert.toDefinition crd of
26+
Left err -> error $ "Couldn't parse the crd: " <> Text.unpack err
27+
Right result -> traverse_ writeDhall $ generateSchemas $ Map.fromList [result]
28+
putStrLn "Done!"
29+
where
30+
writeDhall (fp, content) = Text.writeFile ("schemas/" <> fp <> ".dhall") $ pretty content
31+
32+
-- | Generate one schema per model name, along with a global package.dhall import.
33+
generateSchemas :: Map ModelName Definition -> [(FilePath, Expr)]
34+
generateSchemas defs = [("package", package)] <> map toDhallFiles (Map.toList types)
35+
where
36+
package = getPackage $ Map.keys types
37+
types = getTypes defs
38+
defaults = getDefaults types
39+
toDhallFiles (model, typeExpr) =
40+
let defExpr = case Map.lookup model defaults of
41+
Just x -> x
42+
Nothing -> Dhall.RecordLit mempty
43+
schemaExpr =
44+
Dhall.RecordLit $
45+
DMap.fromList
46+
[ ("Type", Dhall.makeRecordField $ adjustImport typeExpr)
47+
, ("default", Dhall.makeRecordField defExpr)
48+
]
49+
in (Text.unpack $ unModelName model, schemaExpr)
50+
51+
-- | Returns the Dhall type expr for the CRD.
52+
getTypes :: Map ModelName Definition -> Map ModelName Expr
53+
getTypes = fixModels . Convert.toTypes mempty splitModels True []
54+
where
55+
fixModels = Map.map fixEmptyType . Map.filterWithKey removeTop
56+
-- Remove the non-spec part of the CRD
57+
removeTop k _v = case unModelName k of
58+
"io.k8s.apimachinery.pkg.util.intstr.NatOrString" -> False
59+
"sf.softwarefactory-project.io.SoftwareFactory" -> False
60+
_ -> True
61+
62+
-- Attribute like cpu, memory or storage size are undefined, this make them Text
63+
fixEmptyType :: Expr -> Expr
64+
fixEmptyType = Lens.transformOf Dhall.subExpressions emptyTypeToText
65+
emptyTypeToText expr = case expr of
66+
Dhall.Record m | m == mempty -> Dhall.Text
67+
_ -> expr
68+
69+
-- | Split the schemas into logical units
70+
splitModels :: [ModelName] -> Definition -> Maybe ModelName
71+
splitModels hierarchy def
72+
| -- We only split object schema, not values like array or strings
73+
typ def /= Just "object" =
74+
Nothing
75+
| otherwise = case hierarchy of
76+
-- The top level .spec attribute is moved into SoftwareFactorySpec
77+
[ModelName "sf.softwarefactory-project.io.SoftwareFactory", ModelName "spec"] ->
78+
Just $ ModelName "Spec"
79+
-- Spec attributes are moved into dedicated models
80+
[ModelName "Spec", ModelName attr] ->
81+
Just $ ModelName $ adjustName attr
82+
-- Zuul and Nodepool attributes are moved into dedicated models
83+
[ModelName "Zuul", ModelName x] ->
84+
Just $ ModelName $ "Zuul" <> adjustName (Text.replace "conns" "Conn" x)
85+
[ModelName "Nodepool", ModelName x] ->
86+
Just $ ModelName $ "Nodepool" <> adjustName x
87+
-- Adapt MariaDB attributes
88+
[_, ModelName "logStorage"] -> Just $ ModelName "Storage"
89+
[_, ModelName "dbStorage"] -> Just $ ModelName "Storage"
90+
-- Move limits and storage attribute into dedicated models
91+
_ -> case last hierarchy of
92+
ModelName "limits" -> Just $ ModelName "Limits"
93+
ModelName "storage" -> Just $ ModelName "Storage"
94+
_ -> Nothing
95+
96+
-- | Convert model name to PascalCase
97+
adjustName :: Text -> Text
98+
adjustName = Text.filter (/= ' ') . Text.unwords . map toTitle . Text.words . Text.replace "-" " "
99+
where
100+
toTitle s = case Text.uncons s of
101+
Just (c, rest) -> Text.cons (Char.toUpper c) rest
102+
Nothing -> s
103+
104+
-- | Returns the Dhall default expr.
105+
getDefaults :: Map ModelName Expr -> Map ModelName Expr
106+
getDefaults = fmap adjustImport . Map.mapMaybeWithKey (Convert.toDefault mempty mempty)
107+
108+
{- | Adjust the import path because the default dhall-openapi converter generates multiple files
109+
for the type and default while we want to keep them in a single schema file.
110+
-}
111+
adjustImport :: Expr -> Expr
112+
adjustImport = Lens.transformOf Dhall.subExpressions toLocalType
113+
where
114+
toLocalType expr = case expr of
115+
Dhall.Embed (Dhall.Import (Dhall.ImportHashed _ (Dhall.Local _ (Dhall.File _ f))) _) ->
116+
Dhall.Field (mkImport f) $ Dhall.makeFieldSelection "Type"
117+
_ -> expr
118+
119+
mkImport :: Text -> Expr
120+
mkImport = Dhall.Embed . Convert.mkImport mempty []
121+
122+
-- | Return a Dhall expression for the package
123+
getPackage :: [ModelName] -> Expr
124+
getPackage = Dhall.RecordLit . DMap.fromList . map toRecordField
125+
where
126+
toRecordField (ModelName name) = (name, Dhall.makeRecordField $ mkImport (name <> ".dhall"))

‎schemas/Codesearch.dhall

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
{ Type =
2+
{ storage : (./Storage.dhall).Type
3+
, enabled : Optional Bool
4+
, limits : Optional (./Limits.dhall).Type
5+
}
6+
, default = { enabled = None Bool, limits = None (./Limits.dhall).Type }
7+
}

‎schemas/ConfigLocation.dhall

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
{ Type =
2+
{ name : Text
3+
, zuul-connection-name : Text
4+
, branch : Optional Text
5+
, k8s-api-url : Optional Text
6+
, logserver-host : Optional Text
7+
}
8+
, default =
9+
{ branch = None Text, k8s-api-url = None Text, logserver-host = None Text }
10+
}

‎schemas/ExtraLabels.dhall

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
{ Type = List { mapKey : Text, mapValue : Text }, default = {=} }

‎schemas/FluentBitLogForwarding.dhall

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
{ Type =
2+
{ debug : Optional Bool
3+
, forwardInputHost : Optional Text
4+
, forwardInputPort : Optional Natural
5+
}
6+
, default =
7+
{ debug = None Bool
8+
, forwardInputHost = None Text
9+
, forwardInputPort = None Natural
10+
}
11+
}

‎schemas/Gitserver.dhall

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
{ Type = { storage : Optional (./Storage.dhall).Type }
2+
, default.storage = None (./Storage.dhall).Type
3+
}

‎schemas/Hostaliases.dhall

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
{ Type = { hostnames : List Text, ip : Text }, default = {=} }

‎schemas/Limits.dhall

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
{ Type = { cpu : Text, memory : Text }, default = {=} }

‎schemas/Logserver.dhall

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
{ Type =
2+
{ loopDelay : Optional Natural
3+
, retentionDays : Optional Natural
4+
, storage : Optional (./Storage.dhall).Type
5+
}
6+
, default =
7+
{ loopDelay = None Natural
8+
, retentionDays = None Natural
9+
, storage = None (./Storage.dhall).Type
10+
}
11+
}

0 commit comments

Comments
 (0)