settei-kdl (empty) → 0.1.0.0
raw patch · 9 files changed
+976/−0 lines, 9 filesdep +basedep +containersdep +generic-lens
Dependencies added: base, containers, generic-lens, kdl-hs, settei, settei-kdl, tasty, tasty-hunit, text
Files
- CHANGELOG.md +7/−0
- LICENSE +28/−0
- settei-kdl.cabal +67/−0
- src/Settei/Kdl.hs +591/−0
- test/Main.hs +8/−0
- test/Settei/KdlCharacterizationTest.hs +81/−0
- test/Settei/KdlTest.hs +181/−0
- test/fixtures/characterization/README.md +7/−0
- test/fixtures/characterization/nested.kdl +6/−0
+ CHANGELOG.md view
@@ -0,0 +1,7 @@+# Changelog for settei-kdl++## 0.1.0.0 — 2026-07-18++- Initial experimental release.+- Add the canonical KDL v2 mapping with exact spans, deterministic cardinality, explicit+ ambiguity errors, and mounted-file Kubernetes annotations.
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2026, shinzui+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+ this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ settei-kdl.cabal view
@@ -0,0 +1,67 @@+cabal-version: 3.8+name: settei-kdl+version: 0.1.0.0+synopsis: KDL v2 sources for Settei+description:+ Translate a canonical KDL v2 document into a provenance-aware Settei+ source while preserving node spans and rejecting ambiguous shapes.++homepage: https://github.com/shinzui/settei+bug-reports: https://github.com/shinzui/settei/issues+license: BSD-3-Clause+license-file: LICENSE+author: shinzui+maintainer: shinzui+category: Configuration+build-type: Simple+tested-with: GHC ==9.12.4+extra-doc-files: CHANGELOG.md+extra-source-files: test/fixtures/characterization/README.md+data-files: test/fixtures/characterization/*.kdl++source-repository head+ type: git+ location: https://github.com/shinzui/settei.git++common common+ default-language: GHC2024+ default-extensions:+ DeriveAnyClass+ DuplicateRecordFields+ OverloadedLabels+ OverloadedStrings++ ghc-options: -Wall -Wcompat++library+ import: common+ hs-source-dirs: src+ exposed-modules: Settei.Kdl+ build-depends:+ , base >=4.21 && <5+ , containers >=0.6.8 && <0.8+ , generic-lens >=2.2 && <2.4+ , kdl-hs >=1.1.1 && <1.2+ , settei ==0.1.0.0+ , text >=2.1 && <2.2++test-suite settei-kdl-tests+ import: common+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ other-modules:+ Paths_settei_kdl+ Settei.KdlCharacterizationTest+ Settei.KdlTest++ autogen-modules: Paths_settei_kdl+ build-depends:+ , base >=4.21 && <5+ , containers >=0.6.8 && <0.8+ , generic-lens >=2.2 && <2.4+ , settei ==0.1.0.0+ , settei-kdl ==0.1.0.0+ , tasty >=1.5 && <1.6+ , tasty-hunit >=0.10.2 && <0.11+ , text >=2.1 && <2.2
+ src/Settei/Kdl.hs view
@@ -0,0 +1,591 @@+{-# LANGUAGE ImportQualifiedPost #-}++-- |+-- Module: Settei.Kdl+-- Description: Canonical, span-preserving KDL v2 sources for Settei.+module Settei.Kdl+ ( KdlErrorCategory (..),+ KdlSourceError,+ KdlSourceOptions,+ KdlSpan,+ annotateKdlSourceOptions,+ decodeKdlSource,+ fromKubernetesMountedFile,+ kdlErrorCategory,+ kdlErrorContext,+ kdlErrorMessage,+ kdlErrorName,+ kdlErrorPath,+ kdlErrorRelatedSpan,+ kdlErrorSpan,+ kdlSourceAnnotations,+ kdlSourceName,+ kdlSourceOptions,+ kdlSourcePath,+ kdlSpanColumn,+ kdlSpanEndColumn,+ kdlSpanEndLine,+ kdlSpanLine,+ readKdlSource,+ withKdlSourcePath,+ )+where++import Control.Exception (IOException, displayException, try)+import Control.Monad (foldM, when)+import Data.Bifunctor (first)+import Data.Generics.Labels ()+import Data.List.NonEmpty qualified as NonEmpty+import Data.Map.Strict qualified as Map+import Data.Maybe (listToMaybe)+import Data.Text qualified as Text+import Data.Text.IO qualified as TextIO+import Data.Text.Read qualified as TextRead+import KDL.Parser qualified as KDLParser+import KDL.Types qualified as KDL+import Settei+import Settei.Prelude++-- | Stable classes of adapter failure. No constructor retains a raw KDL value.+data KdlErrorCategory+ = KdlSyntaxError+ | KdlIoError+ | KdlDuplicateProperty+ | KdlInvalidName+ | KdlUnsupportedAnnotation+ | KdlUnsupportedValue+ | KdlMixedNodeShape+ | KdlPropertyChildCollision+ deriving stock (Generic, Eq, Ord, Show)++-- | A complete one-based KDL source span.+data KdlSpan = KdlSpan+ { line :: !Int,+ column :: !Int,+ endLine :: !Int,+ endColumn :: !Int+ }+ deriving stock (Generic, Eq, Ord, Show)++-- | A secret-safe KDL input failure.+data KdlSourceError = KdlSourceError+ { category :: !KdlErrorCategory,+ name :: !Text,+ path :: !(Maybe FilePath),+ location :: !(Maybe KdlSpan),+ relatedLocation :: !(Maybe KdlSpan),+ context :: !Text,+ message :: !Text+ }+ deriving stock (Generic, Eq, Show)++-- | How one KDL v2 document should be named and annotated in provenance.+data KdlSourceOptions = KdlSourceOptions+ { name :: !Text,+ path :: !(Maybe FilePath),+ annotations :: !(Map Text Text)+ }+ deriving stock (Generic, Eq)++type LocationMap = Map [Text] KdlSpan++-- | Start options for an in-memory KDL document.+kdlSourceOptions :: Text -> KdlSourceOptions+kdlSourceOptions name = KdlSourceOptions {name, path = Nothing, annotations = Map.empty}++-- | Attach a real or logical path to an in-memory KDL document.+withKdlSourcePath :: FilePath -> KdlSourceOptions -> KdlSourceOptions+withKdlSourcePath path options = options & #path .~ Just path++-- | Add trusted, secret-safe origin metadata.+annotateKdlSourceOptions :: Map Text Text -> KdlSourceOptions -> KdlSourceOptions+annotateKdlSourceOptions annotations options = options & #annotations %~ (annotations <>)++-- | Attach a trusted Kubernetes reference for a mounted KDL file.+--+-- This performs no cluster lookup. Setting sensitivity remains the sole redaction policy.+fromKubernetesMountedFile :: KubernetesRef -> KdlSourceOptions -> KdlSourceOptions+fromKubernetesMountedFile reference =+ annotateKdlSourceOptions (kubernetesAnnotations reference)++-- | Return the stable source name.+kdlSourceName :: KdlSourceOptions -> Text+kdlSourceName options = options ^. #name++-- | Return the optional file path.+kdlSourcePath :: KdlSourceOptions -> Maybe FilePath+kdlSourcePath options = options ^. #path++-- | Return caller-supplied, secret-safe annotations.+kdlSourceAnnotations :: KdlSourceOptions -> Map Text Text+kdlSourceAnnotations options = options ^. #annotations++-- | Return an error's stable category.+kdlErrorCategory :: KdlSourceError -> KdlErrorCategory+kdlErrorCategory problem = problem ^. #category++-- | Return the source name associated with an error.+kdlErrorName :: KdlSourceError -> Text+kdlErrorName problem = problem ^. #name++-- | Return the file path associated with an error, when known.+kdlErrorPath :: KdlSourceError -> Maybe FilePath+kdlErrorPath problem = problem ^. #path++-- | Return the smallest trustworthy primary span for an error.+kdlErrorSpan :: KdlSourceError -> Maybe KdlSpan+kdlErrorSpan problem = problem ^. #location++-- | Return a second trustworthy span for a collision, when available.+kdlErrorRelatedSpan :: KdlSourceError -> Maybe KdlSpan+kdlErrorRelatedSpan problem = problem ^. #relatedLocation++-- | Return the structural path associated with an error.+kdlErrorContext :: KdlSourceError -> Text+kdlErrorContext problem = problem ^. #context++-- | Return a concise message that never includes a raw scalar or source excerpt.+kdlErrorMessage :: KdlSourceError -> Text+kdlErrorMessage problem = problem ^. #message++-- | Return a span's one-based start line.+kdlSpanLine :: KdlSpan -> Int+kdlSpanLine value = value ^. #line++-- | Return a span's one-based start column.+kdlSpanColumn :: KdlSpan -> Int+kdlSpanColumn value = value ^. #column++-- | Return a span's one-based inclusive end line.+kdlSpanEndLine :: KdlSpan -> Int+kdlSpanEndLine value = value ^. #endLine++-- | Return a span's one-based inclusive end column.+kdlSpanEndColumn :: KdlSpan -> Int+kdlSpanEndColumn value = value ^. #endColumn++-- | Decode one KDL v2 document into a Settei file source.+--+-- Type annotations, non-finite numbers, duplicate properties, invalid key segments, and+-- ambiguous mixtures fail explicitly. The parser's rendered source excerpt is discarded+-- on syntax failure so structured errors remain safe before setting sensitivity is known.+decodeKdlSource :: KdlSourceOptions -> Text -> Either (NonEmpty KdlSourceError) Source+decodeKdlSource options input =+ first NonEmpty.singleton $ do+ document <- first (syntaxError options) (KDLParser.parseWith (parseConfig options) input)+ (root, locations) <- translateDocument options document+ pure+ ( annotateSourceAt+ (spanAnnotationsFor locations)+ ( locateSource+ (sourceLocationFor options locations)+ ( annotateSource+ (Map.singleton "kdl.version" "2" <> options ^. #annotations)+ (source (options ^. #name) (FileSource "KDL v2") root)+ )+ )+ )++-- | Read one file and pass it through the same strict pure translator.+--+-- The supplied file path replaces any path already present in the options.+readKdlSource :: KdlSourceOptions -> FilePath -> IO (Either (NonEmpty KdlSourceError) Source)+readKdlSource options filePath = do+ let fileOptions = withKdlSourcePath filePath options+ contents <- try @IOException (TextIO.readFile filePath)+ pure $ case contents of+ Left exception ->+ Left+ ( NonEmpty.singleton+ ( kdlError+ fileOptions+ KdlIoError+ Nothing+ Nothing+ []+ (Text.pack (displayException exception))+ )+ )+ Right input -> decodeKdlSource fileOptions input++parseConfig :: KdlSourceOptions -> KDLParser.ParseConfig+parseConfig options =+ KDLParser.ParseConfig+ { KDLParser.filepath = maybe "" id (options ^. #path),+ KDLParser.includeSpans = True+ }++syntaxError :: KdlSourceOptions -> Text -> KdlSourceError+syntaxError options rendered =+ kdlError+ options+ KdlSyntaxError+ (parseErrorLocation rendered)+ Nothing+ []+ "invalid KDL v2 syntax"++parseErrorLocation :: Text -> Maybe KdlSpan+parseErrorLocation rendered = do+ header <- listToMaybe (Text.lines rendered)+ case reverse (filter (not . Text.null) (Text.splitOn ":" header)) of+ columnText : lineText : _ -> do+ line <- parsePositiveInt lineText+ column <- parsePositiveInt columnText+ pure KdlSpan {line, column, endLine = line, endColumn = column}+ _ -> Nothing++parsePositiveInt :: Text -> Maybe Int+parsePositiveInt value = case TextRead.decimal value of+ Right (number, rest)+ | number > 0 && Text.null rest -> Just number+ _ -> Nothing++translateDocument :: KdlSourceOptions -> KDL.Document -> Either KdlSourceError (RawValue, LocationMap)+translateDocument options document =+ translateNodeList options [] (nodeListNodes document)++translateNodeList ::+ KdlSourceOptions ->+ [Text] ->+ [KDL.Node] ->+ Either KdlSourceError (RawValue, LocationMap)+translateNodeList options prefix nodes = do+ groups <- groupNodes options prefix nodes+ translated <- traverse (translateGroup options prefix) (Map.toAscList groups)+ pure+ ( RawObject (Map.fromList [(name, value) | (name, value, _) <- translated]),+ mconcat [locations | (_, _, locations) <- translated]+ )++groupNodes ::+ KdlSourceOptions ->+ [Text] ->+ [KDL.Node] ->+ Either KdlSourceError (Map Text [KDL.Node])+groupNodes options prefix = foldM addNode Map.empty+ where+ addNode groups node = do+ name <- validateIdentifier options prefix (nodeName node)+ pure+ ( groups+ & at name+ %~ \existing -> Just (maybe [node] (<> [node]) existing)+ )++translateGroup ::+ KdlSourceOptions ->+ [Text] ->+ (Text, [KDL.Node]) ->+ Either KdlSourceError (Text, RawValue, LocationMap)+translateGroup options prefix (name, nodes) = case nodes of+ [] -> pure (name, RawNull, Map.empty)+ [node] -> do+ (value, locations) <- translateNode options (prefix <> [name]) node+ pure (name, value, locations)+ firstNode : remainingNodes -> do+ values <- traverse (fmap fst . translateNode options (prefix <> [name])) (firstNode : remainingNodes)+ let groupSpan = coverSpans (nodeLocation firstNode :| fmap nodeLocation remainingNodes)+ pure+ ( name,+ RawArray values,+ Map.singleton (prefix <> [name]) groupSpan+ )++translateNode ::+ KdlSourceOptions ->+ [Text] ->+ KDL.Node ->+ Either KdlSourceError (RawValue, LocationMap)+translateNode options path node = do+ rejectNodeAnnotation options path node+ properties <- validateProperties options path (nodeEntries node)+ let arguments = [entryValue entry | entry <- nodeEntries node, entryName entry == Nothing]+ childNodes = nodeChildren node+ when (not (null arguments) && (not (Map.null properties) || not (null childNodes))) $+ Left+ ( kdlError+ options+ KdlMixedNodeShape+ (Just (nodeLocation node))+ Nothing+ path+ "positional arguments cannot be combined with properties or children"+ )+ case arguments of+ firstArgument : remainingArguments -> do+ values <- traverse (translateValue options path) (firstArgument : remainingArguments)+ let value = case values of+ [single] -> single+ many -> RawArray many+ location = coverSpans (valueLocation firstArgument :| fmap valueLocation remainingArguments)+ pure (value, Map.singleton path location)+ []+ | Map.null properties && null childNodes ->+ pure (RawNull, Map.singleton path (nodeLocation node))+ | otherwise -> translateObjectNode options path node properties childNodes++translateObjectNode ::+ KdlSourceOptions ->+ [Text] ->+ KDL.Node ->+ Map Text KDL.Entry ->+ [KDL.Node] ->+ Either KdlSourceError (RawValue, LocationMap)+translateObjectNode options path node properties childNodes = do+ childGroups <- groupNodes options path childNodes+ case firstCollision properties childGroups of+ Just (name, property, child) ->+ Left+ ( kdlError+ options+ KdlPropertyChildCollision+ (entryNameLocation property)+ (Just (identifierLocation (nodeName child)))+ (path <> [name])+ "a property and child use the same field name"+ )+ Nothing -> pure ()+ (propertyObject, propertyLocations) <- translateProperties options path properties+ (childValue, childLocations) <- translateNodeList options path childNodes+ let childObject = case childValue of+ RawObject object -> object+ _ -> Map.empty+ pure+ ( RawObject (propertyObject <> childObject),+ Map.singleton path (nodeLocation node) <> propertyLocations <> childLocations+ )++translateProperties ::+ KdlSourceOptions ->+ [Text] ->+ Map Text KDL.Entry ->+ Either KdlSourceError (Map Text RawValue, LocationMap)+translateProperties options path properties = do+ translated <-+ traverse+ ( \(name, entry) -> do+ value <- translateValue options (path <> [name]) (entryValue entry)+ pure (name, value, Map.singleton (path <> [name]) (valueLocation (entryValue entry)))+ )+ (Map.toAscList properties)+ pure+ ( Map.fromList [(name, value) | (name, value, _) <- translated],+ mconcat [locations | (_, _, locations) <- translated]+ )++validateProperties ::+ KdlSourceOptions ->+ [Text] ->+ [KDL.Entry] ->+ Either KdlSourceError (Map Text KDL.Entry)+validateProperties options path = foldM addProperty Map.empty+ where+ addProperty properties entry = case entryName entry of+ Nothing -> pure properties+ Just identifier -> do+ name <- validateIdentifier options path identifier+ case properties ^. at name of+ Just earlier ->+ Left+ ( kdlError+ options+ KdlDuplicateProperty+ (Just (identifierLocation identifier))+ (entryNameLocation earlier)+ (path <> [name])+ "duplicate property"+ )+ Nothing -> pure (properties & at name ?~ entry)++firstCollision :: Map Text KDL.Entry -> Map Text [KDL.Node] -> Maybe (Text, KDL.Entry, KDL.Node)+firstCollision properties childGroups =+ listToMaybe+ [ (name, property, child)+ | name <- Map.keys properties,+ Just property <- [properties ^. at name],+ Just (child : _) <- [childGroups ^. at name]+ ]++translateValue :: KdlSourceOptions -> [Text] -> KDL.Value -> Either KdlSourceError RawValue+translateValue options path value = do+ rejectValueAnnotation options path value+ case valueData value of+ KDL.String text -> Right (RawText text)+ KDL.Number number -> Right (RawNumber (toRational number))+ KDL.Bool boolean -> Right (RawBool boolean)+ KDL.Null -> Right RawNull+ KDL.Inf -> unsupported+ KDL.NegInf -> unsupported+ KDL.NaN -> unsupported+ where+ unsupported =+ Left+ ( kdlError+ options+ KdlUnsupportedValue+ (Just (valueLocation value))+ Nothing+ path+ "non-finite KDL numbers are not supported"+ )++rejectNodeAnnotation :: KdlSourceOptions -> [Text] -> KDL.Node -> Either KdlSourceError ()+rejectNodeAnnotation options path node = case nodeAnnotation node of+ Nothing -> Right ()+ Just annotation ->+ Left+ ( kdlError+ options+ KdlUnsupportedAnnotation+ (Just (annotationLocation annotation))+ Nothing+ path+ "KDL node type annotations are not supported"+ )++rejectValueAnnotation :: KdlSourceOptions -> [Text] -> KDL.Value -> Either KdlSourceError ()+rejectValueAnnotation options path value = case valueAnnotation value of+ Nothing -> Right ()+ Just annotation ->+ Left+ ( kdlError+ options+ KdlUnsupportedAnnotation+ (Just (annotationLocation annotation))+ Nothing+ path+ "KDL value type annotations are not supported"+ )++validateIdentifier ::+ KdlSourceOptions ->+ [Text] ->+ KDL.Identifier ->+ Either KdlSourceError Text+validateIdentifier options prefix identifier =+ case mkKey (NonEmpty.singleton name) of+ Right _ -> Right name+ Left _ ->+ Left+ ( kdlError+ options+ KdlInvalidName+ (Just (identifierLocation identifier))+ Nothing+ (prefix <> [name])+ "KDL names must be non-empty Settei key segments without dots"+ )+ where+ name = identifierText identifier++kdlError ::+ KdlSourceOptions ->+ KdlErrorCategory ->+ Maybe KdlSpan ->+ Maybe KdlSpan ->+ [Text] ->+ Text ->+ KdlSourceError+kdlError options category location relatedLocation context message =+ KdlSourceError+ { category,+ name = options ^. #name,+ path = options ^. #path,+ location,+ relatedLocation,+ context = renderContext context,+ message+ }++renderContext :: [Text] -> Text+renderContext = foldl (\rendered segment -> rendered <> "." <> segment) "$"++sourceLocationFor :: KdlSourceOptions -> LocationMap -> Key -> Maybe SourceLocation+sourceLocationFor options locations key = do+ found <- locations ^. at (NonEmpty.toList (keySegments key))+ pure+ SourceLocation+ { path = maybe (options ^. #name) Text.pack (options ^. #path),+ line = Just (found ^. #line),+ column = Just (found ^. #column)+ }++spanAnnotationsFor :: LocationMap -> Key -> Map Text Text+spanAnnotationsFor locations key = case locations ^. at (NonEmpty.toList (keySegments key)) of+ Nothing -> Map.empty+ Just found ->+ Map.fromList+ [ ("kdl.span.start-line", renderInt (found ^. #line)),+ ("kdl.span.start-column", renderInt (found ^. #column)),+ ("kdl.span.end-line", renderInt (found ^. #endLine)),+ ("kdl.span.end-column", renderInt (found ^. #endColumn))+ ]++renderInt :: Int -> Text+renderInt = Text.pack . show++coverSpans :: NonEmpty KdlSpan -> KdlSpan+coverSpans (firstSpan :| remaining) = foldl cover firstSpan remaining+ where+ cover start finish =+ KdlSpan+ { line = start ^. #line,+ column = start ^. #column,+ endLine = finish ^. #endLine,+ endColumn = finish ^. #endColumn+ }++nodeListNodes :: KDL.NodeList -> [KDL.Node]+nodeListNodes KDL.NodeList {KDL.nodes = nodes} = nodes++nodeAnnotation :: KDL.Node -> Maybe KDL.Ann+nodeAnnotation KDL.Node {KDL.ann = annotation} = annotation++nodeName :: KDL.Node -> KDL.Identifier+nodeName KDL.Node {KDL.name = name} = name++nodeEntries :: KDL.Node -> [KDL.Entry]+nodeEntries KDL.Node {KDL.entries = entries} = entries++nodeChildren :: KDL.Node -> [KDL.Node]+nodeChildren KDL.Node {KDL.children = childList} = maybe [] nodeListNodes childList++nodeLocation :: KDL.Node -> KdlSpan+nodeLocation KDL.Node {KDL.ext = KDL.NodeExtension {KDL.span = location}} = fromKdlSpan location++entryName :: KDL.Entry -> Maybe KDL.Identifier+entryName KDL.Entry {KDL.name = name} = name++entryNameLocation :: KDL.Entry -> Maybe KdlSpan+entryNameLocation entry = identifierLocation <$> entryName entry++entryValue :: KDL.Entry -> KDL.Value+entryValue KDL.Entry {KDL.value = value} = value++valueAnnotation :: KDL.Value -> Maybe KDL.Ann+valueAnnotation KDL.Value {KDL.ann = annotation} = annotation++valueData :: KDL.Value -> KDL.ValueData+valueData KDL.Value {KDL.data_ = value} = value++valueLocation :: KDL.Value -> KdlSpan+valueLocation KDL.Value {KDL.ext = KDL.ValueExtension {KDL.span = location}} = fromKdlSpan location++annotationLocation :: KDL.Ann -> KdlSpan+annotationLocation KDL.Ann {KDL.ext = KDL.AnnExtension {KDL.span = location}} = fromKdlSpan location++identifierText :: KDL.Identifier -> Text+identifierText KDL.Identifier {KDL.value = value} = value++identifierLocation :: KDL.Identifier -> KdlSpan+identifierLocation KDL.Identifier {KDL.ext = KDL.IdentifierExtension {KDL.span = location}} = fromKdlSpan location++fromKdlSpan :: KDL.Span -> KdlSpan+fromKdlSpan+ KDL.Span+ { KDL.startLine = line,+ KDL.startCol = column,+ KDL.endLine = endLine,+ KDL.endCol = endColumn+ } = KdlSpan {line, column, endLine, endColumn}
+ test/Main.hs view
@@ -0,0 +1,8 @@+module Main (main) where++import Settei.KdlCharacterizationTest qualified as CharacterizationTest+import Settei.KdlTest qualified as KdlTest+import Test.Tasty (defaultMain, testGroup)++main :: IO ()+main = defaultMain (testGroup "settei-kdl" [CharacterizationTest.tests, KdlTest.tests])
+ test/Settei/KdlCharacterizationTest.hs view
@@ -0,0 +1,81 @@+module Settei.KdlCharacterizationTest (tests) where++import Data.Generics.Labels ()+import Data.List.NonEmpty qualified as NonEmpty+import Data.Ratio ((%))+import Data.Text qualified as Text+import Settei+import Settei.Kdl+import Settei.Prelude+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, testCase, (@?=))++tests :: TestTree+tests =+ testGroup+ "Settei.Kdl.Characterization"+ [ testCase "KDL v2 strings, booleans, null, and exact numbers remain typed" $ do+ input <- expectSource "text \"hello\"\nraw #\"raw text\"#\nflag #true\nempty #null\ninteger 12345678901234567890\ndecimal 1.25\n"+ expectValue "text" input (RawText "hello")+ expectValue "raw" input (RawText "raw text")+ expectValue "flag" input (RawBool True)+ expectValue "empty" input RawNull+ expectValue "integer" input (RawNumber 12345678901234567890)+ expectValue "decimal" input (RawNumber (5 % 4)),+ testCase "duplicate properties remain visible and fail at the second span" $ do+ problem <- expectError "service port=8000 port=9000\n"+ kdlErrorCategory problem @?= KdlDuplicateProperty+ fmap kdlSpanColumn (kdlErrorSpan problem) @?= Just 19+ fmap kdlSpanColumn (kdlErrorRelatedSpan problem) @?= Just 9,+ testCase "node and value type annotations fail explicitly" $ do+ nodeProblem <- expectError "(record)service { port 8080 }\n"+ kdlErrorCategory nodeProblem @?= KdlUnsupportedAnnotation+ valueProblem <- expectError "service (port)8080\n"+ kdlErrorCategory valueProblem @?= KdlUnsupportedAnnotation,+ testCase "non-finite KDL numbers fail instead of being coerced" $ do+ problem <- expectError "ratio #inf\n"+ kdlErrorCategory problem @?= KdlUnsupportedValue,+ testCase "comments and slash-dash remove values before translation" $ do+ input <- expectSource "// comment\nfoo 1 /- 2 3\n/- omitted 4\nbar 5\n"+ expectValue "foo" input (RawArray [RawNumber 1, RawNumber 3])+ expectValue "bar" input (RawNumber 5)+ assertBool+ "slash-dashed node remained in the document"+ (case lookupSource (validKey "omitted") input of Right Nothing -> True; _ -> False),+ testCase "quoted empty and dotted names reach explicit Settei validation" $ do+ emptyProblem <- expectError "\"\" 1\n"+ kdlErrorCategory emptyProblem @?= KdlInvalidName+ dottedProblem <- expectError "\"service.port\" 8080\n"+ kdlErrorCategory dottedProblem @?= KdlInvalidName,+ testCase "syntax failures keep only a one-based header location" $ do+ let sentinel = "never-retain-this-kdl-secret"+ input = "password \"" <> sentinel <> "\"\nservice { broken [\n"+ problem <- expectError input+ kdlErrorCategory problem @?= KdlSyntaxError+ assertBool "syntax error omitted its line" (maybe False ((> 0) . kdlSpanLine) (kdlErrorSpan problem))+ assertBool "syntax error omitted its column" (maybe False ((> 0) . kdlSpanColumn) (kdlErrorSpan problem))+ assertBool+ "syntax error retained the source excerpt"+ (not (sentinel `Text.isInfixOf` Text.pack (show problem)))+ ]++sourceOptions :: KdlSourceOptions+sourceOptions = withKdlSourcePath "characterization.kdl" (kdlSourceOptions "characterization")++expectSource :: Text -> IO Source+expectSource input = case decodeKdlSource sourceOptions input of+ Left errors -> fail (show errors)+ Right sourceValue -> pure sourceValue++expectError :: Text -> IO KdlSourceError+expectError input = case decodeKdlSource sourceOptions input of+ Left errors -> pure (NonEmpty.head errors)+ Right _ -> fail "expected KDL decoding to fail"++expectValue :: Text -> Source -> RawValue -> IO ()+expectValue keyText input expected = case lookupSource (validKey keyText) input of+ Right (Just found) -> assertBool "unexpected KDL raw value" (candidateValue found == expected)+ _ -> fail "expected KDL candidate"++validKey :: Text -> Key+validKey value = either (error . show) id (parseKey value)
+ test/Settei/KdlTest.hs view
@@ -0,0 +1,181 @@+module Settei.KdlTest (tests) where++import Data.Generics.Labels ()+import Data.List.NonEmpty qualified as NonEmpty+import Data.Map.Strict qualified as Map+import Data.Text qualified as Text+import Paths_settei_kdl qualified as Paths+import Settei+import Settei.Kdl+import Settei.Prelude+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, testCase, (@?=))++tests :: TestTree+tests =+ testGroup+ "Settei.Kdl"+ [ testCase "nested nodes become segmented keys with exact spans" $ do+ input <- expectSource "runtime {\n environment \"production\"\n}\nservice {\n http {\n host \"0.0.0.0\"\n port 8080\n }\n}\n"+ host <- expectCandidate serviceHttpHost input+ assertBool "host did not remain text" (candidateValue host == RawText "0.0.0.0")+ host ^? to candidateOrigin . #location . _Just . #path @?= Just "application.kdl"+ host ^? to candidateOrigin . #location . _Just . #line @?= Just (Just 6)+ host ^? to candidateOrigin . #location . _Just . #column @?= Just (Just 10)+ host ^. to candidateOrigin . #annotations . at "kdl.span.end-column" @?= Just "18"+ host ^. to candidateOrigin . #annotations . at "kdl.version" @?= Just "2",+ testCase "positional arguments become scalars or arrays and empty nodes become null" $ do+ input <- expectSource "tag \"api\"\ntags \"api\" \"public\"\noptional\n"+ expectRaw tagKey input (RawText "api")+ expectRaw tagsKey input (RawArray [RawText "api", RawText "public"])+ expectRaw optionalKey input RawNull,+ testCase "properties and non-colliding children form one object" $ do+ input <- expectSource "service host=\"api.internal\" {\n port 8080\n}\n"+ expectRaw serviceHost input (RawText "api.internal")+ expectRaw servicePort input (RawNumber 8080),+ testCase "repeated siblings preserve document order as an array" $ do+ input <-+ expectSource+ "backend {\n host \"one.internal\"\n port 8080\n}\nbackend {\n host \"two.internal\"\n port 8081\n}\n"+ expectRaw+ backendKey+ input+ ( RawArray+ [ RawObject (Map.fromList [("host", RawText "one.internal"), ("port", RawNumber 8080)]),+ RawObject (Map.fromList [("host", RawText "two.internal"), ("port", RawNumber 8081)])+ ]+ )+ backend <- expectCandidate backendKey input+ backend ^? to candidateOrigin . #location . _Just . #line @?= Just (Just 1)+ backend ^. to candidateOrigin . #annotations . at "kdl.span.end-line" @?= Just "8",+ testCase "arguments mixed with children fail at the node span" $ do+ problem <- expectError "service \"api\" { port 8080 }\n"+ kdlErrorCategory problem @?= KdlMixedNodeShape+ fmap kdlSpanColumn (kdlErrorSpan problem) @?= Just 1,+ testCase "arguments mixed with properties fail at the node span" $ do+ problem <- expectError "service \"api\" port=8080\n"+ kdlErrorCategory problem @?= KdlMixedNodeShape+ fmap kdlSpanColumn (kdlErrorSpan problem) @?= Just 1,+ testCase "property-child collisions report both available locations" $ do+ problem <- expectError "service port=7000 {\n port 8000\n}\n"+ kdlErrorCategory problem @?= KdlPropertyChildCollision+ kdlErrorContext problem @?= "$.service.port"+ fmap kdlSpanLine (kdlErrorSpan problem) @?= Just 1+ fmap kdlSpanLine (kdlErrorRelatedSpan problem) @?= Just 2,+ testCase "higher KDL overrides leaves and replaces arrays through core" $ do+ low <- expectNamedSource "low" "service { host \"old.internal\"; port 7000; names \"one\" \"two\"; }\n"+ high <- expectNamedSource "high" "service { port 9000; names \"three\" \"four\"; }\n"+ result <-+ expectResolution+ ( resolve+ defaultResolveOptions+ [low, high]+ ((,,) <$> required hostSetting <*> required portSetting <*> required namesSetting)+ )+ result ^. #value @?= ("old.internal", 9000, ["three", "four"])+ case result ^. #report . #nodes . at servicePort of+ Just node -> do+ node ^. #origin . _Just . #name @?= "high"+ fmap (^. #name) (node ^. #shadowed) @?= ["low"]+ Nothing -> fail "expected resolved KDL port provenance",+ testCase "mounted Secret metadata remains visible while its value is redacted" $ do+ let reference = kubernetesRef SecretObject (Just "production") "database-config" (Just "config.kdl")+ options = fromKubernetesMountedFile reference sourceOptions+ input <- expectSourceWith options ("database { password \"" <> secretSentinel <> "\"; }\n")+ result <- expectResolution (resolve defaultResolveOptions [input] (required passwordSetting))+ let textOutput = renderResolutionText (result ^. #report)+ jsonOutput = renderResolutionJson (result ^. #report)+ assertBool "secret reached text output" (not (secretSentinel `Text.isInfixOf` textOutput))+ assertBool "secret reached JSON output" (not (secretSentinel `Text.isInfixOf` jsonOutput))+ assertBool "Secret metadata was omitted" ("database-config" `Text.isInfixOf` textOutput),+ testCase "readKdlSource reports IO failures with the requested path" $ do+ result <- readKdlSource (kdlSourceOptions "missing") "test/fixtures/does-not-exist.kdl"+ case result of+ Left errors -> do+ let problem = NonEmpty.head errors+ kdlErrorCategory problem @?= KdlIoError+ kdlErrorPath problem @?= Just "test/fixtures/does-not-exist.kdl"+ Right _ -> fail "expected missing KDL file to fail",+ testCase "readKdlSource loads a fixture and records its actual path" $ do+ fixturePath <- Paths.getDataFileName "test/fixtures/characterization/nested.kdl"+ result <- readKdlSource (kdlSourceOptions "fixture") fixturePath+ input <- case result of+ Left errors -> fail (show errors)+ Right sourceValue -> pure sourceValue+ host <- expectCandidate serviceHttpHost input+ host ^? to candidateOrigin . #location . _Just . #path @?= Just (Text.pack fixturePath)+ ]++sourceOptions :: KdlSourceOptions+sourceOptions = withKdlSourcePath "application.kdl" (kdlSourceOptions "application")++expectSource :: Text -> IO Source+expectSource = expectSourceWith sourceOptions++expectNamedSource :: Text -> Text -> IO Source+expectNamedSource name =+ expectSourceWith (withKdlSourcePath (Text.unpack name <> ".kdl") (kdlSourceOptions name))++expectSourceWith :: KdlSourceOptions -> Text -> IO Source+expectSourceWith options input = case decodeKdlSource options input of+ Left errors -> fail (show errors)+ Right sourceValue -> pure sourceValue++expectError :: Text -> IO KdlSourceError+expectError input = case decodeKdlSource sourceOptions input of+ Left errors -> pure (NonEmpty.head errors)+ Right _ -> fail "expected KDL decoding to fail"++expectCandidate :: Key -> Source -> IO Candidate+expectCandidate key input = case lookupSource key input of+ Right (Just found) -> pure found+ _ -> fail "expected KDL candidate"++expectRaw :: Key -> Source -> RawValue -> IO ()+expectRaw key input expected = do+ found <- expectCandidate key input+ assertBool "unexpected KDL raw value" (candidateValue found == expected)++expectResolution :: Either (NonEmpty ConfigError) a -> IO a+expectResolution = \case+ Left errors -> fail (Text.unpack (renderErrorsText errors))+ Right value -> pure value++hostSetting :: Setting Text+hostSetting = publicSetting serviceHost "Service host" textDecoder++portSetting :: Setting Int+portSetting = publicSetting servicePort "Service port" boundedIntegralDecoder++namesSetting :: Setting [Text]+namesSetting = publicSetting serviceNames "Service names" textListDecoder++passwordSetting :: Setting Text+passwordSetting = secretSetting databasePassword "Database password" textDecoder++textListDecoder :: Decoder [Text]+textListDecoder = decoder $ \key -> \case+ RawArray values -> traverse (textElement key) values+ _ -> Left (decodeFailure key "an array of text")++textElement :: Key -> RawValue -> Either DecodeFailure Text+textElement key = \case+ RawText value -> Right value+ _ -> Left (decodeFailure key "an array of text")++serviceHttpHost, tagKey, tagsKey, optionalKey, serviceHost, servicePort, serviceNames, backendKey, databasePassword :: Key+serviceHttpHost = validKey "service.http.host"+tagKey = validKey "tag"+tagsKey = validKey "tags"+optionalKey = validKey "optional"+serviceHost = validKey "service.host"+servicePort = validKey "service.port"+serviceNames = validKey "service.names"+backendKey = validKey "backend"+databasePassword = validKey "database.password"++validKey :: Text -> Key+validKey value = either (error . show) id (parseKey value)++secretSentinel :: Text+secretSentinel = "never-render-this-kdl-secret"
+ test/fixtures/characterization/README.md view
@@ -0,0 +1,7 @@+# KDL characterization fixtures++These fixtures exercise the canonical KDL v2 subset accepted by `settei-kdl`. They are+package data so file-loading tests do not depend on the developer's working directory.++`nested.kdl` is the successful nested-object fixture used to prove package-local file+loading and source-path provenance.
+ test/fixtures/characterization/nested.kdl view
@@ -0,0 +1,6 @@+service {+ http {+ host "fixture.internal"+ port 8080+ }+}