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 +39/−1
- settei.cabal +1/−1
- src/Settei/Config.hs +57/−4
- src/Settei/Error.hs +8/−0
- src/Settei/Internal/Schema.hs +14/−1
- src/Settei/Prelude.hs +13/−1
- src/Settei/Provenance.hs +35/−3
- src/Settei/Render.hs +14/−2
- src/Settei/Report.hs +1/−1
- src/Settei/Resolve.hs +196/−65
- src/Settei/Setting.hs +20/−0
- src/Settei/Source.hs +109/−2
- src/Settei/Value.hs +109/−4
- test/Settei/ConfigTest.hs +135/−1
- test/Settei/DefaultTest.hs +23/−13
- test/Settei/RenderTest.hs +257/−10
- test/Settei/ResolveTest.hs +338/−22
- test/Settei/SourceTest.hs +71/−0
- test/Settei/ValueTest.hs +75/−1
- test/golden/failure-resolution.json +1/−0
- test/golden/failure-resolution.txt +8/−0
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