packages feed

settei 0.1.0.0 → 0.2.0.0

raw patch · 21 files changed

+1524/−132 lines, 21 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Settei.Resolve: [value] :: ResolveResult a -> !a
+ Settei.Config: fallbackTo :: Config (Maybe a) -> Config a -> Config a
+ Settei.Config: whenConfig :: Config Bool -> Config a -> Config (Maybe a)
+ Settei.Config: whenEq :: Eq d => Config d -> d -> Config a -> Config (Maybe a)
+ Settei.Error: SensitivityConflict :: !SensitivityConflictProblem -> ConfigError
+ Settei.Error: SensitivityConflictProblem :: !Key -> SensitivityConflictProblem
+ Settei.Error: data SensitivityConflictProblem
+ Settei.Error: instance GHC.Classes.Eq Settei.Error.SensitivityConflictProblem
+ Settei.Error: instance GHC.Internal.Generics.Generic Settei.Error.SensitivityConflictProblem
+ Settei.Error: instance GHC.Internal.Show.Show Settei.Error.SensitivityConflictProblem
+ Settei.Provenance: redactReportedValue :: ReportedValue -> ReportedValue
+ Settei.Resolve: [answer] :: ResolveResult a -> !Either (NonEmpty ConfigError) a
+ Settei.Setting: publicShowSetting :: Show a => Key -> Text -> Decoder a -> Setting a
+ Settei.Setting: withRenderer :: (a -> Text) -> Setting a -> Setting a
+ Settei.Source: DuplicateSourceKey :: !Key -> SourceConstructionError
+ Settei.Source: OverlappingSourceKeys :: !Key -> !Key -> SourceConstructionError
+ Settei.Source: data SourceConstructionError
+ Settei.Source: instance GHC.Classes.Eq Settei.Source.SourceConstructionError
+ Settei.Source: instance GHC.Internal.Generics.Generic Settei.Source.SourceConstructionError
+ Settei.Source: instance GHC.Internal.Show.Show Settei.Source.SourceConstructionError
+ Settei.Source: sourceFromPairs :: Text -> SourceKind -> [(Key, RawValue)] -> Either (NonEmpty SourceConstructionError) Source
+ Settei.Source: sourceUnaddressableLeaves :: Source -> [[Text]]
+ Settei.Value: doubleDecoder :: Decoder Double
+ Settei.Value: instance GHC.Internal.Base.Functor Settei.Value.Decoder
+ Settei.Value: listDecoder :: Decoder a -> Decoder [a]
+ Settei.Value: nonEmptyDecoder :: Decoder a -> Decoder (NonEmpty a)
+ Settei.Value: parsedDecoder :: Text -> (Text -> Either Text a) -> Decoder a
+ Settei.Value: rationalDecoder :: Decoder Rational
- Settei.Resolve: ResolveResult :: !a -> !ResolutionReport -> ![ConfigWarning] -> ResolveResult a
+ Settei.Resolve: ResolveResult :: !Either (NonEmpty ConfigError) a -> !ResolutionReport -> ![ConfigWarning] -> ResolveResult a
- Settei.Resolve: resolve :: ResolveOptions -> [Source] -> Config a -> Either (NonEmpty ConfigError) (ResolveResult a)
+ Settei.Resolve: resolve :: ResolveOptions -> [Source] -> Config a -> ResolveResult a

Files

