settei-yaml (empty) → 0.1.0.0
raw patch · 15 files changed
+888/−0 lines, 15 filesdep +attoparsecdep +basedep +bytestring
Dependencies added: attoparsec, base, bytestring, conduit, containers, generic-lens, libyaml, scientific, settei, settei-yaml, tasty, tasty-hunit, text
Files
- CHANGELOG.md +7/−0
- LICENSE +28/−0
- settei-yaml.cabal +72/−0
- src/Settei/Yaml.hs +488/−0
- test/Main.hs +8/−0
- test/Settei/YamlCharacterizationTest.hs +53/−0
- test/Settei/YamlTest.hs +194/−0
- test/fixtures/characterization/README.md +20/−0
- test/fixtures/characterization/alias.yaml +3/−0
- test/fixtures/characterization/custom-tag.yaml +1/−0
- test/fixtures/characterization/duplicate-block.yaml +3/−0
- test/fixtures/characterization/duplicate-flow.yaml +1/−0
- test/fixtures/characterization/merge-key.yaml +2/−0
- test/fixtures/characterization/multiple-documents.yaml +4/−0
- test/fixtures/characterization/nested.yaml +4/−0
+ CHANGELOG.md view
@@ -0,0 +1,7 @@+# Changelog for settei-yaml++## 0.1.0.0 — 2026-07-18++- Initial experimental release.+- Add a strict YAML mapping with exact node locations, explicit unsupported-feature+ 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-yaml.cabal view
@@ -0,0 +1,72 @@+cabal-version: 3.8+name: settei-yaml+version: 0.1.0.0+synopsis: YAML sources for Settei+description:+ Translate one strict YAML document into a provenance-aware Settei source+ while preserving exact node locations and rejecting ambiguous features.++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/*.yaml++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.Yaml+ build-depends:+ , attoparsec >=0.14.4 && <0.15+ , base >=4.21 && <5+ , bytestring >=0.12 && <0.13+ , conduit >=1.3.6 && <1.4+ , containers >=0.6.8 && <0.8+ , generic-lens >=2.2 && <2.4+ , libyaml >=0.1.4 && <0.2+ , scientific >=0.3.7 && <0.4+ , settei ==0.1.0.0+ , text >=2.1 && <2.2++test-suite settei-yaml-tests+ import: common+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ other-modules:+ Paths_settei_yaml+ Settei.YamlCharacterizationTest+ Settei.YamlTest++ autogen-modules: Paths_settei_yaml+ build-depends:+ , base >=4.21 && <5+ , bytestring >=0.12 && <0.13+ , containers >=0.6.8 && <0.8+ , generic-lens >=2.2 && <2.4+ , settei ==0.1.0.0+ , settei-yaml ==0.1.0.0+ , tasty >=1.5 && <1.6+ , tasty-hunit >=0.10.2 && <0.11+ , text >=2.1 && <2.2
+ src/Settei/Yaml.hs view
@@ -0,0 +1,488 @@+{-# LANGUAGE ImportQualifiedPost #-}++-- |+-- Module: Settei.Yaml+-- Description: Strict, location-preserving YAML sources for Settei.+module Settei.Yaml+ ( YamlErrorCategory (..),+ YamlSourceError,+ YamlSourceOptions,+ annotateYamlSourceOptions,+ decodeYamlSource,+ fromKubernetesMountedFile,+ readYamlSource,+ withYamlSourcePath,+ yamlErrorCategory,+ yamlErrorColumn,+ yamlErrorContext,+ yamlErrorLine,+ yamlErrorMessage,+ yamlErrorName,+ yamlErrorPath,+ yamlSourceAnnotations,+ yamlSourceName,+ yamlSourceOptions,+ yamlSourcePath,+ )+where++import Control.Applicative ((<|>))+import Control.Exception (IOException, displayException, try)+import Control.Monad (when)+import Data.Attoparsec.Text qualified as Attoparsec+import Data.Bifunctor (first)+import Data.ByteString (ByteString)+import Data.ByteString qualified as ByteString+import Data.Char (ord)+import Data.Conduit (runConduitRes, (.|))+import Data.Conduit.List qualified as ConduitList+import Data.Generics.Labels ()+import Data.List.NonEmpty qualified as NonEmpty+import Data.Map.Strict qualified as Map+import Data.Ratio qualified as Ratio+import Data.Scientific (Scientific)+import Data.Text qualified as Text+import Data.Text.Encoding qualified as TextEncoding+import Settei+import Settei.Prelude+import System.IO.Unsafe (unsafePerformIO)+import Text.Libyaml qualified as Libyaml++-- | Stable classes of adapter failure. No constructor retains a raw YAML value.+data YamlErrorCategory+ = YamlSyntaxError+ | YamlIoError+ | YamlMultipleDocuments+ | YamlDuplicateKey+ | YamlNonStringKey+ | YamlDottedKey+ | YamlUnsupportedFeature+ | YamlInvalidScalar+ | YamlTopLevelType+ deriving stock (Generic, Eq, Ord, Show)++-- | A secret-safe YAML input failure.+data YamlSourceError = YamlSourceError+ { category :: !YamlErrorCategory,+ name :: !Text,+ path :: !(Maybe FilePath),+ line :: !(Maybe Int),+ column :: !(Maybe Int),+ context :: !Text,+ message :: !Text+ }+ deriving stock (Generic, Eq, Show)++-- | How one YAML document should be named and annotated in provenance.+data YamlSourceOptions = YamlSourceOptions+ { name :: !Text,+ path :: !(Maybe FilePath),+ annotations :: !(Map Text Text)+ }+ deriving stock (Generic, Eq)++data PathPiece = MappingKey !Text | SequenceIndex !Int+ deriving stock (Generic, Eq, Ord)++type LocationMap = Map [Text] SourceLocation++-- | Start options for an in-memory YAML document.+yamlSourceOptions :: Text -> YamlSourceOptions+yamlSourceOptions name = YamlSourceOptions {name, path = Nothing, annotations = Map.empty}++-- | Attach a real or logical file path to an in-memory document.+withYamlSourcePath :: FilePath -> YamlSourceOptions -> YamlSourceOptions+withYamlSourcePath path options = options & #path .~ Just path++-- | Add trusted, secret-safe origin metadata.+annotateYamlSourceOptions :: Map Text Text -> YamlSourceOptions -> YamlSourceOptions+annotateYamlSourceOptions annotations options = options & #annotations %~ (annotations <>)++-- | Attach a trusted Kubernetes reference for a mounted YAML file.+--+-- This performs no cluster lookup. Setting sensitivity remains the sole redaction policy.+fromKubernetesMountedFile :: KubernetesRef -> YamlSourceOptions -> YamlSourceOptions+fromKubernetesMountedFile reference =+ annotateYamlSourceOptions (kubernetesAnnotations reference)++-- | Return the stable source name.+yamlSourceName :: YamlSourceOptions -> Text+yamlSourceName options = options ^. #name++-- | Return the optional file path.+yamlSourcePath :: YamlSourceOptions -> Maybe FilePath+yamlSourcePath options = options ^. #path++-- | Return caller-supplied, secret-safe annotations.+yamlSourceAnnotations :: YamlSourceOptions -> Map Text Text+yamlSourceAnnotations options = options ^. #annotations++-- | Return an error's stable category.+yamlErrorCategory :: YamlSourceError -> YamlErrorCategory+yamlErrorCategory problem = problem ^. #category++-- | Return the source name associated with an error.+yamlErrorName :: YamlSourceError -> Text+yamlErrorName problem = problem ^. #name++-- | Return the file path associated with an error, when known.+yamlErrorPath :: YamlSourceError -> Maybe FilePath+yamlErrorPath problem = problem ^. #path++-- | Return the one-based line associated with an error, when known.+yamlErrorLine :: YamlSourceError -> Maybe Int+yamlErrorLine problem = problem ^. #line++-- | Return the one-based column associated with an error, when known.+yamlErrorColumn :: YamlSourceError -> Maybe Int+yamlErrorColumn problem = problem ^. #column++-- | Return a structural path such as @$.service.ports[0]@.+yamlErrorContext :: YamlSourceError -> Text+yamlErrorContext problem = problem ^. #context++-- | Return a concise message that never includes a raw scalar or source excerpt.+yamlErrorMessage :: YamlSourceError -> Text+yamlErrorMessage problem = problem ^. #message++-- | Decode exactly one YAML mapping into a Settei file source.+--+-- Duplicate keys, non-string keys, dotted keys, aliases, anchors, merge keys, custom+-- tags, special floating values, and multiple documents fail explicitly.+decodeYamlSource :: YamlSourceOptions -> ByteString -> Either (NonEmpty YamlSourceError) Source+decodeYamlSource options bytes =+ first NonEmpty.singleton $ do+ events <- decodeMarkedEvents options bytes+ (root, locations) <- parseDocument options events+ pure+ ( locateSource+ (locationFor locations)+ ( annotateSource+ (options ^. #annotations)+ (source (options ^. #name) (FileSource "YAML") 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.+readYamlSource :: YamlSourceOptions -> FilePath -> IO (Either (NonEmpty YamlSourceError) Source)+readYamlSource options filePath = do+ let fileOptions = withYamlSourcePath filePath options+ contents <- try @IOException (ByteString.readFile filePath)+ pure $ case contents of+ Left exception ->+ Left+ ( NonEmpty.singleton+ ( yamlError+ fileOptions+ YamlIoError+ Nothing+ []+ (Text.pack (displayException exception))+ )+ )+ Right bytes -> decodeYamlSource fileOptions bytes++decodeMarkedEvents :: YamlSourceOptions -> ByteString -> Either YamlSourceError [Libyaml.MarkedEvent]+decodeMarkedEvents options bytes = unsafePerformIO $ do+ decoded <-+ try @Libyaml.YamlException+ (runConduitRes (Libyaml.decodeMarked bytes .| ConduitList.consume))+ pure $ first (syntaxError options) decoded+{-# NOINLINE decodeMarkedEvents #-}++syntaxError :: YamlSourceOptions -> Libyaml.YamlException -> YamlSourceError+syntaxError options = \case+ Libyaml.YamlParseException problem parserContext mark ->+ yamlError+ options+ YamlSyntaxError+ (Just mark)+ []+ ( Text.intercalate+ ": "+ (filter (not . Text.null) (fmap Text.pack [parserContext, problem]))+ )+ Libyaml.YamlException message ->+ yamlError options YamlSyntaxError Nothing [] (Text.pack message)++parseDocument :: YamlSourceOptions -> [Libyaml.MarkedEvent] -> Either YamlSourceError (RawValue, LocationMap)+parseDocument options events = case events of+ firstEvent : rest+ | eventOf firstEvent == Libyaml.EventStreamStart -> parseStream rest+ _ -> Left (unexpectedStructure options Nothing [])+ where+ parseStream = \case+ finalEvent : []+ | eventOf finalEvent == Libyaml.EventStreamEnd ->+ Right (RawObject Map.empty, Map.empty)+ documentStart : rest+ | eventOf documentStart == Libyaml.EventDocumentStart -> do+ (root, locations, remaining) <- case rest of+ documentEnd : trailing+ | eventOf documentEnd == Libyaml.EventDocumentEnd ->+ Right (RawObject Map.empty, Map.empty, trailing)+ _ -> do+ (value, foundLocations, afterValue) <- parseNode options [] (Just []) rest+ afterEnd <- requireEvent options Libyaml.EventDocumentEnd afterValue+ Right (value, foundLocations, afterEnd)+ case remaining of+ next : _+ | eventOf next == Libyaml.EventDocumentStart ->+ Left (yamlError options YamlMultipleDocuments (Just (startMark next)) [] "multiple YAML documents are not supported")+ streamEnd : []+ | eventOf streamEnd == Libyaml.EventStreamEnd ->+ case root of+ RawObject _ -> Right (root, locations)+ RawNull -> Right (RawObject Map.empty, Map.empty)+ _ -> Left (yamlError options YamlTopLevelType Nothing [] "the top-level YAML value must be a mapping")+ _ -> Left (unexpectedStructure options Nothing [])+ _ -> Left (unexpectedStructure options Nothing [])++parseNode ::+ YamlSourceOptions ->+ [PathPiece] ->+ Maybe [Text] ->+ [Libyaml.MarkedEvent] ->+ Either YamlSourceError (RawValue, LocationMap, [Libyaml.MarkedEvent])+parseNode options context keyPath = \case+ [] -> Left (unexpectedStructure options Nothing context)+ marked : rest -> case eventOf marked of+ Libyaml.EventScalar bytes tag style anchor -> do+ rejectAnchor options context marked anchor+ value <- scalarValue options context marked bytes tag style+ Right (value, locationMap options keyPath marked, rest)+ Libyaml.EventSequenceStart tag _ anchor -> do+ rejectAnchor options context marked anchor+ rejectCollectionTag options context marked Libyaml.SeqTag tag+ (values, remaining) <- parseSequence options context 0 rest+ Right (RawArray values, locationMap options keyPath marked, remaining)+ Libyaml.EventMappingStart tag _ anchor -> do+ rejectAnchor options context marked anchor+ rejectCollectionTag options context marked Libyaml.MapTag tag+ (object, childLocations, remaining) <- parseMapping options context keyPath Map.empty Map.empty rest+ Right+ ( RawObject object,+ locationMap options keyPath marked <> childLocations,+ remaining+ )+ Libyaml.EventAlias _ ->+ Left (yamlError options YamlUnsupportedFeature (Just (startMark marked)) context "YAML aliases are not supported")+ _ -> Left (unexpectedStructure options (Just (startMark marked)) context)++parseSequence ::+ YamlSourceOptions ->+ [PathPiece] ->+ Int ->+ [Libyaml.MarkedEvent] ->+ Either YamlSourceError ([RawValue], [Libyaml.MarkedEvent])+parseSequence options context position = \case+ [] -> Left (unexpectedStructure options Nothing context)+ marked : rest+ | eventOf marked == Libyaml.EventSequenceEnd -> Right ([], rest)+ | otherwise -> do+ (value, _, remaining) <- parseNode options (context <> [SequenceIndex position]) Nothing (marked : rest)+ (values, finalEvents) <- parseSequence options context (position + 1) remaining+ Right (value : values, finalEvents)++parseMapping ::+ YamlSourceOptions ->+ [PathPiece] ->+ Maybe [Text] ->+ Map Text RawValue ->+ LocationMap ->+ [Libyaml.MarkedEvent] ->+ Either YamlSourceError (Map Text RawValue, LocationMap, [Libyaml.MarkedEvent])+parseMapping options context keyPath object locations = \case+ [] -> Left (unexpectedStructure options Nothing context)+ marked : rest+ | eventOf marked == Libyaml.EventMappingEnd -> Right (object, locations, rest)+ | otherwise -> do+ key <- mappingKey options context marked+ let keyContext = context <> [MappingKey key]+ when (key == "<<") $+ Left (yamlError options YamlUnsupportedFeature (Just (startMark marked)) keyContext "YAML merge keys are not supported")+ when (Text.any (== '.') key) $+ Left (yamlError options YamlDottedKey (Just (startMark marked)) keyContext "mapping keys containing dots are not supported; use nested mappings")+ when (Map.member key object) $+ Left (yamlError options YamlDuplicateKey (Just (startMark marked)) keyContext "duplicate mapping key")+ let childKeyPath = fmap (<> [key]) keyPath+ (value, childLocations, remaining) <- parseNode options keyContext childKeyPath rest+ parseMapping+ options+ context+ keyPath+ (Map.insert key value object)+ (locations <> childLocations)+ remaining++mappingKey :: YamlSourceOptions -> [PathPiece] -> Libyaml.MarkedEvent -> Either YamlSourceError Text+mappingKey options context marked = case eventOf marked of+ Libyaml.EventScalar bytes tag style anchor -> do+ rejectAnchor options context marked anchor+ value <- scalarValue options context marked bytes tag style+ case value of+ RawText key -> Right key+ _ -> Left (yamlError options YamlNonStringKey (Just (startMark marked)) context "mapping keys must be strings")+ _ -> Left (yamlError options YamlNonStringKey (Just (startMark marked)) context "mapping keys must be scalar strings")++scalarValue ::+ YamlSourceOptions ->+ [PathPiece] ->+ Libyaml.MarkedEvent ->+ ByteString ->+ Libyaml.Tag ->+ Libyaml.Style ->+ Either YamlSourceError RawValue+scalarValue options context marked bytes tag style = do+ value <-+ first+ (const (yamlError options YamlInvalidScalar (Just (startMark marked)) context "scalar is not valid UTF-8"))+ (TextEncoding.decodeUtf8' bytes)+ case tag of+ Libyaml.StrTag -> Right (RawText value)+ Libyaml.NullTag -> Right RawNull+ Libyaml.BoolTag -> parseBoolean options context marked value+ Libyaml.IntTag -> parseTaggedInteger options context marked value+ Libyaml.FloatTag -> RawNumber . toRational <$> parseNumber options context marked value+ Libyaml.NoTag+ | style `elem` [Libyaml.SingleQuoted, Libyaml.DoubleQuoted, Libyaml.Literal, Libyaml.Folded] ->+ Right (RawText value)+ | isNull value -> Right RawNull+ | Just boolean <- yamlBoolean value -> Right (RawBool boolean)+ | Right number <- parseYamlNumber value -> Right (RawNumber (toRational number))+ | otherwise -> Right (RawText value)+ _ -> Left (yamlError options YamlUnsupportedFeature (Just (startMark marked)) context "this YAML scalar tag is not supported")++parseBoolean :: YamlSourceOptions -> [PathPiece] -> Libyaml.MarkedEvent -> Text -> Either YamlSourceError RawValue+parseBoolean options context marked value =+ maybe+ (Left (yamlError options YamlInvalidScalar (Just (startMark marked)) context "invalid boolean scalar"))+ (Right . RawBool)+ (yamlBoolean value)++parseTaggedInteger :: YamlSourceOptions -> [PathPiece] -> Libyaml.MarkedEvent -> Text -> Either YamlSourceError RawValue+parseTaggedInteger options context marked value = do+ number <- parseNumber options context marked value+ let rational = toRational number+ if Ratio.denominator rational == 1+ then Right (RawNumber rational)+ else Left (yamlError options YamlInvalidScalar (Just (startMark marked)) context "integer tag requires a whole number")++parseNumber :: YamlSourceOptions -> [PathPiece] -> Libyaml.MarkedEvent -> Text -> Either YamlSourceError Scientific+parseNumber options context marked value =+ first+ (const (yamlError options YamlInvalidScalar (Just (startMark marked)) context "invalid or non-finite numeric scalar"))+ (parseYamlNumber value)++parseYamlNumber :: Text -> Either String Scientific+parseYamlNumber = Attoparsec.parseOnly (yamlNumberParser <* Attoparsec.endOfInput)++yamlNumberParser :: Attoparsec.Parser Scientific+yamlNumberParser =+ (fromInteger <$> ("0x" *> Attoparsec.hexadecimal))+ <|> (fromInteger <$> ("0o" *> octal))+ <|> Attoparsec.scientific+ where+ octal = Text.foldl' step 0 <$> Attoparsec.takeWhile1 isOctalDigit+ isOctalDigit character = character >= '0' && character <= '7'+ step accumulator character = accumulator * 8 + fromIntegral (ord character - ord '0')++yamlBoolean :: Text -> Maybe Bool+yamlBoolean value = case Text.toCaseFold value of+ "y" -> Just True+ "yes" -> Just True+ "on" -> Just True+ "true" -> Just True+ "n" -> Just False+ "no" -> Just False+ "off" -> Just False+ "false" -> Just False+ _ -> Nothing++isNull :: Text -> Bool+isNull value = Text.toCaseFold value == "null" || value == "~" || Text.null value++rejectAnchor :: YamlSourceOptions -> [PathPiece] -> Libyaml.MarkedEvent -> Libyaml.Anchor -> Either YamlSourceError ()+rejectAnchor options context marked = \case+ Nothing -> Right ()+ Just _ -> Left (yamlError options YamlUnsupportedFeature (Just (startMark marked)) context "YAML anchors are not supported")++rejectCollectionTag ::+ YamlSourceOptions ->+ [PathPiece] ->+ Libyaml.MarkedEvent ->+ Libyaml.Tag ->+ Libyaml.Tag ->+ Either YamlSourceError ()+rejectCollectionTag options context marked expected actual+ | actual == Libyaml.NoTag || actual == expected = Right ()+ | otherwise = Left (yamlError options YamlUnsupportedFeature (Just (startMark marked)) context "this YAML collection tag is not supported")++requireEvent ::+ YamlSourceOptions ->+ Libyaml.Event ->+ [Libyaml.MarkedEvent] ->+ Either YamlSourceError [Libyaml.MarkedEvent]+requireEvent options expected = \case+ marked : rest+ | eventOf marked == expected -> Right rest+ | otherwise -> Left (unexpectedStructure options (Just (startMark marked)) [])+ [] -> Left (unexpectedStructure options Nothing [])++locationMap :: YamlSourceOptions -> Maybe [Text] -> Libyaml.MarkedEvent -> LocationMap+locationMap options keyPath marked = case keyPath of+ Just segments@(_ : _) -> Map.singleton segments (sourceLocation options (startMark marked))+ _ -> Map.empty++locationFor :: LocationMap -> Key -> Maybe SourceLocation+locationFor locations key = Map.lookup (NonEmpty.toList (keySegments key)) locations++sourceLocation :: YamlSourceOptions -> Libyaml.YamlMark -> SourceLocation+sourceLocation options (Libyaml.YamlMark _ zeroBasedLine zeroBasedColumn) =+ SourceLocation+ { path = maybe (options ^. #name) Text.pack (options ^. #path),+ line = Just (zeroBasedLine + 1),+ column = Just (zeroBasedColumn + 1)+ }++yamlError ::+ YamlSourceOptions ->+ YamlErrorCategory ->+ Maybe Libyaml.YamlMark ->+ [PathPiece] ->+ Text ->+ YamlSourceError+yamlError options category mark context message =+ YamlSourceError+ { category,+ name = options ^. #name,+ path = options ^. #path,+ line = oneBasedLine <$> mark,+ column = oneBasedColumn <$> mark,+ context = renderContext context,+ message+ }++unexpectedStructure :: YamlSourceOptions -> Maybe Libyaml.YamlMark -> [PathPiece] -> YamlSourceError+unexpectedStructure options mark context =+ yamlError options YamlSyntaxError mark context "unexpected YAML event sequence"++renderContext :: [PathPiece] -> Text+renderContext = foldl renderPiece "$"+ where+ renderPiece rendered (MappingKey key) = rendered <> "." <> key+ renderPiece rendered (SequenceIndex position) = rendered <> "[" <> Text.pack (show position) <> "]"++eventOf :: Libyaml.MarkedEvent -> Libyaml.Event+eventOf (Libyaml.MarkedEvent event _ _) = event++startMark :: Libyaml.MarkedEvent -> Libyaml.YamlMark+startMark (Libyaml.MarkedEvent _ mark _) = mark++oneBasedLine :: Libyaml.YamlMark -> Int+oneBasedLine (Libyaml.YamlMark _ line _) = line + 1++oneBasedColumn :: Libyaml.YamlMark -> Int+oneBasedColumn (Libyaml.YamlMark _ _ column) = column + 1
+ test/Main.hs view
@@ -0,0 +1,8 @@+module Main (main) where++import Settei.YamlCharacterizationTest qualified as CharacterizationTest+import Settei.YamlTest qualified as YamlTest+import Test.Tasty (defaultMain, testGroup)++main :: IO ()+main = defaultMain (testGroup "settei-yaml" [CharacterizationTest.tests, YamlTest.tests])
+ test/Settei/YamlCharacterizationTest.hs view
@@ -0,0 +1,53 @@+module Settei.YamlCharacterizationTest (tests) where++import Data.ByteString.Char8 qualified as ByteString8+import Data.Generics.Labels ()+import Data.List.NonEmpty qualified as NonEmpty+import Settei.Yaml+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, testCase, (@?=))++tests :: TestTree+tests =+ testGroup+ "Settei.Yaml.Characterization"+ [ testCase "duplicate block mapping keys fail at the second key" $ do+ problem <- expectError "service:\n port: 8000\n port: 9000\n"+ yamlErrorCategory problem @?= YamlDuplicateKey+ yamlErrorLine problem @?= Just 3+ yamlErrorContext problem @?= "$.service.port",+ testCase "duplicate flow mapping keys fail at the second key" $ do+ problem <- expectError "service: {port: 8000, port: 9000}\n"+ yamlErrorCategory problem @?= YamlDuplicateKey+ yamlErrorLine problem @?= Just 1,+ testCase "multiple documents fail instead of dropping a document" $ do+ problem <- expectError "---\nservice: one\n---\nservice: two\n"+ yamlErrorCategory problem @?= YamlMultipleDocuments+ yamlErrorLine problem @?= Just 3,+ testCase "aliases and anchors fail explicitly" $ do+ anchorProblem <- expectError "shared: &shared\n port: 8000\n"+ yamlErrorCategory anchorProblem @?= YamlUnsupportedFeature+ aliasProblem <- expectError "service: *shared\n"+ yamlErrorCategory aliasProblem @?= YamlUnsupportedFeature,+ testCase "merge keys fail explicitly" $ do+ problem <- expectError "service:\n <<: {port: 8000}\n"+ yamlErrorCategory problem @?= YamlUnsupportedFeature+ yamlErrorContext problem @?= "$.service.<<",+ testCase "custom tags fail explicitly" $ do+ problem <- expectError "service: !custom value\n"+ yamlErrorCategory problem @?= YamlUnsupportedFeature,+ testCase "non-string mapping keys fail" $ do+ problem <- expectError "1: value\n"+ yamlErrorCategory problem @?= YamlNonStringKey,+ testCase "syntax failures retain one-based parser marks" $ do+ problem <- expectError "service: [one, two\n"+ yamlErrorCategory problem @?= YamlSyntaxError+ assertBool "syntax error omitted its line" (maybe False (> 0) (yamlErrorLine problem))+ assertBool "syntax error omitted its column" (maybe False (> 0) (yamlErrorColumn problem))+ ]++expectError :: String -> IO YamlSourceError+expectError input =+ case decodeYamlSource (withYamlSourcePath "characterization.yaml" (yamlSourceOptions "characterization")) (ByteString8.pack input) of+ Left errors -> pure (NonEmpty.head errors)+ Right _ -> fail "expected strict YAML characterization to fail"
+ test/Settei/YamlTest.hs view
@@ -0,0 +1,194 @@+module Settei.YamlTest (tests) where++import Data.ByteString qualified as ByteString+import Data.ByteString.Char8 qualified as ByteString8+import Data.Generics.Labels ()+import Data.List.NonEmpty qualified as NonEmpty+import Data.Ratio ((%))+import Data.Text qualified as Text+import Paths_settei_yaml qualified as Paths+import Settei+import Settei.Prelude+import Settei.Yaml+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, testCase, (@?=))++tests :: TestTree+tests =+ testGroup+ "Settei.Yaml"+ [ testCase "nested mappings become segmented keys with exact locations" $ do+ input <- expectSource "service:\n http:\n host: api.internal\n port: 8080\n"+ host <- expectCandidate serviceHttpHost input+ assertBool "host did not remain text" (candidateValue host == RawText "api.internal")+ host ^. to candidateOrigin . #name @?= "application"+ host ^? to candidateOrigin . #location . _Just . #path @?= Just "application.yaml"+ host ^? to candidateOrigin . #location . _Just . #line @?= Just (Just 3)+ host ^? to candidateOrigin . #location . _Just . #column @?= Just (Just 11)+ port <- expectCandidate serviceHttpPort input+ assertBool "port did not remain numeric" (candidateValue port == RawNumber 8080),+ testCase "explicit null remains a present candidate" $ do+ input <- expectSource "service:\n optional: null\n"+ found <- expectCandidate serviceOptional input+ assertBool "explicit null became absence" (candidateValue found == RawNull),+ testCase "large integers, decimals, booleans, and arrays retain portable meaning" $ do+ input <-+ expectSource+ "limits:\n huge: 123456789012345678901234567890\n ratio: 1.25\nfeature:\n enabled: true\n names: [one, two]\n"+ huge <- expectCandidate hugeNumber input+ assertBool+ "large integer lost precision"+ (candidateValue huge == RawNumber 123456789012345678901234567890)+ ratio <- expectCandidate ratioNumber input+ assertBool "decimal lost precision" (candidateValue ratio == RawNumber (5 % 4))+ enabled <- expectCandidate featureEnabled input+ assertBool "boolean was not typed" (candidateValue enabled == RawBool True)+ names <- expectCandidate featureNames input+ assertBool+ "array shape changed"+ (candidateValue names == RawArray [RawText "one", RawText "two"]),+ testCase "higher YAML overrides leaves and replaces arrays wholesale" $ do+ low <- expectNamedSource "low" "service:\n host: old.internal\n port: 7000\n names: [one, two]\n"+ high <- expectNamedSource "high" "service:\n port: 9000\n names: [three]\n"+ result <-+ expectResolution+ ( resolve+ defaultResolveOptions+ [low, high]+ ((,,) <$> required hostSetting <*> required portSetting <*> required namesSetting)+ )+ result ^. #value @?= ("old.internal", 9000, ["three"])+ case result ^. #report . #nodes . at servicePort of+ Just node -> do+ node ^. #origin . _Just . #name @?= "high"+ fmap (^. #name) (node ^. #shadowed) @?= ["low"]+ Nothing -> fail "expected resolved YAML port provenance",+ testCase "dotted keys fail instead of becoming implicit nesting" $ do+ problem <- expectError "service.port: 8080\n"+ yamlErrorCategory problem @?= YamlDottedKey+ yamlErrorContext problem @?= "$.service.port",+ testCase "special floating values fail instead of becoming text" $ do+ problem <- expectError "service:\n ratio: !!float .inf\n"+ yamlErrorCategory problem @?= YamlInvalidScalar,+ testCase "invalid UTF-8 fails without retaining source bytes" $ do+ let invalid = ByteString.pack [115, 101, 114, 118, 105, 99, 101, 58, 32, 255]+ case decodeYamlSource sourceOptions invalid of+ Left errors -> do+ let problem = NonEmpty.head errors+ assertBool+ "unexpected invalid UTF-8 category"+ (yamlErrorCategory problem `elem` [YamlSyntaxError, YamlInvalidScalar])+ Right _ -> fail "expected invalid UTF-8 to fail",+ testCase "mounted Secret metadata remains visible while its setting is redacted" $ do+ let reference = kubernetesRef SecretObject (Just "production") "database-config" (Just "config.yaml")+ options = fromKubernetesMountedFile reference sourceOptions+ input <- expectSourceWith options ("database:\n password: " <> Text.unpack 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 "readYamlSource reports IO failures with the requested path" $ do+ result <- readYamlSource (yamlSourceOptions "missing") "test/fixtures/does-not-exist.yaml"+ case result of+ Left errors -> do+ let problem = NonEmpty.head errors+ yamlErrorCategory problem @?= YamlIoError+ yamlErrorPath problem @?= Just "test/fixtures/does-not-exist.yaml"+ Right _ -> fail "expected missing YAML file to fail",+ testCase "readYamlSource loads a fixture and records its actual path" $ do+ fixturePath <- Paths.getDataFileName "test/fixtures/characterization/nested.yaml"+ result <- readYamlSource (yamlSourceOptions "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),+ testCase "syntax errors never echo an earlier secret scalar" $ do+ let input =+ "database:\n password: "+ <> Text.unpack secretSentinel+ <> "\nbroken: [one, two\n"+ case decodeYamlSource sourceOptions (ByteString8.pack input) of+ Left errors ->+ assertBool+ "secret reached structured YAML errors"+ (not (secretSentinel `Text.isInfixOf` Text.pack (show errors)))+ Right _ -> fail "expected malformed YAML to fail",+ testCase "top-level sequences fail because configuration keys require a mapping" $ do+ problem <- expectError "[one, two]\n"+ yamlErrorCategory problem @?= YamlTopLevelType+ ]++sourceOptions :: YamlSourceOptions+sourceOptions = withYamlSourcePath "application.yaml" (yamlSourceOptions "application")++expectSource :: String -> IO Source+expectSource = expectSourceWith sourceOptions++expectNamedSource :: Text -> String -> IO Source+expectNamedSource name =+ expectSourceWith (withYamlSourcePath (Text.unpack name <> ".yaml") (yamlSourceOptions name))++expectSourceWith :: YamlSourceOptions -> String -> IO Source+expectSourceWith options input =+ case decodeYamlSource options (ByteString8.pack input) of+ Left errors -> fail (show errors)+ Right value -> pure value++expectError :: String -> IO YamlSourceError+expectError input = case decodeYamlSource sourceOptions (ByteString8.pack input) of+ Left errors -> pure (NonEmpty.head errors)+ Right _ -> fail "expected YAML decoding to fail"++expectCandidate :: Key -> Source -> IO Candidate+expectCandidate key input = case lookupSource key input of+ Right (Just found) -> pure found+ _ -> fail "expected YAML candidate"++expectResolution :: Either (NonEmpty ConfigError) a -> IO a+expectResolution = \case+ Left _ -> fail "expected YAML resolution to succeed"+ 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, serviceHttpPort, serviceHost, servicePort, serviceNames, serviceOptional, hugeNumber, ratioNumber, featureEnabled, featureNames, databasePassword :: Key+serviceHttpHost = validKey "service.http.host"+serviceHttpPort = validKey "service.http.port"+serviceHost = validKey "service.host"+servicePort = validKey "service.port"+serviceNames = validKey "service.names"+serviceOptional = validKey "service.optional"+hugeNumber = validKey "limits.huge"+ratioNumber = validKey "limits.ratio"+featureEnabled = validKey "feature.enabled"+featureNames = validKey "feature.names"+databasePassword = validKey "database.password"++validKey :: Text -> Key+validKey value = either (error . show) id (parseKey value)++secretSentinel :: Text+secretSentinel = "never-render-this-yaml-secret"
+ test/fixtures/characterization/README.md view
@@ -0,0 +1,20 @@+# libyaml 0.1.4 characterization++Settei uses `Text.Libyaml.decodeMarked` from `libyaml` 0.1.4 rather than converting+through `Data.Aeson.Value`. Direct inspection of `yaml` 0.11.11.2 showed that its common+`decodeEither'` entry point discards duplicate-key warnings, while `decodeMarked` retains+every mapping pair and one zero-based start and end mark per parser event.++The `Settei.Yaml.Characterization` tests prove the supported boundary. Block and flow+duplicates fail at the second key. Syntax errors and successful values retain marks, which+the public adapter reports as one-based positions. Multiple documents, anchors, aliases,+merge keys, custom tags, and non-string keys fail explicitly. Scalars support null,+booleans, exact finite numbers, strings, arrays, and ordinary string-keyed mappings.++These fixtures are small review artifacts matching the inline executable cases:++- `duplicate-block.yaml` and `duplicate-flow.yaml` contain ambiguous mappings.+- `multiple-documents.yaml` contains two documents that must not be collapsed.+- `alias.yaml`, `merge-key.yaml`, and `custom-tag.yaml` exercise deliberately unsupported+ YAML graph and extension features.+- `nested.yaml` is the supported location and translation baseline.
+ test/fixtures/characterization/alias.yaml view
@@ -0,0 +1,3 @@+shared: &shared+ port: 8000+service: *shared
+ test/fixtures/characterization/custom-tag.yaml view
@@ -0,0 +1,1 @@+service: !custom value
+ test/fixtures/characterization/duplicate-block.yaml view
@@ -0,0 +1,3 @@+service:+ port: 8000+ port: 9000
+ test/fixtures/characterization/duplicate-flow.yaml view
@@ -0,0 +1,1 @@+service: {port: 8000, port: 9000}
+ test/fixtures/characterization/merge-key.yaml view
@@ -0,0 +1,2 @@+service:+ <<: {port: 8000}
+ test/fixtures/characterization/multiple-documents.yaml view
@@ -0,0 +1,4 @@+---+service: one+---+service: two
+ test/fixtures/characterization/nested.yaml view
@@ -0,0 +1,4 @@+service:+ http:+ host: api.internal+ port: 8080