CHANGELOG.md view
@@ -1,8 +1,46 @@ # Changelog for settei -## 0.1.0.0 — 2026-07-18+## 0.2.0.0 — 2026-07-19 +- `Settei.Prelude` is now documented as internal to the settei package family and is+  excluded from the PVP-stable public surface; adopters should import the documented+  public modules instead. Its exports track the `lens` package and may change in any+  release.+- Add a `Functor` instance for `Decoder`; a newtype-wrapping decoder is now+  `SecretText <$> textDecoder`.+- Add decoder combinators `listDecoder`, `nonEmptyDecoder`, `parsedDecoder`,+  `rationalDecoder`, and `doubleDecoder`, all preserving the secret-safe+  failure contract (failures carry only the setting key and an expectation).+- `boundedIntegralDecoder` failures now state the accepted range, for example+  `integer between -32768 and 32767`.+- Document `enumDecoder`'s case-sensitive matching.+- Add `whenConfig`, `whenEq`, and `fallbackTo` to `Settei.Config`. Each combinator+  desugars to the existing `Functor` and `Selective` operations without changing the+  inspectable declaration algebra.+- Add `publicShowSetting` and `withRenderer` to `Settei.Setting` for concise typed-default+  rendering; secret settings continue to redact regardless of attached renderers.+- The text renderer's Kubernetes suffix appends `(modified TIME)` when an origin carries+  the `kubernetes.file-modified` annotation. JSON output is unchanged because it already+  emits the full annotation map.++## 0.1.0.0 — 2026-07-19+ - Initial experimental release. - Add inspectable Applicative and Selective configuration declarations. - Add hierarchical resolution, ordered provenance, named defaults, secret-safe errors,   static schemas, and versioned text and JSON reports.+- Merge duplicate setting sensitivities most-restrictively in schemas and reports, so a+  key declared `Secret` anywhere cannot be weakened by a conflicting `Public`+  declaration; add `redactReportedValue` as a one-way collapse of any retained display+  representation to the redaction marker.+- Add the structured `SensitivityConflict` resolution error for mixed-sensitivity keys,+  rendered in JSON with the additive `sensitivity-conflict` kind.+- Breaking: `resolve` now returns `ResolveResult` unconditionally. The typed outcome+  moved to its `answer` field, while the provenance report and warnings are available+  for every resolution attempt, including failures.+- Make repeated `annotateSource` calls merge source-wide annotations, with annotations+  from later calls winning on name collisions.+- Add `sourceFromPairs`, `SourceConstructionError`, and+  `sourceUnaddressableLeaves` for validated custom-source construction and inspection.+- Render exact terminating rational values as decimals in reports while retaining exact+  fraction notation for non-terminating values.
settei.cabal view
@@ -1,6 +1,6 @@ cabal-version:      3.8 name:               settei-version:            0.1.0.0+version:            0.2.0.0 synopsis:           Typed, layered, explainable configuration description:   Settei provides an inspectable declaration language for typed configuration.
src/Settei/Config.hs view
@@ -13,10 +13,7 @@ -- @ -- productionPassword :: Config (Maybe Text) -- productionPassword =---   select---     ((\environment -> if environment == "production" then Left () else Right Nothing)---       '<$>' required environmentSetting)---     ((\password _ -> Just password) '<$>' required passwordSetting)+--   whenEq (required environmentSetting) "production" (required passwordSetting) -- @ -- -- Inspection needs no environment variables or files:@@ -26,17 +23,31 @@ -- -- ["runtime.environment"] -- @ --+-- For arbitrary selective branch shapes, use 'Control.Selective.select' directly; the+-- production-only declaration above desugars to:+--+-- @+-- select+--   ((\environment -> if environment == "production" then Left () else Right Nothing)+--     '<$>' required environmentSetting)+--   ((\password _ -> Just password) '<$>' required passwordSetting)+-- @+-- -- 'Config' intentionally has no 'Monad' instance. Monadic binding could construct new -- keys from resolved values and would make complete static inspection impossible. module Settei.Config   ( Config,     describe,+    fallbackTo,     optional,     required,+    whenConfig,+    whenEq,     withDefault,   ) where +import Control.Selective (select) import Settei.Default (Default) import Settei.Internal.Config   ( Config,@@ -55,6 +66,48 @@ -- | Request a setting without failing when no source supplies it. optional :: Setting a -> Config (Maybe a) optional = optionalConfig++-- | Evaluate a declaration only when a condition is 'True'.+--+-- Desugars to 'Control.Selective.select'; no new syntax is introduced. Schema+-- footprint: every setting inside the condition keeps its presence (a 'required'+-- condition setting stays necessary); every setting inside the branch becomes+-- conditional; one 'Settei.Schema.Condition' row is recorded whose dependencies are the+-- condition's possible keys and whose activated settings are the branch's possible keys.+-- At resolution time a 'False' condition reports the branch's settings as not selected+-- rather than missing.+whenConfig :: Config Bool -> Config a -> Config (Maybe a)+whenConfig condition branch =+  select+    ((\flag -> if flag then Left () else Right Nothing) <$> condition)+    ((\value () -> Just value) <$> branch)++-- | Evaluate a declaration only when a scrutinee equals an expected value.+--+-- @'whenEq' (required environmentSetting) Production (required passwordSetting)@+-- requires the password only when the resolved environment is @Production@. Schema+-- footprint is identical to 'whenConfig': scrutinee settings keep their presence,+-- branch settings become conditional, and one 'Settei.Schema.Condition' row links them.+whenEq :: (Eq d) => Config d -> d -> Config a -> Config (Maybe a)+whenEq scrutinee expected = whenConfig ((== expected) <$> scrutinee)++-- | Use the first declaration's value when present; otherwise evaluate the fallback.+--+-- This is the key-migration idiom:+-- @optional newSetting `fallbackTo` required oldSetting@ reads a renamed key and+-- consults the old key only when no source supplies the new one.+--+-- Desugars to 'Control.Selective.select'. Schema footprint: the primary declaration's+-- settings keep their presence; the fallback's settings become conditional; one+-- 'Settei.Schema.Condition' row records the primary's possible keys as dependencies and+-- the fallback's possible keys as activated settings. The alias is declaration-level,+-- not per-source: a value for the primary key in any source, however low its precedence,+-- suppresses the fallback entirely.+fallbackTo :: Config (Maybe a) -> Config a -> Config a+fallbackTo primary fallback =+  select+    (maybe (Left ()) Right <$> primary)+    (const <$> fallback)  -- | Request a setting, evaluating its named fallback only when no source supplies it. withDefault :: Setting a -> Default a -> Config a
src/Settei/Error.hs view
@@ -9,6 +9,7 @@     DecodeProblem (..),     MissingProblem (..),     RawShape (..),+    SensitivityConflictProblem (..),     StructuralError (..),     UnknownKeyProblem (..),   )@@ -69,6 +70,12 @@   }   deriving stock (Generic, Eq, Show) +-- | One key was declared with both public and secret sensitivity.+data SensitivityConflictProblem = SensitivityConflictProblem+  { key :: !Key+  }+  deriving stock (Generic, Eq, Show)+ -- | A fatal resolver error. Every constructor is safe to render or show. data ConfigError   = MissingRequired !MissingProblem@@ -77,6 +84,7 @@   | UnknownKeyError !UnknownKeyProblem   | DefaultError !DefaultProblem   | DefaultCycle !DefaultCycleProblem+  | SensitivityConflict !SensitivityConflictProblem   deriving stock (Generic, Eq, Show)  -- | A non-fatal resolver diagnostic.
src/Settei/Internal/Schema.hs view
@@ -7,6 +7,7 @@     combineSchema,     conditionalSchema,     emptySchema,+    mergeSensitivity,     requestSchema,   ) where@@ -17,7 +18,7 @@ import Settei.Key (Key) import Settei.Prelude import Settei.Setting-  ( Sensitivity,+  ( Sensitivity (..),     Setting,     settingDescription,     settingKey,@@ -37,6 +38,7 @@   { key :: !Key,     description :: !Text,     sensitivity :: !Sensitivity,+    declaredSensitivities :: !(Set Sensitivity),     requirement :: !Requirement,     presence :: !Presence   }@@ -72,6 +74,7 @@         { key,           description = settingDescription settingSpec,           sensitivity = settingSensitivity settingSpec,+          declaredSensitivities = Set.singleton (settingSensitivity settingSpec),           requirement,           presence = Necessary         }@@ -102,10 +105,20 @@ mergeSetting :: SchemaSetting -> SchemaSetting -> SchemaSetting mergeSetting left right =   left+    & #sensitivity+    .~ mergeSensitivity (left ^. #sensitivity) (right ^. #sensitivity)+    & #declaredSensitivities+    .~ Set.union (left ^. #declaredSensitivities) (right ^. #declaredSensitivities)     & #requirement     .~ mergeRequirement (left ^. #requirement) (right ^. #requirement)     & #presence     .~ mergePresence (left ^. #presence) (right ^. #presence)++-- | Secret wins: a key declared secret anywhere is secret everywhere.+mergeSensitivity :: Sensitivity -> Sensitivity -> Sensitivity+mergeSensitivity Secret _ = Secret+mergeSensitivity _ Secret = Secret+mergeSensitivity Public Public = Public  mergeRequirement :: Requirement -> Requirement -> Requirement mergeRequirement Required _ = Required
src/Settei/Prelude.hs view
@@ -2,7 +2,19 @@  -- | -- Module: Settei.Prelude--- Description: Small shared project prelude and lens operator surface.+-- Description: Internal shared prelude for the settei package family.+--+-- __Internal to the settei package family — not part of the PVP-stable API.__+--+-- This module exists so that the settei core, its sibling adapter packages,+-- and the reference applications share one import baseline. It re-exports+-- the full "Control.Lens" surface (hiding the lens @Setting@ type alias,+-- which collides with Settei's own 'Settei.Setting.Setting') together with+-- "Prelude" and a few common types. Because its exports track the @lens@+-- package, they may change in any settei release, including patch releases.+-- Code outside this repository must not import this module; the supported+-- adoption surface is listed in the compatibility matrix+-- (@docs/compatibility.md@ in the source distribution). module Settei.Prelude   ( module X,     module Control.Lens,
src/Settei/Provenance.hs view
@@ -8,6 +8,7 @@     candidateOrigin,     candidateValue,     derivedReportedValue,+    redactReportedValue,     renderReportedValue,     reportedValue,     visibleReportedValue,@@ -59,6 +60,10 @@ reportedValue Public = VisibleValue . renderRawValue reportedValue Secret = const RedactedValue +-- | Collapse any retained display representation to the redaction marker.+redactReportedValue :: ReportedValue -> ReportedValue+redactReportedValue _ = RedactedValue+ -- | Render a retained value. A redacted value has no recovery path. renderReportedValue :: ReportedValue -> Text renderReportedValue (VisibleValue value) = value@@ -83,9 +88,12 @@   RawNumber value     | Ratio.denominator value == 1 -> Text.pack (show (Ratio.numerator value))     | otherwise ->-        Text.pack (show (Ratio.numerator value))-          <> "/"-          <> Text.pack (show (Ratio.denominator value))+        case renderDecimal value of+          Just decimal -> decimal+          Nothing ->+            Text.pack (show (Ratio.numerator value))+              <> "/"+              <> Text.pack (show (Ratio.denominator value))   RawArray values -> "[" <> Text.intercalate ", " (fmap renderRawValue values) <> "]"   RawObject values ->     "{"@@ -95,6 +103,30 @@         | (key, value) <- Map.toAscList values         ]       <> "}"++renderDecimal :: Rational -> Maybe Text+renderDecimal value =+  let numerator = Ratio.numerator value+      denominator = Ratio.denominator value+      (twos, afterTwos) = countFactor 2 denominator+      (fives, residual) = countFactor 5 afterTwos+   in if residual /= 1+        then Nothing+        else+          let scale = max twos fives+              scaled = abs numerator * (10 ^ scale) `quot` denominator+              digits = Text.pack (show scaled)+              padded = Text.replicate (max 0 (scale + 1 - Text.length digits)) "0" <> digits+              (whole, fractional) = Text.splitAt (Text.length padded - scale) padded+              sign = if numerator < 0 then "-" else ""+           in Just (sign <> whole <> "." <> fractional)++countFactor :: Integer -> Integer -> (Int, Integer)+countFactor factor = go 0+  where+    go count remaining+      | remaining `rem` factor == 0 = go (count + 1) (remaining `quot` factor)+      | otherwise = (count, remaining)  escapeText :: Text -> Text escapeText =
src/Settei/Render.hs view
@@ -64,7 +64,7 @@       <> commaKeys (Set.toAscList (conditionSettings condition))   ] --- | Render one successful resolution, including skipped settings and branch decisions.+-- | Render one resolution attempt, including skipped settings and branch decisions. renderResolutionText :: ResolutionReport -> Text renderResolutionText report =   Text.concat (fmap (renderNodeText report) (reportNodes report))@@ -161,6 +161,10 @@         <> maybe "" (<> "/") (origin ^. #annotations . at "kubernetes.namespace")         <> objectName         <> maybe "" (" key " <>) (origin ^. #annotations . at "kubernetes.object-key")+        <> maybe+          ""+          (\modified -> " (modified " <> modified <> ")")+          (origin ^. #annotations . at "kubernetes.file-modified")     _ -> ""  -- | Render structured failures without access to rejected secret values.@@ -199,6 +203,9 @@   DefaultCycle problem ->     "default cycle: "       <> Text.intercalate " -> " (fmap renderRuleName (NonEmpty.toList (problem ^. #rules)))+  SensitivityConflict problem ->+    renderKey (problem ^. #key)+      <> ": declared with both public and secret sensitivity; treated as secret"  -- | Render non-fatal diagnostics in deterministic source and key order. renderWarningsText :: [ConfigWarning] -> Text@@ -237,7 +244,7 @@       ("settings", jsonKeyArray (Set.toAscList (conditionSettings condition)))     ] --- | Render a successful resolution as versioned deterministic JSON.+-- | Render a resolution attempt as versioned deterministic JSON. renderResolutionJson :: ResolutionReport -> Text renderResolutionJson report =   versionedJson@@ -340,6 +347,11 @@     jsonObject       [ ("kind", jsonString "default-cycle"),         ("rules", jsonArray (fmap (jsonString . renderRuleName) (NonEmpty.toList (problem ^. #rules))))+      ]+  SensitivityConflict problem ->+    jsonObject+      [ ("kind", jsonString "sensitivity-conflict"),+        ("key", jsonString (renderKey (problem ^. #key)))       ]  -- | Render warnings as a versioned deterministic JSON document.
src/Settei/Report.hs view
@@ -54,7 +54,7 @@   }   deriving stock (Generic, Eq, Show) --- | Complete, secret-safe trace for one successful resolution.+-- | Complete, secret-safe trace for one resolution attempt. data ResolutionReport = ResolutionReport   { nodes :: !(Map Key ResolutionNode),     branches :: ![BranchTrace]
src/Settei/Resolve.hs view
@@ -15,6 +15,8 @@ import Data.Generics.Labels () import Data.List.NonEmpty qualified as NonEmpty import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe)+import Data.Set qualified as Set import Settei.Error import Settei.Internal.Config   ( Config (..),@@ -24,7 +26,7 @@     describeConfig,     renderRuleName,   )-import Settei.Internal.Schema (Schema)+import Settei.Internal.Schema (Schema, mergeSensitivity) import Settei.Key (Key, keySegments) import Settei.Origin (Origin (..), SourceKind (DerivedSource)) import Settei.Prelude@@ -34,6 +36,7 @@     candidateOrigin,     candidateValue,     derivedReportedValue,+    redactReportedValue,     reportedValue,     visibleReportedValue,   )@@ -65,9 +68,11 @@   }   deriving stock (Generic, Eq, Show) --- | The typed result plus its safe explanation and non-fatal diagnostics.+-- | The outcome of one resolution attempt. The provenance report and non-fatal+-- warnings are always present; the typed value or accumulated errors live in+-- 'answer'. data ResolveResult a = ResolveResult-  { value :: !a,+  { answer :: !(Either (NonEmpty ConfigError) a),     report :: !ResolutionReport,     warnings :: ![ConfigWarning]   }@@ -81,29 +86,50 @@ -- -- Each request chooses its rightmost candidate and decodes it exactly once. Independent -- applicative errors accumulate in declaration order; selective branches evaluate only--- the branch selected by their resolved selector.-resolve :: ResolveOptions -> [Source] -> Config a -> Either (NonEmpty ConfigError) (ResolveResult a)+-- the branch selected by their resolved selector. The report and warnings are returned+-- on both success and failure. Validation failures that happen before evaluation return+-- a schema-shaped report of not-selected nodes with no branch traces; default-cycle+-- failures additionally return no warnings and do not inspect any source.+resolve :: ResolveOptions -> [Source] -> Config a -> ResolveResult a resolve options sources config =   case NonEmpty.nonEmpty (validateDefaultCycles config) of-    Just errors -> Left errors-    Nothing -> resolveValidated+    Just errors ->+      ResolveResult+        { answer = Left errors,+          report = ResolutionReport {nodes = cycleSchemaNodes config, branches = []},+          warnings = []+        }+    Nothing -> case NonEmpty.nonEmpty (validateSensitivityConflicts schemaSettings) of+      Just errors -> preEvaluationFailure errors+      Nothing -> resolveValidated   where     resolveValidated =       case NonEmpty.nonEmpty structuralErrors of-        Just errors -> Left errors+        Just errors -> preEvaluationFailure errors         Nothing ->-          case appendErrors (evaluation ^. #answer) strictUnknownErrors of-            Left errors -> Left (toNonEmpty errors)-            Right value ->-              Right-                ResolveResult-                  { value,-                    report = ResolutionReport {nodes = completeNodes, branches = evaluation ^. #branches},-                    warnings = unknownWarnings-                  }+          ResolveResult+            { answer =+                case appendErrors (evaluation ^. #answer) strictUnknownErrors of+                  Left errors -> Left (toNonEmpty errors)+                  Right value -> Right value,+              report = ResolutionReport {nodes = completeNodes, branches = evaluation ^. #branches},+              warnings = unknownWarnings+            }+    preEvaluationFailure errors =+      ResolveResult+        { answer = Left errors,+          report = ResolutionReport {nodes = schemaOnlyNodes, branches = []},+          warnings = unknownWarnings+        }     schemaSettings = schemaPossible (describeEvaluation config)+    schemaOnlyNodes = addNotSelected schemaSettings Map.empty+    sensitivities =+      Map.fromList+        [ (schemaSettingKey schemaSetting, schemaSettingSensitivity schemaSetting)+        | schemaSetting <- schemaSettings+        ]     structuralErrors = validateStructure schemaSettings sources-    evaluation = evaluate sources config+    evaluation = evaluate sensitivities sources config     unknownProblems = findUnknownKeys schemaSettings sources     unknownWarnings = case options ^. #unknownKeyPolicy of       WarnUnknownKeys -> fmap UnknownKeyWarning unknownProblems@@ -113,6 +139,65 @@       RejectUnknownKeys -> errorsOnly (fmap UnknownKeyError unknownProblems)     completeNodes = addNotSelected schemaSettings (evaluation ^. #nodes) +-- | Build the not-selected skeleton for a default-cycle failure without calling+-- 'describeEvaluation'. Static schema construction follows default dependencies and+-- therefore cannot terminate for the cyclic declaration this path is reporting.+cycleSchemaNodes :: Config a -> Map Key ResolutionNode+cycleSchemaNodes = Map.mapWithKey notSelectedNode . cycleSettings []+  where+    cycleSettings :: [RuleName] -> Config b -> Map Key Sensitivity+    cycleSettings active = \case+      PureConfig _ -> Map.empty+      MapConfig _ declaration -> cycleSettings active declaration+      ApplyConfig function inputConfig ->+        Map.unionWith+          mergeSensitivity+          (cycleSettings active function)+          (cycleSettings active inputConfig)+      RequestConfig request -> case request of+        RequiredRequest settingSpec -> oneSetting settingSpec+        OptionalRequest settingSpec -> oneSetting settingSpec+      DefaultConfig settingSpec defaultSpec ->+        Map.unionWith+          mergeSensitivity+          (oneSetting settingSpec)+          (defaultSettings active defaultSpec)+      SelectConfig selector branch ->+        Map.unionWith+          mergeSensitivity+          (cycleSettings active selector)+          (cycleSettings active branch)++    defaultSettings :: [RuleName] -> Default b -> Map Key Sensitivity+    defaultSettings active defaultSpec+      | rule `elem` active = Map.empty+      | otherwise = case defaultSpec of+          ConstantDefault _ _ _ -> Map.empty+          DerivedDefault _ _ dependency _ -> cycleSettings (active <> [rule]) dependency+          CaseDefault _ _ dependency _ _ -> cycleSettings (active <> [rule]) dependency+      where+        rule = defaultRule defaultSpec++    oneSetting settingSpec =+      Map.singleton (settingKey settingSpec) (settingSensitivity settingSpec)++    notSelectedNode key sensitivity =+      ResolutionNode+        { key,+          sensitivity,+          outcome = NotSelected,+          origin = Nothing,+          shadowed = [],+          derivation = Nothing+        }++validateSensitivityConflicts :: [SchemaSetting] -> [ConfigError]+validateSensitivityConflicts schemaSettings =+  [ SensitivityConflict (SensitivityConflictProblem {key = schemaSettingKey schemaSetting})+  | schemaSetting <- schemaSettings,+    Set.size (schemaSetting ^. #declaredSensitivities) > 1+  ]+ validateStructure :: [SchemaSetting] -> [Source] -> [ConfigError] validateStructure schemaSettings sources =   unique@@ -169,17 +254,19 @@   }   deriving stock (Generic) -evaluate :: [Source] -> Config a -> Evaluation a-evaluate sources = \case+evaluate :: Map Key Sensitivity -> [Source] -> Config a -> Evaluation a+evaluate sensitivities sources = \case   PureConfig value -> successful value-  MapConfig mapValue config -> mapEvaluation mapValue (evaluate sources config)+  MapConfig mapValue config -> mapEvaluation mapValue (evaluate sensitivities sources config)   ApplyConfig function inputConfig ->-    applyEvaluation (evaluate sources function) (evaluate sources inputConfig)-  RequestConfig request -> evaluateRequest sources request+    applyEvaluation+      (evaluate sensitivities sources function)+      (evaluate sensitivities sources inputConfig)+  RequestConfig request -> evaluateRequest sensitivities sources request   DefaultConfig settingSpec defaultSpec ->-    evaluateDefaultRequest sources settingSpec defaultSpec+    evaluateDefaultRequest sensitivities sources settingSpec defaultSpec   SelectConfig selector branch ->-    let selectorEvaluation = evaluate sources selector+    let selectorEvaluation = evaluate sensitivities sources selector         selectorKeys = Map.keys (selectorEvaluation ^. #nodes)         branchKeys = fmap schemaSettingKey (schemaPossible (describeEvaluation branch))      in case selectorEvaluation ^. #answer of@@ -191,11 +278,15 @@               & #branches               %~ (<> [BranchTrace {dependencies = selectorKeys, settings = branchKeys, selected = False}])           Right (Left input) ->-            let branchEvaluation = evaluate sources branch+            let branchEvaluation = evaluate sensitivities sources branch                 combined = mapEvaluation ($ input) branchEvaluation              in Evaluation                   { answer = combined ^. #answer,-                    nodes = Map.union (selectorEvaluation ^. #nodes) (branchEvaluation ^. #nodes),+                    nodes =+                      Map.unionWith+                        mergeNodes+                        (selectorEvaluation ^. #nodes)+                        (branchEvaluation ^. #nodes),                     branches =                       selectorEvaluation ^. #branches                         <> branchEvaluation ^. #branches@@ -207,10 +298,10 @@ describeEvaluation :: Config a -> Schema describeEvaluation = describeConfig -evaluateRequest :: [Source] -> Request a -> Evaluation a-evaluateRequest sources = \case+evaluateRequest :: Map Key Sensitivity -> [Source] -> Request a -> Evaluation a+evaluateRequest sensitivities sources = \case   RequiredRequest settingSpec ->-    case evaluateSetting sources settingSpec of+    case evaluateSetting sensitivities sources settingSpec of       SettingAbsent node ->         failed           [MissingRequired (MissingProblem {key = settingKey settingSpec})]@@ -218,44 +309,57 @@       SettingFailed errors node -> failed errors (Map.singleton (settingKey settingSpec) node)       SettingPresent value node -> withNode value node   OptionalRequest settingSpec ->-    case evaluateSetting sources settingSpec of+    case evaluateSetting sensitivities sources settingSpec of       SettingAbsent node -> withNode Nothing node       SettingFailed errors node -> failed errors (Map.singleton (settingKey settingSpec) node)       SettingPresent value node -> withNode (Just value) node -evaluateDefaultRequest :: [Source] -> Setting a -> Default a -> Evaluation a-evaluateDefaultRequest sources settingSpec defaultSpec =-  case evaluateSetting sources settingSpec of+evaluateDefaultRequest :: Map Key Sensitivity -> [Source] -> Setting a -> Default a -> Evaluation a+evaluateDefaultRequest sensitivities sources settingSpec defaultSpec =+  case evaluateSetting sensitivities sources settingSpec of     SettingFailed errors node -> failed errors (Map.singleton (settingKey settingSpec) node)     SettingPresent value node -> withNode value node-    SettingAbsent _ -> evaluateFallback sources settingSpec defaultSpec+    SettingAbsent _ -> evaluateFallback sensitivities sources settingSpec defaultSpec -evaluateFallback :: [Source] -> Setting a -> Default a -> Evaluation a-evaluateFallback sources settingSpec = \case+evaluateFallback :: Map Key Sensitivity -> [Source] -> Setting a -> Default a -> Evaluation a+evaluateFallback sensitivities sources settingSpec = \case   ConstantDefault rule explanation value ->-    derivedEvaluation settingSpec rule explanation [] value+    derivedEvaluation sensitivities settingSpec rule explanation [] value   DerivedDefault rule explanation dependency derive ->-    let dependencyEvaluation = evaluate sources dependency+    let dependencyEvaluation = evaluate sensitivities sources dependency      in case dependencyEvaluation ^. #answer of           Left errors -> evaluationFailure dependencyEvaluation errors           Right dependencyValue ->             derivedFromDependencies+              sensitivities               settingSpec               rule               explanation               dependencyEvaluation               (derive dependencyValue)   CaseDefault rule explanation dependency choices fallback ->-    let dependencyEvaluation = evaluate sources dependency+    let dependencyEvaluation = evaluate sensitivities sources dependency      in case dependencyEvaluation ^. #answer of           Left errors -> evaluationFailure dependencyEvaluation errors           Right dependencyValue ->             case lookup dependencyValue (NonEmpty.toList choices) of               Just value ->-                derivedFromDependencies settingSpec rule explanation dependencyEvaluation value+                derivedFromDependencies+                  sensitivities+                  settingSpec+                  rule+                  explanation+                  dependencyEvaluation+                  value               Nothing -> case fallback of                 Just value ->-                  derivedFromDependencies settingSpec rule explanation dependencyEvaluation value+                  derivedFromDependencies+                    sensitivities+                    settingSpec+                    rule+                    explanation+                    dependencyEvaluation+                    value                 Nothing ->                   evaluationFailure                     dependencyEvaluation@@ -268,35 +372,36 @@                     ]  derivedFromDependencies ::+  Map Key Sensitivity ->   Setting a ->   RuleName ->   Text ->   Evaluation d ->   a ->   Evaluation a-derivedFromDependencies settingSpec rule explanation dependencyEvaluation value =+derivedFromDependencies sensitivities settingSpec rule explanation dependencyEvaluation value =   Evaluation     { answer = Right value,       nodes =         dependencyEvaluation           ^. #nodes           & at (settingKey settingSpec)-          ?~ derivedNode settingSpec rule explanation dependencyKeys value,+          ?~ derivedNode sensitivities settingSpec rule explanation dependencyKeys value,       branches = dependencyEvaluation ^. #branches     }   where     dependencyKeys = Map.keys (dependencyEvaluation ^. #nodes) -derivedEvaluation :: Setting a -> RuleName -> Text -> [Key] -> a -> Evaluation a-derivedEvaluation settingSpec rule explanation dependencies value =-  withNode value (derivedNode settingSpec rule explanation dependencies value)+derivedEvaluation :: Map Key Sensitivity -> Setting a -> RuleName -> Text -> [Key] -> a -> Evaluation a+derivedEvaluation sensitivities settingSpec rule explanation dependencies value =+  withNode value (derivedNode sensitivities settingSpec rule explanation dependencies value) -derivedNode :: Setting a -> RuleName -> Text -> [Key] -> a -> ResolutionNode-derivedNode settingSpec rule explanation dependencies value =+derivedNode :: Map Key Sensitivity -> Setting a -> RuleName -> Text -> [Key] -> a -> ResolutionNode+derivedNode sensitivities settingSpec rule explanation dependencies value =   ResolutionNode     { key = settingKey settingSpec,-      sensitivity = settingSensitivity settingSpec,-      outcome = Resolved (defaultReportedValue settingSpec value),+      sensitivity = effectiveSensitivity sensitivities settingSpec,+      outcome = Resolved (defaultReportedValue sensitivities settingSpec value),       origin =         Just           Origin@@ -310,9 +415,9 @@       derivation = Just Derivation {rule = renderRuleName rule, explanation, dependencies}     } -defaultReportedValue :: Setting a -> a -> ReportedValue-defaultReportedValue settingSpec value =-  case settingSensitivity settingSpec of+defaultReportedValue :: Map Key Sensitivity -> Setting a -> a -> ReportedValue+defaultReportedValue sensitivities settingSpec value =+  case effectiveSensitivity sensitivities settingSpec of     Secret -> derivedReportedValue Secret     Public -> case settingValueRenderer settingSpec of       Just renderValue -> visibleReportedValue (renderValue value)@@ -331,14 +436,14 @@   | SettingFailed ![ConfigError] !ResolutionNode   | SettingPresent a !ResolutionNode -evaluateSetting :: [Source] -> Setting a -> SettingEvaluation a-evaluateSetting sources settingSpec =+evaluateSetting :: Map Key Sensitivity -> [Source] -> Setting a -> SettingEvaluation a+evaluateSetting sensitivities sources settingSpec =   case collectCandidates (settingKey settingSpec) sources of     Left structuralErrors ->       SettingFailed         (fmap StructuralConflict structuralErrors)-        (missingNode settingSpec)-    Right [] -> SettingAbsent (missingNode settingSpec)+        (missingNode sensitivities settingSpec)+    Right [] -> SettingAbsent (missingNode sensitivities settingSpec)     Right candidates ->       let winner = last candidates           lower = init candidates@@ -346,8 +451,8 @@           node =             ResolutionNode               { key = settingKey settingSpec,-                sensitivity = settingSensitivity settingSpec,-                outcome = Resolved (reportedValue (settingSensitivity settingSpec) rawValue),+                sensitivity,+                outcome = Resolved (reportedValue sensitivity rawValue),                 origin = Just (candidateOrigin winner),                 shadowed = fmap candidateOrigin (reverse lower),                 derivation = Nothing@@ -360,12 +465,23 @@                       { key = settingKey settingSpec,                         expected = decodeFailureExpected decodeFailure,                         origin = candidateOrigin winner,-                        rejected = reportedValue (settingSensitivity settingSpec) rawValue+                        rejected = reportedValue sensitivity rawValue                       }                 ]                 node             Right value -> SettingPresent value node+  where+    sensitivity = effectiveSensitivity sensitivities settingSpec +effectiveSensitivity :: Map Key Sensitivity -> Setting a -> Sensitivity+effectiveSensitivity sensitivities settingSpec =+  mergeSensitivity+    (settingSensitivity settingSpec)+    ( fromMaybe+        (settingSensitivity settingSpec)+        (Map.lookup (settingKey settingSpec) sensitivities)+    )+ collectCandidates :: Key -> [Source] -> Either [StructuralError] [Candidate] collectCandidates key sources =   case foldr collect ([], []) (fmap (lookupSource key) sources) of@@ -377,11 +493,11 @@     collect (Right (Just foundCandidate)) (errors, candidates) =       (errors, foundCandidate : candidates) -missingNode :: Setting a -> ResolutionNode-missingNode settingSpec =+missingNode :: Map Key Sensitivity -> Setting a -> ResolutionNode+missingNode sensitivities settingSpec =   ResolutionNode     { key = settingKey settingSpec,-      sensitivity = settingSensitivity settingSpec,+      sensitivity = effectiveSensitivity sensitivities settingSpec,       outcome = MissingValue,       origin = Nothing,       shadowed = [],@@ -409,9 +525,24 @@ applyEvaluation function inputConfig =   Evaluation     { answer = applyAnswer (function ^. #answer) (inputConfig ^. #answer),-      nodes = Map.union (function ^. #nodes) (inputConfig ^. #nodes),+      nodes = Map.unionWith mergeNodes (function ^. #nodes) (inputConfig ^. #nodes),       branches = function ^. #branches <> inputConfig ^. #branches     }++mergeNodes :: ResolutionNode -> ResolutionNode -> ResolutionNode+mergeNodes left right+  | left ^. #sensitivity == Secret || right ^. #sensitivity == Secret =+      left+        & #sensitivity+        .~ Secret+        & #outcome+        %~ redactOutcome+  | otherwise = left++redactOutcome :: ResolutionOutcome -> ResolutionOutcome+redactOutcome = \case+  Resolved value -> Resolved (redactReportedValue value)+  outcome -> outcome  applyAnswer :: Either [ConfigError] (a -> b) -> Either [ConfigError] a -> Either [ConfigError] b applyAnswer (Right function) (Right value) = Right (function value)
src/Settei/Setting.hs view
@@ -5,6 +5,7 @@   ( Sensitivity (..),     Setting,     decodeSetting,+    publicShowSetting,     publicSetting,     publicSettingWithRenderer,     secretSetting,@@ -12,10 +13,12 @@     settingKey,     settingSensitivity,     settingValueRenderer,+    withRenderer,   ) where  import Data.Generics.Labels ()+import Data.Text qualified as Text import Settei.Key (Key) import Settei.Prelude import Settei.Value (DecodeFailure, Decoder, RawValue, runDecoder)@@ -51,10 +54,27 @@ publicSettingWithRenderer key description decoder renderer =   Setting {key, description, sensitivity = Public, decoder, renderer = Just renderer} +-- | Declare a public setting whose typed default values render via 'show'.+--+-- Equivalent to 'publicSettingWithRenderer' with @Text.pack . show@. Best for primitive+-- and enum-like types; a derived 'Show' of a rich type may be ugly in reports but is+-- never unsafe, because renderers only affect display of typed defaults and secret+-- settings always redact regardless of any renderer.+publicShowSetting :: (Show a) => Key -> Text -> Decoder a -> Setting a+publicShowSetting key description decoder =+  publicSettingWithRenderer key description decoder (Text.pack . show)+ -- | Declare a setting whose resolved value must be redacted from reports. secretSetting :: Key -> Text -> Decoder a -> Setting a secretSetting key description decoder =   Setting {key, description, sensitivity = Secret, decoder, renderer = Nothing}++-- | Attach or replace the typed-default renderer of an existing setting.+--+-- On a secret setting this is harmless: the stored renderer is ignored and reports keep+-- showing the redaction marker (see "Settei.Resolve").+withRenderer :: (a -> Text) -> Setting a -> Setting a+withRenderer renderValue settingSpec = settingSpec & #renderer ?~ renderValue  -- | Decode one raw candidate using the setting's validated key. decodeSetting :: Setting a -> RawValue -> Either DecodeFailure a
src/Settei/Source.hs view
@@ -5,15 +5,18 @@ -- Description: Ordered, hierarchical configuration inputs. module Settei.Source   ( Source,+    SourceConstructionError (..),     annotateSource,     annotateSourceAt,     locateSource,     lookupSource,     source,     sourceAnnotations,+    sourceFromPairs,     sourceKind,     sourceLeaves,     sourceName,+    sourceUnaddressableLeaves,   ) where @@ -40,7 +43,21 @@   }   deriving stock (Generic) +-- | Why a list of key/value pairs cannot form one addressable source tree.+data SourceConstructionError+  = -- | The same key appears more than once.+    DuplicateSourceKey !Key+  | -- | One key is a structural prefix of another, so one leaf would sit+    -- inside the object the other needs to traverse.+    OverlappingSourceKeys !Key !Key+  deriving stock (Generic, Eq, Show)+ -- | Construct a source with no retained locations or annotations.+--+-- This function performs no validation. Leaves below object keys that are empty or+-- contain dots cannot be addressed by 'lookupSource' and are silently absent from+-- 'sourceLeaves'. Prefer 'sourceFromPairs' for hand-built sources; this function is the+-- unvalidated escape hatch used by adapters that already guarantee valid trees. source :: Text -> SourceKind -> RawValue -> Source source name kind root =   Source@@ -52,9 +69,46 @@       annotations = Map.empty     } +-- | Build a source from validated keys, rejecting duplicates and prefix overlaps.+--+-- Every leaf of the result is addressable by 'lookupSource' and enumerated by+-- 'sourceLeaves'. This is the recommended constructor for hand-built sources; 'source'+-- is the unvalidated escape hatch.+sourceFromPairs ::+  Text ->+  SourceKind ->+  [(Key, RawValue)] ->+  Either (NonEmpty SourceConstructionError) Source+sourceFromPairs name kind pairs =+  case NonEmpty.nonEmpty constructionErrors of+    Just errors -> Left errors+    Nothing ->+      Right+        ( source+            name+            kind+            (foldl (\rootValue (key, value) -> insertRawValue key value rootValue) (RawObject Map.empty) pairs)+        )+  where+    keys = fmap fst pairs+    duplicateErrors = fmap DuplicateSourceKey (duplicates keys)+    overlapErrors =+      [ OverlappingSourceKeys lower higher+      | (positionIndex, lower) <- zip [0 :: Int ..] keys,+        higher <- drop (positionIndex + 1) keys,+        lower /= higher,+        isPrefixKey lower higher || isPrefixKey higher lower+      ]+    constructionErrors = duplicateErrors <> overlapErrors+ -- | Attach adapter-specific descriptive metadata. It never changes precedence.+--+-- Repeated calls merge: annotations from a later call win when the same annotation+-- name is already present, and entries under other names are retained. Per-key+-- annotations from 'annotateSourceAt' still take precedence over source-wide entries. annotateSource :: Map Text Text -> Source -> Source-annotateSource annotations sourceValue = sourceValue & #annotations .~ annotations+annotateSource annotations sourceValue =+  sourceValue & #annotations %~ (annotations <>)  -- | Attach descriptive metadata for individual keys. --@@ -112,7 +166,11 @@  -- | Enumerate addressable leaves in key order for unknown-key diagnostics. ----- Arrays and scalars are whole leaves. Empty objects contain no leaves.+-- Arrays and scalars are whole leaves. Empty objects contain no leaves. Sources created+-- through the unvalidated 'source' escape hatch may contain leaves below empty or dotted+-- object keys; those leaves cannot form a 'Key' and are silently absent here. Prefer+-- 'sourceFromPairs' for hand-built sources and use 'sourceUnaddressableLeaves' to inspect+-- an existing source. sourceLeaves :: Source -> [(Key, Candidate)] sourceLeaves sourceValue = go [] (sourceValue ^. #root)   where@@ -126,6 +184,55 @@         Just segments -> case mkKey segments of           Left _ -> []           Right key -> [(key, candidate rawValue (originFor key sourceValue))]++-- | Return the raw segment paths of leaves that no 'Key' can address.+--+-- A non-empty result means the source was built by hand with object keys that are empty+-- or contain dots; such leaves are invisible to 'lookupSource', 'sourceLeaves', and+-- unknown-key diagnostics. Only key paths are returned; raw values are never exposed+-- because they may be secret. A scalar at the root has an empty path and is excluded.+sourceUnaddressableLeaves :: Source -> [[Text]]+sourceUnaddressableLeaves sourceValue = go [] (sourceValue ^. #root)+  where+    go prefix = \case+      RawObject object ->+        concatMap+          (\(segment, rawValue) -> go (prefix <> [segment]) rawValue)+          (Map.toAscList object)+      _ -> case NonEmpty.nonEmpty prefix of+        Nothing -> []+        Just segments -> case mkKey segments of+          Left _ -> [prefix]+          Right _ -> []++duplicates :: (Ord a) => [a] -> [a]+duplicates values =+  Map.keys (Map.filter (> (1 :: Int)) (Map.fromListWith (+) [(value, 1) | value <- values]))++isPrefixKey :: Key -> Key -> Bool+isPrefixKey prefix candidateKey =+  NonEmpty.toList (keySegments prefix)+    `isListPrefixOf` NonEmpty.toList (keySegments candidateKey)++isListPrefixOf :: (Eq a) => [a] -> [a] -> Bool+isListPrefixOf [] _ = True+isListPrefixOf _ [] = False+isListPrefixOf (left : leftRest) (right : rightRest) =+  left == right && isListPrefixOf leftRest rightRest++insertRawValue :: Key -> RawValue -> RawValue -> RawValue+insertRawValue key value = go (NonEmpty.toList (keySegments key))+  where+    go [] _ = value+    go (segment : rest) (RawObject object) =+      RawObject+        ( object+            & at segment+            %~ Just+            . go rest+            . maybe (RawObject Map.empty) id+        )+    go _ _ = error "validated source keys cannot overlap"  originFor :: Key -> Source -> Origin originFor key sourceValue =
src/Settei/Value.hs view
@@ -7,10 +7,15 @@     Decoder,     boolDecoder,     boundedIntegralDecoder,+    doubleDecoder,     enumDecoder,     decodeFailure,     decodeFailureExpected,     decoder,+    listDecoder,+    nonEmptyDecoder,+    parsedDecoder,+    rationalDecoder,     renderDecodeFailure,     runDecoder,     textDecoder,@@ -52,6 +57,16 @@   }   deriving stock (Generic) +-- | Mapping transforms only a successfully decoded result; failures pass+-- through unchanged.+--+-- The instance is lawful: 'fmap' merely post-composes over the 'Either'+-- result of the wrapped function, so identity and composition follow+-- directly from the 'Functor' laws of @'Either' 'DecodeFailure'@ and of+-- functions.+instance Functor Decoder where+  fmap f (Decoder run) = Decoder (\key raw -> fmap f (run key raw))+ -- | Construct a decoder whose failures carry only safe expectation metadata. decoder :: (Key -> RawValue -> Either DecodeFailure a) -> Decoder a decoder decode = Decoder {decode}@@ -84,17 +99,98 @@     _ -> failure key "boolean"   _ -> failure key "boolean" +-- | Decode an array by applying the element decoder to every element.+--+-- Elements are decoded left to right and the first failing element stops+-- decoding. An element failure keeps the owning setting key (arrays are+-- whole values at one key) and wraps the element's expectation as+-- @\"an array of \<expectation\>\"@; a non-array input fails with+-- @\"an array\"@. Failures carry only expectation text, never the+-- rejected raw value.+listDecoder :: Decoder a -> Decoder [a]+listDecoder elementDecoder = Decoder $ \key -> \case+  RawArray values ->+    traverse (runDecoder elementDecoder key) values+      & _Left+      . #expected+      %~ ("an array of " <>)+  _ -> failure key "an array"++-- | Decode a non-empty array with the element decoder.+--+-- An empty array -- and any non-array input -- fails with+-- @\"a non-empty array\"@; a failing element wraps its expectation as+-- @\"a non-empty array of \<expectation\>\"@.+nonEmptyDecoder :: Decoder a -> Decoder (NonEmpty a)+nonEmptyDecoder elementDecoder = Decoder $ \key -> \case+  RawArray (firstValue : rest) ->+    traverse (runDecoder elementDecoder key) (firstValue :| rest)+      & _Left+      . #expected+      %~ ("a non-empty array of " <>)+  _ -> failure key "a non-empty array"++-- | Decode a text scalar through a caller-supplied parser.+--+-- The first argument is the safe expectation description reported on any+-- failure, for example @\"an absolute URI\"@ or @\"a duration such as 30s\"@.+-- The parser's own error message is deliberately discarded: parser messages+-- routinely echo the offending input, and decode failures must never retain+-- the raw value. Non-text inputs fail with the same description.+parsedDecoder :: Text -> (Text -> Either Text a) -> Decoder a+parsedDecoder expected parse = Decoder $ \key -> \case+  RawText value -> case parse value of+    Right parsed -> Right parsed+    Left _ -> failure key expected+  _ -> failure key expected++-- | Decode an exact rational number.+--+-- Accepts a native number or, for environment-variable and command-line+-- friendliness, a textual number such as @\"2.5\"@, @\"-3\"@, or @\"1e-3\"@+-- (mirroring how 'boundedIntegralDecoder' accepts textual integers).+-- Decimal text converts exactly; no rounding occurs.+rationalDecoder :: Decoder Rational+rationalDecoder = Decoder $ \key value ->+  maybe (failure key "a number") Right (numberValue value)++-- | Decode an IEEE double-precision number.+--+-- Equivalent to @'fromRational' \<\$\> 'rationalDecoder'@: the exact source+-- value is rounded to the nearest representable 'Double'. That rounding is+-- acceptable for configuration values such as timeouts and ratios; use+-- 'rationalDecoder' or 'boundedIntegralDecoder' when exactness matters.+doubleDecoder :: Decoder Double+doubleDecoder = fromRational <$> rationalDecoder+ -- | Decode a whole number that fits the requested bounded integral type.+--+-- Accepts a native whole number or a textual integer. Failures state the+-- accepted range, for example @\"integer between -32768 and 32767\"@. boundedIntegralDecoder :: forall a. (Bounded a, Integral a) => Decoder a boundedIntegralDecoder = Decoder $ \key value ->   case integralValue value of     Just candidate-      | candidate >= toInteger (minBound @a)-          && candidate <= toInteger (maxBound @a) ->-          Right (fromInteger candidate)-    _ -> failure key "bounded integer"+      | candidate >= lower && candidate <= upper -> Right (fromInteger candidate)+    _ -> failure key expectedRange+  where+    lower = toInteger (minBound @a)+    upper = toInteger (maxBound @a)+    expectedRange =+      "integer between "+        <> Text.pack (show lower)+        <> " and "+        <> Text.pack (show upper)  -- | Decode one of a finite set of exact text spellings.+--+-- Matching is case-sensitive: @\"Production\"@ does not match a declared+-- @\"production\"@ choice. This is deliberate -- enumeration spellings are+-- part of an application's configuration vocabulary. Note the asymmetry+-- with 'boolDecoder', which case-folds its textual @true@/@false@ forms+-- for environment-variable convention; enumerations do not follow it.+-- Applications wanting case-insensitive enumerations can normalize input+-- via 'parsedDecoder'. enumDecoder :: [(Text, a)] -> Decoder a enumDecoder choices = Decoder $ \key -> \case   RawText value ->@@ -122,6 +218,15 @@   RawNumber value     | Ratio.denominator value == 1 -> Just (Ratio.numerator value)   RawText value -> case TextRead.signed TextRead.decimal value of+    Right (candidate, rest)+      | Text.null rest -> Just candidate+    _ -> Nothing+  _ -> Nothing++numberValue :: RawValue -> Maybe Rational+numberValue = \case+  RawNumber value -> Just value+  RawText value -> case TextRead.rational value of     Right (candidate, rest)       | Text.null rest -> Just candidate     _ -> Nothing
test/Settei/ConfigTest.hs view
@@ -4,12 +4,13 @@ import Data.Bifunctor (first) import Data.Map.Strict qualified as Map import Data.Set qualified as Set+import Data.Text qualified as Text import Settei import Settei.Internal.Config (Request (..), runConfig) import Settei.Prelude import Settei.Prototype.Free (freeNecessaryKeys, freePossibleKeys) import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (testCase, (@?=))+import Test.Tasty.HUnit (assertBool, testCase, (@?=))  tests :: TestTree tests =@@ -30,6 +31,23 @@             conditionDependencies condition @?= Set.singleton environmentKey             conditionSettings condition @?= Set.singleton passwordKey           conditions -> fail ("expected one condition, found " <> show (length conditions)),+      testCase "whenEq matches the raw selective schema" $ do+        let schema = describe sugaredProductionOnly+        schema @?= describe productionOnly+        assertProductionSchema schema,+      testCase "whenConfig preserves the conditional schema footprint" $+        assertProductionSchema (describe whenConfigProductionOnly),+      testCase "fallbackTo makes only the fallback key conditional" $ do+        let schema = describe endpointWithFallback+        keySet (schemaPossible schema)+          @?= Set.fromList [serviceEndpointKey, serviceUrlKey]+        keySet (schemaNecessary schema)+          @?= Set.singleton serviceEndpointKey+        case schemaConditions schema of+          [condition] -> do+            conditionDependencies condition @?= Set.singleton serviceEndpointKey+            conditionSettings condition @?= Set.singleton serviceUrlKey+          conditions -> fail ("expected one condition, found " <> show (length conditions)),       testCase "free-selective prototype agrees on possible effects" $         Set.fromList (freePossibleKeys environmentKey passwordKey)           @?= Set.fromList [environmentKey, passwordKey],@@ -41,7 +59,35 @@           @?= Right Nothing,       testCase "production requests its secret" $         runConfig (interpret productionValues) productionOnly+          @?= Left (Missing passwordKey),+      testCase "whenEq skips, requires, and returns its conditional value" $ do+        runConfig (interpret developmentValues) sugaredProductionOnly+          @?= Right Nothing+        runConfig (interpret productionValues) sugaredProductionOnly           @?= Left (Missing passwordKey)+        runConfig (interpret productionWithPasswordValues) sugaredProductionOnly+          @?= Right (Just "fleet-secret"),+      testCase "fallbackTo prefers the primary and otherwise evaluates the fallback" $ do+        runConfig (interpret primaryEndpointValues) endpointWithFallback+          @?= Right "new.example"+        runConfig (interpret fallbackEndpointValues) endpointWithFallback+          @?= Right "old.example"+        runConfig (interpret Map.empty) endpointWithFallback+          @?= Left (Missing serviceUrlKey),+      testCase "duplicate sensitivity is secret-biased in either applicative order" $ do+        schemaSettingSensitivity (schemaEntry passwordKey (describe secretThenPublic))+          @?= Secret+        schemaSettingSensitivity (schemaEntry passwordKey (describe publicThenSecret))+          @?= Secret+        let rendered = renderSchemaText (describe publicThenSecret)+        assertBool "schema did not mark the duplicate key secret" ("secret" `Text.isInfixOf` rendered)+        assertBool "schema marked the duplicate key public" (not ("public" `Text.isInfixOf` rendered)),+      testCase "duplicate sensitivity is secret-biased through a selective branch" $+        schemaSettingSensitivity (schemaEntry passwordKey (describe selectiveDuplicate))+          @?= Secret,+      testCase "duplicate sensitivity is secret-biased through a default dependency" $+        schemaSettingSensitivity (schemaEntry passwordKey (describe defaultDuplicate))+          @?= Secret     ]  data RuntimeError@@ -57,6 +103,45 @@         <$> required environmentSetting     productionBranch = (\password _ -> Just password) <$> required passwordSetting +sugaredProductionOnly :: Config (Maybe Text)+sugaredProductionOnly =+  whenEq (required environmentSetting) "production" (required passwordSetting)++whenConfigProductionOnly :: Config (Maybe Text)+whenConfigProductionOnly =+  whenConfig+    ((== "production") <$> required environmentSetting)+    (required passwordSetting)++endpointWithFallback :: Config Text+endpointWithFallback =+  optional endpointSetting `fallbackTo` required urlSetting++secretThenPublic :: Config (Text, Text)+secretThenPublic =+  (,) <$> required passwordSetting <*> required publicPasswordSetting++publicThenSecret :: Config (Text, Text)+publicThenSecret =+  (,) <$> required publicPasswordSetting <*> required passwordSetting++selectiveDuplicate :: Config Text+selectiveDuplicate =+  select+    (Left <$> required passwordSetting)+    (const <$> required publicPasswordSetting)++defaultDuplicate :: Config Text+defaultDuplicate =+  withDefault+    passwordSetting+    ( derivedDefault+        (RuleName "password-from-public-duplicate")+        "Exercise duplicate sensitivity in a default dependency"+        (required publicPasswordSetting)+        id+    )+ interpret :: Map Key RawValue -> Request a -> Either RuntimeError a interpret values = \case   RequiredRequest settingSpec ->@@ -74,6 +159,19 @@ productionValues :: Map Key RawValue productionValues = Map.singleton environmentKey (RawText "production") +productionWithPasswordValues :: Map Key RawValue+productionWithPasswordValues =+  Map.fromList+    [ (environmentKey, RawText "production"),+      (passwordKey, RawText "fleet-secret")+    ]++primaryEndpointValues :: Map Key RawValue+primaryEndpointValues = Map.singleton serviceEndpointKey (RawText "new.example")++fallbackEndpointValues :: Map Key RawValue+fallbackEndpointValues = Map.singleton serviceUrlKey (RawText "old.example")+ environmentSetting :: Setting Text environmentSetting =   publicSetting environmentKey "Runtime environment" textDecoder@@ -82,14 +180,50 @@ passwordSetting =   secretSetting passwordKey "Database password" textDecoder +publicPasswordSetting :: Setting Text+publicPasswordSetting =+  publicSetting passwordKey "Metrics password label" textDecoder++endpointSetting :: Setting Text+endpointSetting =+  publicSetting serviceEndpointKey "Service endpoint" textDecoder++urlSetting :: Setting Text+urlSetting =+  publicSetting serviceUrlKey "Legacy service URL" textDecoder+ environmentKey :: Key environmentKey = validKey "runtime.environment"  passwordKey :: Key passwordKey = validKey "database.password" +serviceEndpointKey :: Key+serviceEndpointKey = validKey "service.endpoint"++serviceUrlKey :: Key+serviceUrlKey = validKey "service.url"+ validKey :: Text -> Key validKey value = either (error . show) id (parseKey value)  keySet :: [SchemaSetting] -> Set Key keySet = Set.fromList . fmap schemaSettingKey++assertProductionSchema :: Schema -> IO ()+assertProductionSchema schema = do+  keySet (schemaPossible schema)+    @?= Set.fromList [environmentKey, passwordKey]+  keySet (schemaNecessary schema)+    @?= Set.singleton environmentKey+  case schemaConditions schema of+    [condition] -> do+      conditionDependencies condition @?= Set.singleton environmentKey+      conditionSettings condition @?= Set.singleton passwordKey+    conditions -> fail ("expected one condition, found " <> show (length conditions))++schemaEntry :: Key -> Schema -> SchemaSetting+schemaEntry key schema =+  case filter ((== key) . schemaSettingKey) (schemaPossible schema) of+    [entry] -> entry+    entries -> error ("expected one schema entry, found " <> show (length entries))
test/Settei/DefaultTest.hs view
@@ -16,16 +16,18 @@   testGroup     "Settei.Default"     [ testCase "constant default resolves without a source" $ do-        result <- expectSuccess (resolve defaultResolveOptions [] constantPort)-        result ^. #value @?= 8080+        let result = resolve defaultResolveOptions [] constantPort+        value <- expectAnswer result+        value @?= 8080         case result ^. #report . #nodes . at servicePort of           Just node -> do             fmap (^. #name) (node ^. #origin) @?= Just "built-in-port"             fmap (^. #rule) (node ^. #derivation) @?= Just "built-in-port"           Nothing -> fail "expected a derived port node",       testCase "production port records its environment dependency" $ do-        result <- expectSuccess (resolve defaultResolveOptions [environmentSource Production] casePort)-        result ^. #value @?= 443+        let result = resolve defaultResolveOptions [environmentSource Production] casePort+        value <- expectAnswer result+        value @?= 443         case result ^. #report . #nodes . at servicePort of           Just node -> case node ^. #derivation of             Just derivation -> do@@ -37,8 +39,9 @@             Nothing -> fail "expected default derivation metadata"           Nothing -> fail "expected the port report node",       testCase "an explicit target overrides and skips its default dependencies" $ do-        result <- expectSuccess (resolve defaultResolveOptions [portSource 9443] casePort)-        result ^. #value @?= 9443+        let result = resolve defaultResolveOptions [portSource 9443] casePort+        value <- expectAnswer result+        value @?= 9443         case result ^. #report . #nodes . at runtimeEnvironment of           Just node -> node ^. #outcome @?= NotSelected           Nothing -> fail "expected the skipped dependency in the report"@@ -46,7 +49,7 @@           Just node -> node ^. #derivation @?= Nothing           Nothing -> fail "expected the explicit port node",       testCase "an unmatched case without fallback is structured" $ do-        case resolve defaultResolveOptions [environmentSource Staging] casePort of+        case (resolve defaultResolveOptions [environmentSource Staging] casePort) ^. #answer of           Left errors -> case NonEmpty.toList errors of             [DefaultError problem] -> do               problem ^. #key @?= servicePort@@ -64,8 +67,9 @@                     ((Development, 8080) :| [])                     (Just 9000)                 )-        result <- expectSuccess (resolve defaultResolveOptions [environmentSource Staging] withFallback)-        result ^. #value @?= 9000,+        let result = resolve defaultResolveOptions [environmentSource Staging] withFallback+        value <- expectAnswer result+        value @?= 9000,       testCase "default dependencies remain conditional in the static schema" $ do         let schema = describe casePort             necessaryKeys = fmap schemaSettingKey (schemaNecessary schema)@@ -74,13 +78,19 @@           [portSchema] -> schemaSettingRequirement portSchema @?= Optional           _ -> fail "expected one port schema entry",       testCase "cyclic defaults fail before source evaluation" $ do-        case resolve defaultResolveOptions [poisonSource] cyclicA of+        let result = resolve defaultResolveOptions [poisonSource] cyclicA+        case result ^. #answer of           Left errors -> case NonEmpty.toList errors of             [DefaultCycle problem] ->               NonEmpty.toList (problem ^. #rules)                 @?= [RuleName "cycle-a", RuleName "cycle-b", RuleName "cycle-a"]             _ -> fail "expected one default cycle"           Right _ -> fail "expected cyclic defaults to fail"+        fmap (^. #key) (reportNodes (result ^. #report)) @?= [cycleAKey, cycleBKey]+        fmap (^. #outcome) (reportNodes (result ^. #report))+          @?= [NotSelected, NotSelected]+        result ^. #report . #branches @?= []+        result ^. #warnings @?= []     ]  data Environment = Development | Test | Staging | Production@@ -189,9 +199,9 @@ environmentText Staging = "staging" environmentText Production = "production" -expectSuccess :: Either (NonEmpty ConfigError) a -> IO a-expectSuccess = \case-  Left _ -> fail "expected successful resolution"+expectAnswer :: ResolveResult a -> IO a+expectAnswer result = case result ^. #answer of+  Left errors -> fail ("expected successful resolution: " <> show errors)   Right value -> pure value  servicePort :: Key
test/Settei/RenderTest.hs view
@@ -2,8 +2,11 @@  module Settei.RenderTest (tests) where +import Control.Selective (select) 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.Text qualified as Text import Data.Text.IO qualified as TextIO import Settei@@ -23,12 +26,23 @@         assertGolden "test/golden/resolution.txt" (renderResolutionText snapshotReport),       testCase "resolution JSON matches its versioned golden snapshot" $         assertGolden "test/golden/resolution.json" (renderResolutionJson snapshotReport),+      testCase "failure resolution text matches its golden snapshot" $ do+        _ <- expectFailure failureResolutionResult+        assertGolden+          "test/golden/failure-resolution.txt"+          (renderResolutionText (failureResolutionResult ^. #report)),+      testCase "failure resolution JSON matches its versioned golden snapshot" $ do+        _ <- expectFailure failureResolutionResult+        assertGolden+          "test/golden/failure-resolution.json"+          (renderResolutionJson (failureResolutionResult ^. #report)),       testCase "error renderers match their golden snapshots" $ do         errors <- expectFailure (resolve defaultResolveOptions [secretSource] (required secretBoolSetting))         assertGolden "test/golden/errors.txt" (renderErrorsText errors)         assertGolden "test/golden/errors.json" (renderErrorsJson errors),       testCase "warning renderers match their golden snapshots" $ do-        result <- expectSuccess (resolve defaultResolveOptions [unknownSecretSource] (pure ()))+        let result = resolve defaultResolveOptions [unknownSecretSource] (pure ())+        _ <- expectAnswer result         assertGolden "test/golden/warnings.txt" (renderWarningsText (result ^. #warnings))         assertGolden "test/golden/warnings.json" (renderWarningsJson (result ^. #warnings)),       testCase "renderers distinguish missing from not selected" $ do@@ -38,9 +52,119 @@         assertBool "text omitted the not-selected outcome" ("<not selected>" `Text.isInfixOf` textOutput)         assertBool "JSON omitted the missing outcome" ("\"outcome\":\"missing\"" `Text.isInfixOf` jsonOutput)         assertBool "JSON omitted the not-selected outcome" ("\"outcome\":\"not-selected\"" `Text.isInfixOf` jsonOutput),-      testCase "every supported output redacts marked secrets" redactionTest+      testCase "terminating rationals render as exact decimals" $ do+        renderNumber (1 Ratio.% 2) @?= "0.5"+        renderNumber ((-3) Ratio.% 8) @?= "-0.375"+        renderNumber (1 Ratio.% 1000) @?= "0.001"+        renderNumber (25 Ratio.% 2) @?= "12.5",+      testCase "non-terminating rationals retain exact fractions" $ do+        renderNumber (1 Ratio.% 3) @?= "1/3"+        renderNumber (7 Ratio.% 12) @?= "7/12",+      testCase "arrays use decimal and fraction rendering recursively" $+        renderReportedValue+          ( reportedValue+              Public+              (RawArray [RawNumber (1 Ratio.% 2), RawNumber (1 Ratio.% 3)])+          )+          @?= "[0.5, 1/3]",+      testCase "sensitivity conflicts render as structured errors" $ do+        let errors = SensitivityConflict (SensitivityConflictProblem {key = databasePassword}) :| []+        assertBool+          "text omitted the conflict explanation"+          ("database.password: declared with both public and secret sensitivity" `Text.isInfixOf` renderErrorsText errors)+        assertBool+          "JSON omitted the sensitivity-conflict kind"+          ("\"kind\":\"sensitivity-conflict\"" `Text.isInfixOf` renderErrorsJson errors),+      kubernetesRendererTests,+      testCase "every supported output redacts marked secrets" redactionTest,+      testCase "mixed-sensitivity declarations never expose their secret sentinel" $+        sensitivityConflictRedactionTest     ] +kubernetesRendererTests :: TestTree+kubernetesRendererTests =+  testGroup+    "Kubernetes provenance"+    [ testCase "text appends only the file modification time" $ do+        let output = renderResolutionText (kubernetesReport freshKubernetesOrigin)+        output+          @?= Text.unlines+            [ "service.host = \"api.internal\"",+              "  from kubernetes-mounted-directory source service-config from Kubernetes ConfigMap payments/service-config key host (modified 2026-07-19T15:20:08Z)"+            ]+        assertBool+          "text rendered the mount-path annotation"+          (not ("/etc/app-config" `Text.isInfixOf` output))+        assertBool+          "text rendered the read-at annotation"+          (not ("2026-07-19T15:21:00Z" `Text.isInfixOf` output)),+      testCase "text without file-modified retains the old suffix exactly" $ do+        let originWithoutModified =+              freshKubernetesOrigin+                & #annotations+                %~ Map.delete "kubernetes.file-modified"+            output = renderResolutionText (kubernetesReport originWithoutModified)+        output+          @?= Text.unlines+            [ "service.host = \"api.internal\"",+              "  from kubernetes-mounted-directory source service-config from Kubernetes ConfigMap payments/service-config key host"+            ]+        assertBool "text unexpectedly added a modification suffix" (not ("(modified" `Text.isInfixOf` output)),+      testCase "JSON retains every Kubernetes annotation" $ do+        let output = renderResolutionJson (kubernetesReport freshKubernetesOrigin)+            expectedEntries =+              [ "\"kubernetes.file-modified\":\"2026-07-19T15:20:08Z\"",+                "\"kubernetes.mount-path\":\"/etc/app-config\"",+                "\"kubernetes.namespace\":\"payments\"",+                "\"kubernetes.object-key\":\"host\"",+                "\"kubernetes.object-kind\":\"ConfigMap\"",+                "\"kubernetes.object-name\":\"service-config\"",+                "\"kubernetes.read-at\":\"2026-07-19T15:21:00Z\""+              ]+        assertBool+          "JSON omitted a Kubernetes annotation"+          (all (`Text.isInfixOf` output) expectedEntries)+    ]++kubernetesReport :: Origin -> ResolutionReport+kubernetesReport origin =+  ResolutionReport+    { nodes =+        Map.singleton+          serviceHost+          ResolutionNode+            { key = serviceHost,+              sensitivity = Public,+              outcome = Resolved (reportedValue Public (RawText "api.internal")),+              origin = Just origin,+              shadowed = [],+              derivation = Nothing+            },+      branches = []+    }++freshKubernetesOrigin :: Origin+freshKubernetesOrigin =+  Origin+    { kind = CustomSource "kubernetes-mounted-directory",+      name = "service-config",+      key = serviceHost,+      location = Nothing,+      annotations =+        Map.fromList+          [ ("kubernetes.object-kind", "ConfigMap"),+            ("kubernetes.namespace", "payments"),+            ("kubernetes.object-name", "service-config"),+            ("kubernetes.object-key", "host"),+            ("kubernetes.mount-path", "/etc/app-config"),+            ("kubernetes.file-modified", "2026-07-19T15:20:08Z"),+            ("kubernetes.read-at", "2026-07-19T15:21:00Z")+          ]+    }++renderNumber :: Rational -> Text+renderNumber = renderReportedValue . reportedValue Public . RawNumber+ assertGolden :: FilePath -> Text -> IO () assertGolden path actual = do   expected <- Text.stripEnd <$> TextIO.readFile path@@ -48,16 +172,22 @@  redactionTest :: IO () redactionTest = do-  success <- expectSuccess (resolve defaultResolveOptions [secretSource] (required secretTextSetting))-  errors <- expectFailure (resolve defaultResolveOptions [secretSource] (required secretBoolSetting))-  warningResult <- expectSuccess (resolve defaultResolveOptions [unknownSecretSource] (pure ()))+  let success = resolve defaultResolveOptions [secretSource] (required secretTextSetting)+      failure = resolve defaultResolveOptions [secretSource] (required secretBoolSetting)+      warningResult = resolve defaultResolveOptions [unknownSecretSource] (pure ())+  _ <- expectAnswer success+  errors <- expectFailure failure+  _ <- expectAnswer warningResult   let report = success ^. #report+      failureReport = failure ^. #report       warnings = warningResult ^. #warnings       outputs =         [ renderSchemaText (describe (required secretTextSetting)),           renderSchemaJson (describe (required secretTextSetting)),           renderResolutionText report,           renderResolutionJson report,+          renderResolutionText failureReport,+          renderResolutionJson failureReport,           renderErrorsText errors,           renderErrorsJson errors,           renderWarningsText warnings,@@ -71,14 +201,59 @@     (all (not . Text.isInfixOf secretSentinel) outputs)   assertBool "decode error did not show a redaction marker" $     "<redacted>" `Text.isInfixOf` renderErrorsText errors+  assertBool "failure report did not show a redaction marker" $+    "<redacted>" `Text.isInfixOf` renderResolutionText failureReport -expectSuccess :: Either (NonEmpty ConfigError) a -> IO a-expectSuccess = \case-  Left _ -> fail "expected successful resolution"+sensitivityConflictRedactionTest :: IO ()+sensitivityConflictRedactionTest = do+  let conflictResult = resolve defaultResolveOptions [conflictSource] conflictingConfig+  case conflictResult ^. #answer of+    Right _ -> fail "mixed-sensitivity declaration should fail"+    Left errors -> do+      assertBool+        "resolution omitted the sensitivity conflict"+        ( any+            ( \case+                SensitivityConflict problem -> problem ^. #key == databasePassword+                _ -> False+            )+            (NonEmpty.toList errors)+        )+      let secretOnly = resolve defaultResolveOptions [conflictSource] (required secretTextSetting)+      _ <- expectAnswer secretOnly+      let schema = describe conflictingConfig+          report = secretOnly ^. #report+          conflictReport = conflictResult ^. #report+          outputs =+            [ renderSchemaText schema,+              renderSchemaJson schema,+              renderErrorsText errors,+              renderErrorsJson errors,+              renderResolutionText report,+              renderResolutionJson report,+              renderResolutionText conflictReport,+              renderResolutionJson conflictReport,+              Text.pack (show schema),+              Text.pack (show errors),+              Text.pack (show report)+            ]+      assertBool+        "the conflict sentinel reached a schema, error, resolution, or Show output"+        (all (not . Text.isInfixOf conflictSentinel) outputs)+      assertBool+        "the conflicted schema key was not marked secret"+        ("database.password [required, necessary, secret]" `Text.isInfixOf` renderSchemaText schema)+  where+    conflictingConfig =+      (,) <$> required secretTextSetting <*> required publicConflictSetting++expectAnswer :: ResolveResult a -> IO a+expectAnswer result = case result ^. #answer of+  Left errors -> fail ("expected successful resolution: " <> show errors)   Right value -> pure value -expectFailure :: Either (NonEmpty ConfigError) a -> IO (NonEmpty ConfigError)-expectFailure = \case+expectFailure :: ResolveResult a -> IO (NonEmpty ConfigError)+expectFailure result = case result ^. #answer of   Left errors -> pure errors   Right _ -> fail "expected resolution to fail" @@ -171,6 +346,48 @@         ]     } +failureResolutionResult :: ResolveResult (Text, Int, Maybe Text)+failureResolutionResult =+  resolve defaultResolveOptions failureSources failureResolutionConfig++failureResolutionConfig :: Config (Text, Int, Maybe Text)+failureResolutionConfig =+  (,,)+    <$> required hostSetting+    <*> required portSetting+    <*> productionPassword++productionPassword :: Config (Maybe Text)+productionPassword = select selector branch+  where+    selector =+      (\environment -> if environment == "production" then Left () else Right Nothing)+        <$> required environmentSetting+    branch = (\password _ -> Just password) <$> required passwordSetting++failureSources :: [Source]+failureSources =+  [ source+      "built-in"+      BuiltInSource+      ( RawObject+          ( Map.fromList+              [ ("runtime", RawObject (Map.singleton "environment" (RawText "development"))),+                ("service", RawObject (Map.singleton "port" (RawNumber 8080)))+              ]+          )+      ),+    source+      "command-line"+      CommandLineSource+      ( RawObject+          ( Map.singleton+              "service"+              (RawObject (Map.singleton "port" (RawText "not-a-port")))+          )+      )+  ]+ environmentOrigin :: Key -> Text -> Origin environmentOrigin key variable =   Origin@@ -204,12 +421,24 @@ passwordSetting :: Setting Text passwordSetting = secretSetting databasePassword "Database password" textDecoder +hostSetting :: Setting Text+hostSetting = publicSetting serviceHost "Service host" textDecoder++portSetting :: Setting Int+portSetting = publicSetting servicePort "Service port" boundedIntegralDecoder++environmentSetting :: Setting Text+environmentSetting = publicSetting runtimeEnvironment "Runtime environment" textDecoder+ secretTextSetting :: Setting Text secretTextSetting = secretSetting databasePassword "Database password" textDecoder  secretBoolSetting :: Setting Bool secretBoolSetting = secretSetting databasePassword "Database password" boolDecoder +publicConflictSetting :: Setting Text+publicConflictSetting = publicSetting databasePassword "Metrics password label" textDecoder+ secretSource :: Source secretSource =   source@@ -222,6 +451,18 @@         )     ) +conflictSource :: Source+conflictSource =+  source+    "conflict-sentinel"+    (CustomSource "test")+    ( RawObject+        ( Map.singleton+            "database"+            (RawObject (Map.singleton "password" (RawText conflictSentinel)))+        )+    )+ unknownSecretSource :: Source unknownSecretSource =   source@@ -232,8 +473,14 @@ secretSentinel :: Text secretSentinel = "S3cr3t-\"\\\n-[]{}-雪" +conflictSentinel :: Text+conflictSentinel = "CONFLICT-S3cr3t-\"\\\n-[]{}-雪"+ databasePassword :: Key databasePassword = validKey "database.password"++serviceHost :: Key+serviceHost = validKey "service.host"  runtimeEnvironment :: Key runtimeEnvironment = validKey "runtime.environment"
test/Settei/ResolveTest.hs view
@@ -7,7 +7,9 @@ import Data.List (permutations) import Data.List.NonEmpty qualified as NonEmpty import Data.Map.Strict qualified as Map+import Data.Text qualified as Text import Settei+import Settei.Internal.Schema (mergeSensitivity) import Settei.Prelude import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase, (@?=))@@ -17,8 +19,9 @@   testGroup     "Settei.Resolve"     [ testCase "rightmost source wins per leaf" $ do-        result <- expectSuccess (resolve defaultResolveOptions layeredSources serviceConfig)-        result ^. #value @?= ("file.example", 443)+        let result = resolve defaultResolveOptions layeredSources serviceConfig+        value <- expectAnswer result+        value @?= ("file.example", 443)         let nodes = result ^. #report . #nodes         case nodes ^. at serviceHost of           Just node -> do@@ -31,10 +34,12 @@             fmap (^. #name) (node ^. #shadowed) @?= ["built-in"]           Nothing -> fail "expected port report node",       testCase "reversing source order predictably reverses precedence" $ do-        result <- expectSuccess (resolve defaultResolveOptions (reverse layeredSources) serviceConfig)-        result ^. #value @?= ("built-in.example", 8080),+        let result = resolve defaultResolveOptions (reverse layeredSources) serviceConfig+        value <- expectAnswer result+        value @?= ("built-in.example", 8080),       testCase "shadowed origins are ordered from highest to lowest precedence" $ do-        result <- expectSuccess (resolve defaultResolveOptions (fmap snd lawSources) (required portSetting))+        let result = resolve defaultResolveOptions (fmap snd lawSources) (required portSetting)+        _ <- expectAnswer result         case result ^. #report . #nodes . at servicePort of           Just node -> fmap (^. #name) (node ^. #shadowed) @?= ["two", "one"]           Nothing -> fail "expected the port resolution node",@@ -43,7 +48,7 @@       testCase "malformed winner does not fall back" $ do         let lower = treeSource "lower" (RawNumber 8080) Map.empty             higher = treeSource "higher" (RawText "not-a-port") Map.empty-        case resolve defaultResolveOptions [lower, higher] (required portSetting) of+        case (resolve defaultResolveOptions [lower, higher] (required portSetting)) ^. #answer of           Left errors -> case NonEmpty.toList errors of             [DecodeError problem] -> do               problem ^. #key @?= servicePort@@ -53,8 +58,9 @@       testCase "arrays replace rather than concatenate" $ do         let lower = arraySource "lower" ["one", "two"]             higher = arraySource "higher" ["three"]-        result <- expectSuccess (resolve defaultResolveOptions [lower, higher] (required hostsSetting))-        result ^. #value @?= ["three"],+        let result = resolve defaultResolveOptions [lower, higher] (required hostsSetting)+        value <- expectAnswer result+        value @?= ["three"],       testCase "unknown keys warn by default and can be promoted" $ do         let values =               RawObject@@ -65,27 +71,29 @@                 )             input = source "document" (FileSource "memory") values             declaration = required knownSetting-        result <- expectSuccess (resolve defaultResolveOptions [input] declaration)+        let result = resolve defaultResolveOptions [input] declaration+        _ <- expectAnswer result         length (result ^. #warnings) @?= 1         case result ^. #warnings of           [UnknownKeyWarning problem] -> problem ^. #key @?= typoKey           _ -> fail "expected one unknown-key warning"         let strictOptions = ResolveOptions {unknownKeyPolicy = RejectUnknownKeys}-        case resolve strictOptions [input] declaration of+        case (resolve strictOptions [input] declaration) ^. #answer of           Left errors -> case NonEmpty.toList errors of             [UnknownKeyError problem] -> problem ^. #key @?= typoKey             _ -> fail "expected one strict unknown-key error"           Right _ -> fail "strict mode should reject the unknown key",       testCase "independent applicative errors accumulate in declaration order" $ do-        case resolve defaultResolveOptions [] serviceConfig of+        case (resolve defaultResolveOptions [] serviceConfig) ^. #answer of           Left errors ->             fmap errorKey (NonEmpty.toList errors)               @?= [serviceHost, servicePort]           Right _ -> fail "expected both required settings to be missing",       testCase "unselected selective branch is traced without errors" $ do         let development = environmentSource "development"-        result <- expectSuccess (resolve defaultResolveOptions [development] productionPassword)-        result ^. #value @?= Nothing+        let result = resolve defaultResolveOptions [development] productionPassword+        value <- expectAnswer result+        value @?= Nothing         case result ^. #report . #nodes . at databasePassword of           Just node -> node ^. #outcome @?= NotSelected           Nothing -> fail "expected a not-selected password node"@@ -93,9 +101,132 @@           [branch] -> branch ^. #selected @?= False           _ -> fail "expected one selective branch trace",       testCase "selected selective branch reports its missing requirement" $ do-        case resolve defaultResolveOptions [environmentSource "production"] productionPassword of+        case (resolve defaultResolveOptions [environmentSource "production"] productionPassword) ^. #answer of           Left errors -> fmap errorKey (NonEmpty.toList errors) @?= [databasePassword]           Right _ -> fail "production should require a password",+      testCase "whenEq reports an unselected branch in development" $ do+        let result =+              resolve defaultResolveOptions [environmentSource "development"] sugaredProductionPassword+        value <- expectAnswer result+        value @?= Nothing+        case result ^. #report . #nodes . at databasePassword of+          Just node -> node ^. #outcome @?= NotSelected+          Nothing -> fail "expected a not-selected password node"+        case result ^. #report . #branches of+          [branch] -> do+            branch ^. #dependencies @?= [runtimeEnvironment]+            branch ^. #settings @?= [databasePassword]+            branch ^. #selected @?= False+          _ -> fail "expected one selective branch trace",+      testCase "whenEq reports a selected missing branch in production" $ do+        let result =+              resolve defaultResolveOptions [environmentSource "production"] sugaredProductionPassword+        case result ^. #answer of+          Left errors -> fmap errorKey (NonEmpty.toList errors) @?= [databasePassword]+          Right _ -> fail "production should require a password"+        case result ^. #report . #nodes . at databasePassword of+          Just node -> node ^. #outcome @?= MissingValue+          Nothing -> fail "expected a missing password node"+        case result ^. #report . #branches of+          [branch] -> do+            branch ^. #dependencies @?= [runtimeEnvironment]+            branch ^. #settings @?= [databasePassword]+            branch ^. #selected @?= True+          _ -> fail "expected one selective branch trace",+      testCase "fallbackTo suppresses the legacy key when the primary is present" $ do+        let result =+              resolve+                defaultResolveOptions+                [serviceTextSource "primary" "endpoint" "new.example"]+                endpointWithFallback+        value <- expectAnswer result+        value @?= "new.example"+        case result ^. #report . #nodes . at serviceUrl of+          Just node -> node ^. #outcome @?= NotSelected+          Nothing -> fail "expected a not-selected legacy URL node"+        case result ^. #report . #branches of+          [branch] -> do+            branch ^. #dependencies @?= [serviceEndpoint]+            branch ^. #settings @?= [serviceUrl]+            branch ^. #selected @?= False+          _ -> fail "expected one fallback branch trace",+      testCase "fallbackTo evaluates the legacy key when the primary is absent" $ do+        let result =+              resolve+                defaultResolveOptions+                [serviceTextSource "legacy" "url" "old.example"]+                endpointWithFallback+        value <- expectAnswer result+        value @?= "old.example"+        case result ^. #report . #branches of+          [branch] -> do+            branch ^. #dependencies @?= [serviceEndpoint]+            branch ^. #settings @?= [serviceUrl]+            branch ^. #selected @?= True+          _ -> fail "expected one fallback branch trace",+      testCase "publicShowSetting renders a typed default" $+        expectDefaultDisplay+          "8080"+          (publicShowSetting servicePort "Service port" boundedIntegralDecoder),+      testCase "a rendererless public setting keeps the derived marker" $+        expectDefaultDisplay+          "<derived>"+          (publicSetting servicePort "Service port" boundedIntegralDecoder),+      testCase "withRenderer displays a public typed default" $+        expectDefaultDisplay+          "8080"+          ( withRenderer+              (Text.pack . show)+              (publicSetting servicePort "Service port" boundedIntegralDecoder)+          ),+      testCase "withRenderer cannot expose a secret typed default" $+        expectDefaultDisplay+          "<redacted>"+          ( withRenderer+              (Text.pack . show)+              (secretSetting servicePort "Service port" boundedIntegralDecoder)+          ),+      testCase "failure report retains evaluated provenance" $ do+        let input = treeSource "only-port" (RawNumber 8080) Map.empty+            result = resolve defaultResolveOptions [input] serviceConfig+        case result ^. #answer of+          Left errors -> fmap errorKey (NonEmpty.toList errors) @?= [serviceHost]+          Right _ -> fail "expected the missing host to fail"+        case result ^. #report . #nodes . at servicePort of+          Just node -> do+            node ^. #outcome @?= Resolved (reportedValue Public (RawNumber 8080))+            fmap (^. #name) (node ^. #origin) @?= Just "only-port"+          Nothing -> fail "expected the evaluated port node"+        case result ^. #report . #nodes . at serviceHost of+          Just node -> node ^. #outcome @?= MissingValue+          Nothing -> fail "expected the missing host node",+      testCase "decode failure keeps the rejected candidate's provenance" $ do+        let lower = treeSource "lower" (RawNumber 8080) Map.empty+            higher = treeSource "higher" (RawText "not-a-port") Map.empty+            result = resolve defaultResolveOptions [lower, higher] (required portSetting)+        case result ^. #answer of+          Left errors -> case NonEmpty.toList errors of+            [DecodeError problem] -> problem ^. #origin . #name @?= "higher"+            _ -> fail "expected one decode error"+          Right _ -> fail "expected the malformed winner to fail"+        case result ^. #report . #nodes . at servicePort of+          Just node -> do+            node ^. #outcome @?= Resolved (reportedValue Public (RawText "not-a-port"))+            fmap (^. #name) (node ^. #origin) @?= Just "higher"+            fmap (^. #name) (node ^. #shadowed) @?= ["lower"]+          Nothing -> fail "expected the rejected winner's report node",+      testCase "failure report completes not-selected settings" $ do+        let declaration = (,) <$> productionPassword <*> required knownSetting+            result = resolve defaultResolveOptions [environmentSource "development"] declaration+        case result ^. #answer of+          Left errors -> fmap errorKey (NonEmpty.toList errors) @?= [knownKey]+          Right _ -> fail "expected the unrelated required setting to fail"+        case result ^. #report . #nodes . at databasePassword of+          Just node -> node ^. #outcome @?= NotSelected+          Nothing -> fail "expected the unselected password node"+        case result ^. #report . #branches of+          [branch] -> branch ^. #selected @?= False+          _ -> fail "expected one unselected branch trace",       testCase "structural conflicts are rejected even under an unselected branch" $ do         let development = environmentSource "development"             conflicting =@@ -103,20 +234,117 @@                 "conflicting"                 (FileSource "memory")                 (RawObject (Map.singleton "database" (RawText "not-an-object")))-        case resolve defaultResolveOptions [development, conflicting] productionPassword of+        case (resolve defaultResolveOptions [development, conflicting] productionPassword) ^. #answer of           Left errors -> case NonEmpty.toList errors of             [StructuralConflict structuralError] ->               structuralError ^. #key @?= databasePassword             _ -> fail "expected one structural conflict"+          Right _ -> fail "source shape validation should fail",+      testCase "structural exit still reports schema and warnings" $ do+        let malformed =+              source+                "malformed"+                (FileSource "memory")+                ( RawObject+                    ( Map.fromList+                        [ ("database", RawText "not-an-object"),+                          ("typo", RawText "unused")+                        ]+                    )+                )+            result =+              resolve+                defaultResolveOptions+                [environmentSource "development", malformed]+                productionPassword+        case result ^. #answer of+          Left errors -> case NonEmpty.toList errors of+            [StructuralConflict structuralError] ->+              structuralError ^. #key @?= databasePassword+            _ -> fail "expected one structural conflict"           Right _ -> fail "source shape validation should fail"+        fmap (^. #key) (reportNodes (result ^. #report))+          @?= [databasePassword, runtimeEnvironment]+        fmap (^. #outcome) (reportNodes (result ^. #report))+          @?= [NotSelected, NotSelected]+        fmap (^. #origin) (reportNodes (result ^. #report)) @?= [Nothing, Nothing]+        result ^. #report . #branches @?= []+        any+          ( \case+              UnknownKeyWarning problem -> problem ^. #key == typoKey+          )+          (result ^. #warnings)+          @?= True,+      testCase "warnings accompany failures and strict mode promotes them" $ do+        let input =+              source+                "document"+                (FileSource "memory")+                (RawObject (Map.singleton "typo" (RawText "unused")))+            warned = resolve defaultResolveOptions [input] (required knownSetting)+        case warned ^. #answer of+          Left errors -> fmap errorKey (NonEmpty.toList errors) @?= [knownKey]+          Right _ -> fail "expected the missing known setting to fail"+        case warned ^. #warnings of+          [UnknownKeyWarning problem] -> problem ^. #key @?= typoKey+          _ -> fail "expected one warning alongside the failure"+        let strictOptions = ResolveOptions {unknownKeyPolicy = RejectUnknownKeys}+            rejected = resolve strictOptions [input] (required knownSetting)+        case rejected ^. #answer of+          Left errors -> fmap errorKey (NonEmpty.toList errors) @?= [knownKey, typoKey]+          Right _ -> fail "strict mode should reject the unknown key"+        rejected ^. #warnings @?= [],+      testCase "conflicting sensitivity declarations fail with a structured error" $ do+        assertSensitivityConflict secretThenPublic+        assertSensitivityConflict publicThenSecret,+      testCase "sensitivity conflicts include unselected selective branches" $+        assertSensitivityConflict selectiveSensitivityConflict,+      testCase "sensitivity conflicts include default dependencies" $+        assertSensitivityConflict defaultSensitivityConflict,+      testCase "effective sensitivity is secret-dominant at the schema seam" $ do+        mergeSensitivity Public Public @?= Public+        mergeSensitivity Public Secret @?= Secret+        mergeSensitivity Secret Public @?= Secret+        mergeSensitivity Secret Secret @?= Secret+        schemaSettingSensitivity (schemaEntry databasePassword (describe secretThenPublic))+          @?= Secret+        schemaSettingSensitivity (schemaEntry databasePassword (describe publicThenSecret))+          @?= Secret,+      testCase "redactReportedValue collapses every retained representation" $+        mapM_+          (\value -> renderReportedValue (redactReportedValue value) @?= "<redacted>")+          [ visibleReportedValue "x",+            derivedReportedValue Public,+            reportedValue Secret (RawText "x")+          ]     ] +assertSensitivityConflict :: Config a -> IO ()+assertSensitivityConflict declaration = do+  let result = resolve defaultResolveOptions [passwordSource] declaration+  case result ^. #answer of+    Left errors -> case NonEmpty.toList errors of+      [SensitivityConflict problem] -> problem ^. #key @?= databasePassword+      _ -> fail "expected one sensitivity conflict"+    Right _ -> fail "mixed-sensitivity declaration should fail"+  case result ^. #report . #nodes . at databasePassword of+    Just node -> do+      node ^. #sensitivity @?= Secret+      node ^. #outcome @?= NotSelected+      node ^. #origin @?= Nothing+    Nothing -> fail "expected a schema-only conflict report node"++schemaEntry :: Key -> Schema -> SchemaSetting+schemaEntry key schema =+  case filter ((== key) . schemaSettingKey) (schemaPossible schema) of+    [entry] -> entry+    entries -> error ("expected one schema entry, found " <> show (length entries))+ checkOrdering :: [(Int, Source)] -> IO () checkOrdering orderedSources = do-  result <--    expectSuccess-      (resolve defaultResolveOptions (fmap snd orderedSources) (required portSetting))-  result ^. #value @?= fst (last orderedSources)+  let result = resolve defaultResolveOptions (fmap snd orderedSources) (required portSetting)+  value <- expectAnswer result+  value @?= fst (last orderedSources)  lawSources :: [(Int, Source)] lawSources =@@ -125,11 +353,26 @@     (3003, treeSource "three" (RawNumber 3003) Map.empty)   ] -expectSuccess :: Either (NonEmpty ConfigError) a -> IO a-expectSuccess = \case-  Left _ -> fail "expected successful resolution"+expectAnswer :: ResolveResult a -> IO a+expectAnswer result = case result ^. #answer of+  Left errors -> fail ("expected successful resolution: " <> show errors)   Right value -> pure value +expectDefaultDisplay :: Text -> Setting Int -> IO ()+expectDefaultDisplay expected settingSpec = do+  let declaration =+        withDefault+          settingSpec+          (constantDefault (RuleName "built-in-port") "Built-in service port" 8080)+      result = resolve defaultResolveOptions [] declaration+  value <- expectAnswer result+  value @?= 8080+  case result ^. #report . #nodes . at servicePort of+    Just node -> case node ^. #outcome of+      Resolved reported -> renderReportedValue reported @?= expected+      _ -> fail "expected a resolved default value"+    Nothing -> fail "expected a derived service port node"+ errorKey :: ConfigError -> Key errorKey = \case   MissingRequired problem -> problem ^. #key@@ -138,6 +381,7 @@   UnknownKeyError problem -> problem ^. #key   DefaultError problem -> problem ^. #key   DefaultCycle _ -> error "a cycle has no single setting key"+  SensitivityConflict problem -> problem ^. #key  serviceConfig :: Config (Text, Int) serviceConfig = (,) <$> required hostSetting <*> required portSetting@@ -150,6 +394,39 @@         <$> required environmentSetting     branch = (\password _ -> Just password) <$> required passwordSetting +sugaredProductionPassword :: Config (Maybe Text)+sugaredProductionPassword =+  whenEq (required environmentSetting) "production" (required passwordSetting)++endpointWithFallback :: Config Text+endpointWithFallback =+  optional endpointSetting `fallbackTo` required urlSetting++secretThenPublic :: Config (Text, Text)+secretThenPublic =+  (,) <$> required passwordSetting <*> required publicPasswordSetting++publicThenSecret :: Config (Text, Text)+publicThenSecret =+  (,) <$> required publicPasswordSetting <*> required passwordSetting++selectiveSensitivityConflict :: Config Text+selectiveSensitivityConflict =+  select+    ((\password -> Right password :: Either () Text) <$> required passwordSetting)+    ((\publicValue () -> publicValue) <$> required publicPasswordSetting)++defaultSensitivityConflict :: Config Text+defaultSensitivityConflict =+  withDefault+    passwordSetting+    ( derivedDefault+        (RuleName "password-from-public-duplicate")+        "Exercise a sensitivity conflict in a default dependency"+        (required publicPasswordSetting)+        id+    )+ hostSetting :: Setting Text hostSetting = publicSetting serviceHost "Service host" textDecoder @@ -168,6 +445,27 @@ passwordSetting :: Setting Text passwordSetting = secretSetting databasePassword "Database password" textDecoder +endpointSetting :: Setting Text+endpointSetting = publicSetting serviceEndpoint "Service endpoint" textDecoder++urlSetting :: Setting Text+urlSetting = publicSetting serviceUrl "Legacy service URL" textDecoder++publicPasswordSetting :: Setting Text+publicPasswordSetting = publicSetting databasePassword "Metrics password label" textDecoder++passwordSource :: Source+passwordSource =+  source+    "password"+    (CustomSource "test")+    ( RawObject+        ( Map.singleton+            "database"+            (RawObject (Map.singleton "password" (RawText "sensitive-value")))+        )+    )+ textArrayDecoder :: Decoder [Text] textArrayDecoder = decoder $ \key -> \case   RawArray values -> traverse (decodeOne key) values@@ -222,6 +520,18 @@         )     ) +serviceTextSource :: Text -> Text -> Text -> Source+serviceTextSource name field value =+  source+    name+    (CustomSource "test")+    ( RawObject+        ( Map.singleton+            "service"+            (RawObject (Map.singleton field (RawText value)))+        )+    )+ serviceHost :: Key serviceHost = validKey "service.host" @@ -230,6 +540,12 @@  serviceHosts :: Key serviceHosts = validKey "service.hosts"++serviceEndpoint :: Key+serviceEndpoint = validKey "service.endpoint"++serviceUrl :: Key+serviceUrl = validKey "service.url"  runtimeEnvironment :: Key runtimeEnvironment = validKey "runtime.environment"
test/Settei/SourceTest.hs view
@@ -39,6 +39,77 @@       testCase "leaf enumeration is ordered and treats arrays wholesale" $         fmap (renderKey . fst) (sourceLeaves sampleSource)           @?= ["service.hosts", "service.port"],+      testCase "source annotations compose across repeated calls" $+        sourceAnnotations+          ( annotateSource+              (Map.singleton "b" "2")+              (annotateSource (Map.singleton "a" "1") sampleSource)+          )+          @?= Map.fromList [("a", "1"), ("b", "2")],+      testCase "later source annotations win on collision" $+        sourceAnnotations+          ( annotateSource+              (Map.singleton "a" "new")+              (annotateSource (Map.singleton "a" "old") sampleSource)+          )+          ^. at "a"+          @?= Just "new",+      testCase "candidate origins observe merged source annotations" $ do+        let annotated =+              annotateSource+                (Map.singleton "b" "2")+                (annotateSource (Map.singleton "a" "1") sampleSource)+        case lookupSource servicePort annotated of+          Right (Just found) ->+            candidateOrigin found ^. #annotations+              @?= Map.fromList [("a", "1"), ("b", "2")]+          _ -> fail "expected the annotated source candidate",+      testCase "validated source pairs build addressable sibling leaves" $ do+        let serviceHost = validKey "service.host"+            result =+              sourceFromPairs+                "custom"+                BuiltInSource+                [ (servicePort, RawNumber 8080),+                  (serviceHost, RawText "db")+                ]+        case result of+          Left errors -> fail ("expected a valid source, got " <> show errors)+          Right built -> do+            fmap (renderKey . fst) (sourceLeaves built)+              @?= ["service.host", "service.port"]+            sourceUnaddressableLeaves built @?= []+            case (lookupSource servicePort built, lookupSource serviceHost built) of+              (Right (Just port), Right (Just host)) -> do+                assertBool "expected the inserted port" (candidateValue port == RawNumber 8080)+                assertBool "expected the inserted host" (candidateValue host == RawText "db")+              _ -> fail "expected both inserted candidates to be addressable",+      testCase "validated source pairs reject duplicate keys" $+        ( sourceFromPairs+            "custom"+            BuiltInSource+            [(servicePort, RawNumber 8080), (servicePort, RawNumber 9090)]+            & either id (const (error "expected duplicate rejection"))+        )+          @?= DuplicateSourceKey servicePort :| [],+      testCase "validated source pairs reject prefix overlaps" $+        let service = validKey "service"+         in ( sourceFromPairs+                "custom"+                BuiltInSource+                [(service, RawText "scalar"), (servicePort, RawNumber 8080)]+                & either id (const (error "expected overlap rejection"))+            )+              @?= OverlappingSourceKeys service servicePort :| [],+      testCase "unvalidated dotted leaves are visible to inspection" $+        let built =+              source+                "custom"+                BuiltInSource+                (RawObject (Map.singleton "a.b" (RawText "hidden")))+         in do+              assertBool "expected no addressable leaves" (null (sourceLeaves built))+              sourceUnaddressableLeaves built @?= [["a.b"]],       testCase "per-key annotations reach only their matching origins" $ do         let annotated =               annotateSourceAt
test/Settei/ValueTest.hs view
@@ -1,5 +1,7 @@ module Settei.ValueTest (tests) where +import Data.Int (Int16)+import Data.Ratio ((%)) import Data.Text qualified as Text import Settei import Settei.Prelude@@ -23,7 +25,69 @@         Left failureValue ->           assertBool             "rendered failure leaked the rejected secret"-            (not (Text.isInfixOf "supersecret" (renderDecodeFailure failureValue)))+            (not (Text.isInfixOf "supersecret" (renderDecodeFailure failureValue))),+      testCase "fmap maps a successful decode" $+        runDecoder (Text.toUpper <$> textDecoder) exampleKey (RawText "hello")+          @?= Right "HELLO",+      testCase "fmap passes failures through unchanged" $+        case runDecoder (Text.toUpper <$> textDecoder) exampleKey (RawBool True) of+          Right _ -> fail "expected decoding to fail"+          Left failureValue -> decodeFailureExpected failureValue @?= "text",+      testCase "listDecoder decodes arrays element-wise" $+        runDecoder (listDecoder textDecoder) exampleKey (RawArray [RawText "a", RawText "b"])+          @?= Right ["a", "b"],+      testCase "listDecoder rejects non-arrays" $+        case runDecoder (listDecoder textDecoder) exampleKey (RawText "a") of+          Right _ -> fail "expected decoding to fail"+          Left failureValue -> decodeFailureExpected failureValue @?= "an array",+      testCase "listDecoder wraps element expectations" $+        case runDecoder (listDecoder textDecoder) exampleKey (RawArray [RawText "a", RawBool True]) of+          Right _ -> fail "expected decoding to fail"+          Left failureValue -> decodeFailureExpected failureValue @?= "an array of text",+      testCase "nonEmptyDecoder decodes non-empty arrays" $+        runDecoder (nonEmptyDecoder textDecoder) exampleKey (RawArray [RawText "a", RawText "b"])+          @?= Right ("a" :| ["b"]),+      testCase "nonEmptyDecoder rejects empty arrays" $+        case runDecoder (nonEmptyDecoder textDecoder) exampleKey (RawArray []) of+          Right _ -> fail "expected decoding to fail"+          Left failureValue -> decodeFailureExpected failureValue @?= "a non-empty array",+      testCase "parsedDecoder applies the parser" $+        runDecoder portFromText exampleKey (RawText "8080") @?= Right (8080 :: Int),+      testCase "parsedDecoder reports only the caller's expectation" $+        case runDecoder portFromText exampleKey (RawText sentinel) of+          Right _ -> fail "expected decoding to fail"+          Left failureValue ->+            decodeFailureExpected failureValue @?= "a port number",+      testCase "parsedDecoder discards parser messages that echo input" $+        case runDecoder portFromText exampleKey (RawText sentinel) of+          Right _ -> fail "expected decoding to fail"+          Left failureValue ->+            assertBool+              "rendered failure leaked the parser input"+              (not (Text.isInfixOf sentinel (renderDecodeFailure failureValue))),+      testCase "listDecoder element failures never leak the value" $+        case runDecoder (listDecoder boolDecoder) exampleKey (RawArray [RawText sentinel]) of+          Right _ -> fail "expected decoding to fail"+          Left failureValue ->+            assertBool+              "rendered failure leaked the array element"+              (not (Text.isInfixOf sentinel (renderDecodeFailure failureValue))),+      testCase "rationalDecoder accepts numbers and numeric text" $ do+        runDecoder rationalDecoder exampleKey (RawNumber (5 % 2)) @?= Right (5 % 2)+        runDecoder rationalDecoder exampleKey (RawText "2.5") @?= Right (5 % 2)+        runDecoder rationalDecoder exampleKey (RawText "-3") @?= Right (negate 3),+      testCase "rationalDecoder rejects trailing garbage" $+        case runDecoder rationalDecoder exampleKey (RawText "1.5x") of+          Right _ -> fail "expected decoding to fail"+          Left failureValue -> decodeFailureExpected failureValue @?= "a number",+      testCase "doubleDecoder rounds through the exact rational" $ do+        runDecoder doubleDecoder exampleKey (RawText "2.5") @?= Right 2.5+        runDecoder doubleDecoder exampleKey (RawNumber (1 % 10)) @?= Right 0.1,+      testCase "boundedIntegralDecoder reports its range" $+        case runDecoder (boundedIntegralDecoder :: Decoder Int16) exampleKey (RawNumber 100000) of+          Right _ -> fail "expected decoding to fail"+          Left failureValue ->+            decodeFailureExpected failureValue @?= "integer between -32768 and 32767"     ]  data Environment = Development | Production@@ -50,6 +114,16 @@  exampleKey :: Key exampleKey = validKey "example.value"++portFromText :: Decoder Int+portFromText =+  parsedDecoder "a port number" $ \value ->+    case runDecoder (boundedIntegralDecoder :: Decoder Int) exampleKey (RawText value) of+      Right port -> Right port+      Left _ -> Left ("could not parse port from input: " <> value)++sentinel :: Text+sentinel = "s3cr3t\"\\\SOH!☃パス"  validKey :: Text -> Key validKey value = either (error . show) id (parseKey value)
+ test/golden/failure-resolution.json view
@@ -0,0 +1,1 @@+{"schemaVersion":1,"type":"settei.resolution","nodes":[{"key":"database.password","sensitivity":"secret","outcome":"not-selected","value":null,"origin":null,"shadowed":[],"derivation":null},{"key":"runtime.environment","sensitivity":"public","outcome":"resolved","value":"\"development\"","origin":{"kind":"built-in","kindDetail":null,"name":"built-in","key":"runtime.environment","location":null,"annotations":{}},"shadowed":[],"derivation":null},{"key":"service.host","sensitivity":"public","outcome":"missing","value":null,"origin":null,"shadowed":[],"derivation":null},{"key":"service.port","sensitivity":"public","outcome":"resolved","value":"\"not-a-port\"","origin":{"kind":"command-line","kindDetail":null,"name":"command-line","key":"service.port","location":null,"annotations":{}},"shadowed":[{"kind":"built-in","kindDetail":null,"name":"built-in","key":"service.port","location":null,"annotations":{}}],"derivation":null}],"branches":[{"dependencies":["runtime.environment"],"settings":["database.password"],"selected":false}]}
+ test/golden/failure-resolution.txt view
@@ -0,0 +1,8 @@+database.password = <not selected>+runtime.environment = "development"+  from built-in source built-in+service.host = <missing>+service.port = "not-a-port"+  from command-line option command-line+  shadowed: built-in source built-in+branch 1 [not selected]: runtime.environment -> database.password