packages feed

settei (empty) → 0.1.0.0

raw patch · 38 files changed

+3426/−0 lines, 38 filesdep +basedep +containersdep +generic-lens

Dependencies added: base, containers, generic-lens, lens, selective, tasty, tasty-hunit, text

Files

+ CHANGELOG.md view
@@ -0,0 +1,8 @@+# Changelog for settei++## 0.1.0.0 — 2026-07-18++- 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.
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2026, shinzui+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+   this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,13 @@+# settei++`settei` is the core package in the Settei family of typed, layered, explainable+configuration libraries for Haskell. It owns the inspectable declaration language,+hierarchical resolution semantics, provenance model, derived defaults, and secret-safe+text and JSON reports.++Import `Settei` for the supported public entry point. Format and integration adapters are+published as separate `settei-*` packages so applications only depend on the parsers and+boundaries they use.++The package family, guides, architecture records, and implementation plans live in the+[Settei repository](https://github.com/shinzui/settei).
+ settei.cabal view
@@ -0,0 +1,111 @@+cabal-version:      3.8+name:               settei+version:            0.1.0.0+synopsis:           Typed, layered, explainable configuration+description:+  Settei provides an inspectable declaration language for typed configuration.+  This core package owns resolution, provenance, defaults, schemas, and reporting;+  sibling packages provide maintained source adapters.++homepage:           https://github.com/shinzui/settei+bug-reports:        https://github.com/shinzui/settei/issues+license:            BSD-3-Clause+license-file:       LICENSE+author:             shinzui+maintainer:         shinzui+category:           Configuration+build-type:         Simple+tested-with:        GHC ==9.12.4+extra-doc-files:    CHANGELOG.md+extra-source-files:+  README.md+  test/golden/*.json+  test/golden/*.txt++source-repository head+  type:     git+  location: https://github.com/shinzui/settei.git++common common+  default-language:   GHC2024+  default-extensions:+    DeriveAnyClass+    DuplicateRecordFields+    OverloadedLabels+    OverloadedStrings++  ghc-options:        -Wall -Wcompat++library+  import:          common+  hs-source-dirs:  src+  exposed-modules:+    Settei+    Settei.Config+    Settei.Default+    Settei.Error+    Settei.Key+    Settei.Origin+    Settei.Prelude+    Settei.Provenance+    Settei.Render+    Settei.Report+    Settei.Resolve+    Settei.Schema+    Settei.Setting+    Settei.Source+    Settei.Value++  other-modules:+    Settei.Internal.Config+    Settei.Internal.Schema++  build-depends:+    , base          >=4.21  && <5+    , containers    >=0.6.8 && <0.8+    , generic-lens  >=2.2   && <2.4+    , lens          >=5.3   && <5.4+    , selective     >=0.7   && <0.8+    , text          >=2.1   && <2.2++test-suite settei-tests+  import:         common+  type:           exitcode-stdio-1.0+  hs-source-dirs: test src+  main-is:        Main.hs+  other-modules:+    Settei+    Settei.Config+    Settei.ConfigTest+    Settei.Default+    Settei.DefaultTest+    Settei.Error+    Settei.Internal.Config+    Settei.Internal.Schema+    Settei.Key+    Settei.KeyTest+    Settei.Origin+    Settei.Prelude+    Settei.Prototype.Free+    Settei.Provenance+    Settei.Render+    Settei.RenderTest+    Settei.Report+    Settei.Resolve+    Settei.ResolveTest+    Settei.Schema+    Settei.Setting+    Settei.Source+    Settei.SourceTest+    Settei.Value+    Settei.ValueTest++  build-depends:+    , base          >=4.21   && <5+    , containers    >=0.6.8  && <0.8+    , generic-lens  >=2.2    && <2.4+    , lens          >=5.3    && <5.4+    , selective     >=0.7    && <0.8+    , tasty         >=1.5    && <1.6+    , tasty-hunit   >=0.10.2 && <0.11+    , text          >=2.1    && <2.2
+ src/Settei.hs view
@@ -0,0 +1,31 @@+-- | Typed, inspectable configuration declarations.+module Settei+  ( module Settei.Config,+    module Settei.Default,+    module Settei.Error,+    module Settei.Key,+    module Settei.Origin,+    module Settei.Provenance,+    module Settei.Render,+    module Settei.Report,+    module Settei.Resolve,+    module Settei.Schema,+    module Settei.Setting,+    module Settei.Source,+    module Settei.Value,+  )+where++import Settei.Config+import Settei.Default+import Settei.Error+import Settei.Key+import Settei.Origin+import Settei.Provenance+import Settei.Render+import Settei.Report+import Settei.Resolve+import Settei.Schema+import Settei.Setting+import Settei.Source+import Settei.Value
+ src/Settei/Config.hs view
@@ -0,0 +1,65 @@+-- |+-- Module: Settei.Config+-- Description: Compose and inspect typed configuration declarations.+--+-- A 'Config' describes configuration effects without reading a source. Independent+-- settings compose with 'Applicative'; runtime-dependent effects compose with+-- "Control.Selective". The latter preserves a static over-approximation while allowing+-- an interpreter to skip an unused branch.+--+-- For example, a caller can declare a production-only password (assuming+-- @environmentSetting :: Setting Text@ and @passwordSetting :: Setting Text@):+--+-- @+-- productionPassword :: Config (Maybe Text)+-- productionPassword =+--   select+--     ((\environment -> if environment == "production" then Left () else Right Nothing)+--       '<$>' required environmentSetting)+--     ((\password _ -> Just password) '<$>' required passwordSetting)+-- @+--+-- Inspection needs no environment variables or files:+--+-- @+-- fmap (renderKey . schemaSettingKey) (schemaNecessary (describe productionPassword))+-- -- ["runtime.environment"]+-- @+--+-- '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,+    optional,+    required,+    withDefault,+  )+where++import Settei.Default (Default)+import Settei.Internal.Config+  ( Config,+    describeConfig,+    optionalConfig,+    requiredConfig,+    withDefaultConfig,+  )+import Settei.Schema (Schema)+import Settei.Setting (Setting)++-- | Require one setting when this declaration path is evaluated.+required :: Setting a -> Config a+required = requiredConfig++-- | Request a setting without failing when no source supplies it.+optional :: Setting a -> Config (Maybe a)+optional = optionalConfig++-- | Request a setting, evaluating its named fallback only when no source supplies it.+withDefault :: Setting a -> Default a -> Config a+withDefault = withDefaultConfig++-- | Inspect every possible request without reading configuration sources.+describe :: Config a -> Schema+describe = describeConfig
+ src/Settei/Default.hs view
@@ -0,0 +1,45 @@+-- |+-- Module: Settei.Default+-- Description: Named constant and dependency-aware fallback rules.+module Settei.Default+  ( Default,+    RuleName (..),+    caseDefault,+    constantDefault,+    derivedDefault,+    renderRuleName,+  )+where++import Settei.Internal.Config+  ( Config,+    Default,+    RuleName (..),+    caseDefaultConfig,+    constantDefaultConfig,+    derivedDefaultConfig,+    renderRuleName,+  )+import Settei.Prelude++-- | A fallback value with a stable name and human-readable rationale.+constantDefault :: RuleName -> Text -> a -> Default a+constantDefault = constantDefaultConfig++-- | A fallback derived from an explicit, statically inspectable declaration.+derivedDefault :: RuleName -> Text -> Config d -> (d -> a) -> Default a+derivedDefault = derivedDefaultConfig++-- | A finite named derivation with an optional catch-all fallback.+--+-- An unmatched value without a fallback becomes a structured resolver error; the+-- rejected dependency value is never retained in that error.+caseDefault ::+  (Ord d, Show d) =>+  RuleName ->+  Text ->+  Config d ->+  NonEmpty (d, a) ->+  Maybe a ->+  Default a+caseDefault = caseDefaultConfig
+ src/Settei/Error.hs view
@@ -0,0 +1,85 @@+-- |+-- Module: Settei.Error+-- Description: Structured, secret-safe configuration failures.+module Settei.Error+  ( ConfigError (..),+    ConfigWarning (..),+    DefaultCycleProblem (..),+    DefaultProblem (..),+    DecodeProblem (..),+    MissingProblem (..),+    RawShape (..),+    StructuralError (..),+    UnknownKeyProblem (..),+  )+where++import Settei.Default (RuleName)+import Settei.Key (Key)+import Settei.Origin (Origin)+import Settei.Prelude+import Settei.Provenance (ReportedValue)++-- | The coarse shape that prevented traversal through a source tree.+data RawShape = NullShape | ScalarShape | ArrayShape+  deriving stock (Generic, Eq, Ord, Show)++-- | A declared key attempted to traverse through a non-object value.+data StructuralError = StructuralError+  { key :: !Key,+    blockedAt :: !Key,+    origin :: !Origin,+    shape :: !RawShape+  }+  deriving stock (Generic, Eq, Show)++-- | A required setting that had no winning source candidate.+data MissingProblem = MissingProblem+  { key :: !Key+  }+  deriving stock (Generic, Eq, Show)++-- | A winning candidate that did not satisfy its setting decoder.+data DecodeProblem = DecodeProblem+  { key :: !Key,+    expected :: !Text,+    origin :: !Origin,+    rejected :: !ReportedValue+  }+  deriving stock (Generic, Eq, Show)++-- | An addressable source leaf that no declaration recognizes.+data UnknownKeyProblem = UnknownKeyProblem+  { key :: !Key,+    origin :: !Origin+  }+  deriving stock (Generic, Eq, Show)++-- | A named default failed without retaining its dependency value.+data DefaultProblem = DefaultProblem+  { key :: !Key,+    rule :: !RuleName,+    message :: !Text+  }+  deriving stock (Generic, Eq, Show)++-- | The ordered rule path that re-entered an active default.+data DefaultCycleProblem = DefaultCycleProblem+  { rules :: !(NonEmpty RuleName)+  }+  deriving stock (Generic, Eq, Show)++-- | A fatal resolver error. Every constructor is safe to render or show.+data ConfigError+  = MissingRequired !MissingProblem+  | DecodeError !DecodeProblem+  | StructuralConflict !StructuralError+  | UnknownKeyError !UnknownKeyProblem+  | DefaultError !DefaultProblem+  | DefaultCycle !DefaultCycleProblem+  deriving stock (Generic, Eq, Show)++-- | A non-fatal resolver diagnostic.+data ConfigWarning+  = UnknownKeyWarning !UnknownKeyProblem+  deriving stock (Generic, Eq, Show)
+ src/Settei/Internal/Config.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Settei.Internal.Config+  ( Config (..),+    Default (..),+    Request (..),+    RuleName (..),+    caseDefaultConfig,+    constantDefaultConfig,+    describeConfig,+    derivedDefaultConfig,+    optionalConfig,+    renderRuleName,+    requiredConfig,+    runConfig,+    withDefaultConfig,+  )+where++import Control.Selective (Selective (..))+import Data.List.NonEmpty qualified as NonEmpty+import Settei.Internal.Schema+  ( Requirement (..),+    Schema,+    combineSchema,+    conditionalSchema,+    emptySchema,+    requestSchema,+  )+import Settei.Prelude+import Settei.Setting (Setting)++-- | A request made by the declaration language.+data Request a where+  RequiredRequest :: !(Setting a) -> Request a+  OptionalRequest :: !(Setting a) -> Request (Maybe a)++-- | Stable identity for a default derivation rule.+newtype RuleName = RuleName Text+  deriving stock (Generic, Eq, Ord, Show)++-- | An inspectable fallback with explicit dependencies.+--+-- Function-bearing constructors intentionally have no 'Show' instance.+data Default a where+  ConstantDefault :: !RuleName -> !Text -> a -> Default a+  DerivedDefault :: !RuleName -> !Text -> Config d -> (d -> a) -> Default a+  CaseDefault ::+    (Ord d, Show d) =>+    !RuleName ->+    !Text ->+    Config d ->+    !(NonEmpty (d, a)) ->+    !(Maybe a) ->+    Default a++-- | The private, typed syntax tree behind the public declaration language.+data Config a where+  PureConfig :: a -> Config a+  MapConfig :: (a -> b) -> Config a -> Config b+  ApplyConfig :: Config (a -> b) -> Config a -> Config b+  RequestConfig :: !(Request a) -> Config a+  DefaultConfig :: !(Setting a) -> !(Default a) -> Config a+  SelectConfig :: Config (Either a b) -> Config (a -> b) -> Config b++instance Functor Config where+  fmap = MapConfig++instance Applicative Config where+  pure = PureConfig+  (<*>) = ApplyConfig++instance Selective Config where+  select = SelectConfig++requiredConfig :: Setting a -> Config a+requiredConfig = RequestConfig . RequiredRequest++optionalConfig :: Setting a -> Config (Maybe a)+optionalConfig = RequestConfig . OptionalRequest++constantDefaultConfig :: RuleName -> Text -> a -> Default a+constantDefaultConfig = ConstantDefault++derivedDefaultConfig :: RuleName -> Text -> Config d -> (d -> a) -> Default a+derivedDefaultConfig = DerivedDefault++caseDefaultConfig ::+  (Ord d, Show d) =>+  RuleName ->+  Text ->+  Config d ->+  NonEmpty (d, a) ->+  Maybe a ->+  Default a+caseDefaultConfig = CaseDefault++withDefaultConfig :: Setting a -> Default a -> Config a+withDefaultConfig = DefaultConfig++-- | Render the stable textual identity of a default rule.+renderRuleName :: RuleName -> Text+renderRuleName (RuleName value) = value++-- | Interpret a declaration. Selective branches evaluate only the chosen side.+runConfig :: (Monad m) => (forall x. Request x -> m x) -> Config a -> m a+runConfig interpret = \case+  PureConfig value -> pure value+  MapConfig mapValue config -> mapValue <$> runConfig interpret config+  ApplyConfig function inputConfig ->+    runConfig interpret function <*> runConfig interpret inputConfig+  RequestConfig request -> interpret request+  DefaultConfig settingSpec defaultSpec -> do+    explicitValue <- interpret (OptionalRequest settingSpec)+    case explicitValue of+      Just value -> pure value+      Nothing -> runDefault defaultSpec+  SelectConfig selector branch -> do+    decision <- runConfig interpret selector+    case decision of+      Right value -> pure value+      Left value -> do+        applyBranch <- runConfig interpret branch+        pure (applyBranch value)+  where+    runDefault = \case+      ConstantDefault _ _ value -> pure value+      DerivedDefault _ _ dependency derive ->+        derive <$> runConfig interpret dependency+      CaseDefault _ _ dependency choices fallback -> do+        dependencyValue <- runConfig interpret dependency+        case lookup dependencyValue (NonEmpty.toList choices) of+          Just value -> pure value+          Nothing -> case fallback of+            Just value -> pure value+            Nothing -> error "Settei.Internal.Config.runConfig: unmatched case default"++describeConfig :: Config a -> Schema+describeConfig = \case+  PureConfig _ -> emptySchema+  MapConfig _ config -> describeConfig config+  ApplyConfig function inputConfig ->+    combineSchema (describeConfig function) (describeConfig inputConfig)+  RequestConfig request -> case request of+    RequiredRequest settingSpec -> requestSchema Required settingSpec+    OptionalRequest settingSpec -> requestSchema Optional settingSpec+  DefaultConfig settingSpec defaultSpec ->+    conditionalSchema+      (requestSchema Optional settingSpec)+      (describeDefault defaultSpec)+  SelectConfig selector branch ->+    conditionalSchema (describeConfig selector) (describeConfig branch)++describeDefault :: Default a -> Schema+describeDefault = \case+  ConstantDefault _ _ _ -> emptySchema+  DerivedDefault _ _ dependency _ -> describeConfig dependency+  CaseDefault _ _ dependency _ _ -> describeConfig dependency
+ src/Settei/Internal/Schema.hs view
@@ -0,0 +1,118 @@+module Settei.Internal.Schema+  ( Condition (..),+    Presence (..),+    Requirement (..),+    Schema (..),+    SchemaSetting (..),+    combineSchema,+    conditionalSchema,+    emptySchema,+    requestSchema,+  )+where++import Data.Generics.Labels ()+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Settei.Key (Key)+import Settei.Prelude+import Settei.Setting+  ( Sensitivity,+    Setting,+    settingDescription,+    settingKey,+    settingSensitivity,+  )++-- | Whether absence of a candidate is an error at runtime.+data Requirement = Required | Optional+  deriving stock (Generic, Eq, Ord, Show)++-- | Whether a declaration is evaluated on every execution path.+data Presence = Necessary | Conditional+  deriving stock (Generic, Eq, Ord, Show)++-- | Static metadata for one possible setting request.+data SchemaSetting = SchemaSetting+  { key :: !Key,+    description :: !Text,+    sensitivity :: !Sensitivity,+    requirement :: !Requirement,+    presence :: !Presence+  }+  deriving stock (Generic, Eq, Show)++-- | A conservative relationship introduced by a selective branch.+data Condition = Condition+  { dependencies :: !(Set Key),+    settings :: !(Set Key)+  }+  deriving stock (Generic, Eq, Show)++-- | The complete static over-approximation of a configuration declaration.+data Schema = Schema+  { settings :: !(Map Key SchemaSetting),+    conditions :: ![Condition]+  }+  deriving stock (Generic, Eq, Show)++emptySchema :: Schema+emptySchema = Schema {settings = Map.empty, conditions = []}++requestSchema :: Requirement -> Setting a -> Schema+requestSchema requirement settingSpec =+  Schema+    { settings = Map.singleton key entry,+      conditions = []+    }+  where+    key = settingKey settingSpec+    entry =+      SchemaSetting+        { key,+          description = settingDescription settingSpec,+          sensitivity = settingSensitivity settingSpec,+          requirement,+          presence = Necessary+        }++combineSchema :: Schema -> Schema -> Schema+combineSchema left right =+  Schema+    { settings =+        Map.unionWith mergeSetting (left ^. #settings) (right ^. #settings),+      conditions = left ^. #conditions <> right ^. #conditions+    }++conditionalSchema :: Schema -> Schema -> Schema+conditionalSchema selector branch =+  combined+    & #conditions+    %~ (<> newCondition)+  where+    branchSettings = branch ^. #settings & each . #presence .~ Conditional+    branchKeys = Map.keysSet branchSettings+    selectorKeys = Map.keysSet (selector ^. #settings)+    conditionalBranch = branch & #settings .~ branchSettings+    combined = combineSchema selector conditionalBranch+    newCondition+      | Set.null branchKeys = []+      | otherwise = [Condition {dependencies = selectorKeys, settings = branchKeys}]++mergeSetting :: SchemaSetting -> SchemaSetting -> SchemaSetting+mergeSetting left right =+  left+    & #requirement+    .~ mergeRequirement (left ^. #requirement) (right ^. #requirement)+    & #presence+    .~ mergePresence (left ^. #presence) (right ^. #presence)++mergeRequirement :: Requirement -> Requirement -> Requirement+mergeRequirement Required _ = Required+mergeRequirement _ Required = Required+mergeRequirement Optional Optional = Optional++mergePresence :: Presence -> Presence -> Presence+mergePresence Necessary _ = Necessary+mergePresence _ Necessary = Necessary+mergePresence Conditional Conditional = Conditional
+ src/Settei/Key.hs view
@@ -0,0 +1,65 @@+-- |+-- Module: Settei.Key+-- Description: Validated structural keys with canonical dotted rendering.+module Settei.Key+  ( Key,+    KeyError (..),+    mkKey,+    parseKey,+    renderKey,+    keySegments,+  )+where++import Data.Generics.Labels ()+import Data.List.NonEmpty qualified as NonEmpty+import Data.Text qualified as Text+import Settei.Prelude++-- | A validated, hierarchical configuration key.+newtype Key = ValidatedKey+  { segments :: NonEmpty Text+  }+  deriving stock (Generic, Eq, Ord, Show)++-- | Why textual input could not be represented as a 'Key'.+data KeyError+  = KeyIsEmpty+  | KeySegmentIsEmpty+  | KeySegmentContainsDot !Text+  deriving stock (Generic, Eq, Show)++-- | Validate structural key segments.+mkKey :: NonEmpty Text -> Either KeyError Key+mkKey value+  | any Text.null segmentList = Left KeySegmentIsEmpty+  | Just part <- findWithDot segmentList = Left (KeySegmentContainsDot part)+  | otherwise = Right (ValidatedKey value)+  where+    segmentList = NonEmpty.toList value+    findWithDot = find (Text.any (== '.'))++-- | Parse dot-separated text into a non-empty structural key.+parseKey :: Text -> Either KeyError Key+parseKey value+  | Text.null value = Left KeyIsEmpty+  | otherwise =+      maybe+        (Left KeyIsEmpty)+        mkKey+        (NonEmpty.nonEmpty (Text.splitOn "." value))++-- | Render a key using its canonical dot-separated spelling.+renderKey :: Key -> Text+renderKey value = Text.intercalate "." (NonEmpty.toList (value ^. #segments))++-- | Return the structural segments of a key.+keySegments :: Key -> NonEmpty Text+keySegments value = value ^. #segments++find :: (a -> Bool) -> [a] -> Maybe a+find predicate = \case+  [] -> Nothing+  value : rest+    | predicate value -> Just value+    | otherwise -> find predicate rest
+ src/Settei/Origin.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE ImportQualifiedPost #-}++-- |+-- Module: Settei.Origin+-- Description: Adapter-neutral metadata describing where a candidate came from.+module Settei.Origin+  ( KubernetesObjectKind (..),+    KubernetesRef,+    Origin (..),+    SourceKind (..),+    SourceLocation (..),+    kubernetesAnnotations,+    kubernetesRef,+    kubernetesRefKey,+    kubernetesRefKind,+    kubernetesRefName,+    kubernetesRefNamespace,+  )+where++import Data.Generics.Labels ()+import Data.Map.Strict qualified as Map+import Settei.Key (Key)+import Settei.Prelude++-- | A format-independent category for a configuration source.+data SourceKind+  = BuiltInSource+  | FileSource !Text+  | EnvironmentSource+  | CommandLineSource+  | DerivedSource+  | CustomSource !Text+  deriving stock (Generic, Eq, Ord, Show)++-- | An optional source location retained by an adapter.+data SourceLocation = SourceLocation+  { path :: !Text,+    line :: !(Maybe Int),+    column :: !(Maybe Int)+  }+  deriving stock (Generic, Eq, Ord, Show)++-- | Structured provenance for one logical configuration key.+data Origin = Origin+  { kind :: !SourceKind,+    name :: !Text,+    key :: !Key,+    location :: !(Maybe SourceLocation),+    annotations :: !(Map Text Text)+  }+  deriving stock (Generic, Eq, Show)++-- | Kubernetes object categories shared by independent adapters.+data KubernetesObjectKind = ConfigMapObject | SecretObject+  deriving stock (Generic, Eq, Ord, Show)++-- | A cluster-independent Kubernetes object reference.+data KubernetesRef = KubernetesRef+  { kind :: !KubernetesObjectKind,+    namespace :: !(Maybe Text),+    name :: !Text,+    key :: !(Maybe Text)+  }+  deriving stock (Generic, Eq, Ord, Show)++-- | Construct a reference without performing a cluster lookup.+kubernetesRef :: KubernetesObjectKind -> Maybe Text -> Text -> Maybe Text -> KubernetesRef+kubernetesRef kind namespace name key = KubernetesRef {kind, namespace, name, key}++-- | Return the referenced Kubernetes object kind.+kubernetesRefKind :: KubernetesRef -> KubernetesObjectKind+kubernetesRefKind value = value ^. #kind++-- | Return the optional Kubernetes namespace.+kubernetesRefNamespace :: KubernetesRef -> Maybe Text+kubernetesRefNamespace value = value ^. #namespace++-- | Return the Kubernetes object name.+kubernetesRefName :: KubernetesRef -> Text+kubernetesRefName value = value ^. #name++-- | Return the optional key within the Kubernetes object.+kubernetesRefKey :: KubernetesRef -> Maybe Text+kubernetesRefKey value = value ^. #key++-- | Stable annotations understood across Kubernetes-aware adapters.+kubernetesAnnotations :: KubernetesRef -> Map Text Text+kubernetesAnnotations value =+  Map.fromList+    ( [ ("kubernetes.object-kind", renderObjectKind (value ^. #kind)),+        ("kubernetes.object-name", value ^. #name)+      ]+        <> maybe [] (pure . ("kubernetes.namespace",)) (value ^. #namespace)+        <> maybe [] (pure . ("kubernetes.object-key",)) (value ^. #key)+    )++renderObjectKind :: KubernetesObjectKind -> Text+renderObjectKind ConfigMapObject = "ConfigMap"+renderObjectKind SecretObject = "Secret"
+ src/Settei/Prelude.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE PackageImports #-}++-- |+-- Module: Settei.Prelude+-- Description: Small shared project prelude and lens operator surface.+module Settei.Prelude+  ( module X,+    module Control.Lens,+  )+where++import "base" Data.List.NonEmpty as X (NonEmpty (..))+import "base" GHC.Generics as X (Generic)+import "containers" Data.Map.Strict as X (Map)+import "containers" Data.Set as X (Set)+import "lens" Control.Lens hiding (Setting)+import "text" Data.Text as X (Text)+import "base" Prelude as X
+ src/Settei/Provenance.hs view
@@ -0,0 +1,105 @@+-- |+-- Module: Settei.Provenance+-- Description: Raw candidates paired with their structured origin.+module Settei.Provenance+  ( Candidate,+    ReportedValue,+    candidate,+    candidateOrigin,+    candidateValue,+    derivedReportedValue,+    renderReportedValue,+    reportedValue,+    visibleReportedValue,+  )+where++import Data.Generics.Labels ()+import Data.Map.Strict qualified as Map+import Data.Ratio qualified as Ratio+import Data.Text qualified as Text+import Settei.Origin (Origin)+import Settei.Prelude+import Settei.Setting (Sensitivity (..))+import Settei.Value (RawValue (..))++-- | One source's value for one declared key.+--+-- There is deliberately no 'Show' instance: the raw value may be secret.+data Candidate = Candidate+  { value :: !RawValue,+    origin :: !Origin+  }+  deriving stock (Generic, Eq)++-- | Pair one raw source value with its exact origin.+candidate :: RawValue -> Origin -> Candidate+candidate value origin = Candidate {value, origin}++-- | Return the candidate's raw value for core decoding.+candidateValue :: Candidate -> RawValue+candidateValue value = value ^. #value++-- | Return the candidate's structured origin.+candidateOrigin :: Candidate -> Origin+candidateOrigin value = value ^. #origin++-- | A value safe to retain in reports and structured errors.+--+-- Constructors are private so reporting code can display a value but cannot unwrap a+-- supposedly redacted secret.+data ReportedValue+  = VisibleValue !Text+  | RedactedValue+  | DerivedValue+  deriving stock (Generic, Eq, Ord, Show)++-- | Apply a setting's sensitivity before retaining any display representation.+reportedValue :: Sensitivity -> RawValue -> ReportedValue+reportedValue Public = VisibleValue . renderRawValue+reportedValue Secret = const RedactedValue++-- | Render a retained value. A redacted value has no recovery path.+renderReportedValue :: ReportedValue -> Text+renderReportedValue (VisibleValue value) = value+renderReportedValue RedactedValue = "<redacted>"+renderReportedValue DerivedValue = "<derived>"++-- | Represent a typed default when no format-independent encoder exists.+derivedReportedValue :: Sensitivity -> ReportedValue+derivedReportedValue Public = DerivedValue+derivedReportedValue Secret = RedactedValue++-- | Retain an already-rendered public value.+visibleReportedValue :: Text -> ReportedValue+visibleReportedValue = VisibleValue++renderRawValue :: RawValue -> Text+renderRawValue = \case+  RawNull -> "null"+  RawText value -> "\"" <> escapeText value <> "\""+  RawBool True -> "true"+  RawBool False -> "false"+  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))+  RawArray values -> "[" <> Text.intercalate ", " (fmap renderRawValue values) <> "]"+  RawObject values ->+    "{"+      <> Text.intercalate+        ", "+        [ "\"" <> escapeText key <> "\": " <> renderRawValue value+        | (key, value) <- Map.toAscList values+        ]+      <> "}"++escapeText :: Text -> Text+escapeText =+  Text.replace "\n" "\\n"+    . Text.replace "\r" "\\r"+    . Text.replace "\t" "\\t"+    . Text.replace "\"" "\\\""+    . Text.replace "\\" "\\\\"
+ src/Settei/Render.hs view
@@ -0,0 +1,461 @@+{-# LANGUAGE ImportQualifiedPost #-}++-- |+-- Module: Settei.Render+-- Description: Deterministic text and versioned JSON presentation.+module Settei.Render+  ( renderErrorsJson,+    renderErrorsText,+    renderResolutionJson,+    renderResolutionText,+    renderSchemaJson,+    renderSchemaText,+    renderWarningsJson,+    renderWarningsText,+  )+where++import Control.Applicative ((<|>))+import Data.Char (ord)+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 Data.Text qualified as Text+import Numeric (showHex)+import Settei.Default (renderRuleName)+import Settei.Error+import Settei.Key (Key, renderKey)+import Settei.Origin+import Settei.Prelude+import Settei.Provenance (renderReportedValue)+import Settei.Report+import Settei.Schema+import Settei.Setting (Sensitivity (..))++-- | Render a static schema in stable key order.+renderSchemaText :: Schema -> Text+renderSchemaText schema =+  Text.unlines+    ( fmap renderSchemaSettingText (schemaPossible schema)+        <> concatMap renderConditionText (zip [1 :: Int ..] (schemaConditions schema))+    )++renderSchemaSettingText :: SchemaSetting -> Text+renderSchemaSettingText schemaEntry =+  renderKey (schemaSettingKey schemaEntry)+    <> " ["+    <> requirementText (schemaSettingRequirement schemaEntry)+    <> ", "+    <> presenceText (schemaSettingPresence schemaEntry)+    <> ", "+    <> sensitivityText (schemaSettingSensitivity schemaEntry)+    <> "] "+    <> schemaSettingDescription schemaEntry++renderConditionText :: (Int, Condition) -> [Text]+renderConditionText (conditionNumber, condition) =+  [ "condition "+      <> Text.pack (show conditionNumber)+      <> ": "+      <> commaKeys (Set.toAscList (conditionDependencies condition))+      <> " -> "+      <> commaKeys (Set.toAscList (conditionSettings condition))+  ]++-- | Render one successful resolution, including skipped settings and branch decisions.+renderResolutionText :: ResolutionReport -> Text+renderResolutionText report =+  Text.concat (fmap (renderNodeText report) (reportNodes report))+    <> Text.concat (fmap renderBranchText (zip [1 :: Int ..] (reportBranches report)))++renderNodeText :: ResolutionReport -> ResolutionNode -> Text+renderNodeText report node =+  renderKey (node ^. #key)+    <> " = "+    <> outcomeValueText (node ^. #outcome)+    <> "\n"+    <> maybe "" (renderOriginText "  from ") (node ^. #origin)+    <> maybe "" (renderDerivationText report) (node ^. #derivation)+    <> Text.concat (fmap (renderOriginText "  shadowed: ") (node ^. #shadowed))++renderDerivationText :: ResolutionReport -> Derivation -> Text+renderDerivationText report derivation =+  Text.concat (fmap renderDependency (derivation ^. #dependencies))+  where+    renderDependency key =+      case report ^. #nodes . at key of+        Nothing -> "  because " <> renderKey key <> " = <not evaluated>\n"+        Just node ->+          "  because "+            <> renderKey key+            <> " = "+            <> outcomeValueText (node ^. #outcome)+            <> "\n"+            <> maybe "" (renderOriginText "    from ") (node ^. #origin)++renderBranchText :: (Int, BranchTrace) -> Text+renderBranchText (branchNumber, branch) =+  "branch "+    <> Text.pack (show branchNumber)+    <> " ["+    <> (if branch ^. #selected then "selected" else "not selected")+    <> "]: "+    <> commaKeys (branch ^. #dependencies)+    <> " -> "+    <> commaKeys (branch ^. #settings)+    <> "\n"++renderOriginText :: Text -> Origin -> Text+renderOriginText prefix origin = prefix <> originDescription origin <> "\n"++originDescription :: Origin -> Text+originDescription origin =+  baseDescription <> dhallSuffix origin <> kubernetesSuffix origin+  where+    baseDescription = case origin ^. #kind of+      BuiltInSource -> "built-in source " <> origin ^. #name+      FileSource formatName -> "file source " <> origin ^. #name <> " (" <> formatName <> ")"+      EnvironmentSource ->+        maybe+          ("environment source " <> origin ^. #name)+          ("environment variable " <>)+          (origin ^. #annotations . at "environment.variable")+      CommandLineSource ->+        "command-line option "+          <> fromMaybe+            (origin ^. #name)+            ( origin ^. #annotations . at "command-line.spelling"+                <|> origin ^. #annotations . at "command-line.option"+            )+          <> maybe+            ""+            (" occurrence " <>)+            (origin ^. #annotations . at "command-line.occurrence")+      DerivedSource -> "default rule " <> origin ^. #name+      CustomSource customKind -> customKind <> " source " <> origin ^. #name++dhallSuffix :: Origin -> Text+dhallSuffix origin = case origin ^. #kind of+  FileSource "Dhall" ->+    case origin ^. #annotations . at "dhall.root" of+      Nothing -> ""+      Just root ->+        " rooted at "+          <> root+          <> " evaluated with "+          <> fromMaybe "0" (origin ^. #annotations . at "dhall.import-count")+          <> " local imports; leaf-level import attribution unavailable after normalization"+  _ -> ""++kubernetesSuffix :: Origin -> Text+kubernetesSuffix origin =+  case ( origin ^. #annotations . at "kubernetes.object-kind",+         origin ^. #annotations . at "kubernetes.object-name"+       ) of+    (Just objectKind, Just objectName) ->+      " from Kubernetes "+        <> objectKind+        <> " "+        <> maybe "" (<> "/") (origin ^. #annotations . at "kubernetes.namespace")+        <> objectName+        <> maybe "" (" key " <>) (origin ^. #annotations . at "kubernetes.object-key")+    _ -> ""++-- | Render structured failures without access to rejected secret values.+renderErrorsText :: NonEmpty ConfigError -> Text+renderErrorsText = Text.unlines . fmap renderErrorText . NonEmpty.toList++renderErrorText :: ConfigError -> Text+renderErrorText = \case+  MissingRequired problem -> renderKey (problem ^. #key) <> ": required value is missing"+  DecodeError problem ->+    renderKey (problem ^. #key)+      <> ": expected "+      <> problem ^. #expected+      <> " from "+      <> originDescription (problem ^. #origin)+      <> ", rejected "+      <> renderReportedValue (problem ^. #rejected)+  StructuralConflict problem ->+    renderKey (problem ^. #key)+      <> ": cannot traverse "+      <> renderKey (problem ^. #blockedAt)+      <> " through "+      <> rawShapeText (problem ^. #shape)+      <> " in "+      <> originDescription (problem ^. #origin)+  UnknownKeyError problem ->+    renderKey (problem ^. #key)+      <> ": unknown key in "+      <> originDescription (problem ^. #origin)+  DefaultError problem ->+    renderKey (problem ^. #key)+      <> ": default rule "+      <> renderRuleName (problem ^. #rule)+      <> " failed: "+      <> problem ^. #message+  DefaultCycle problem ->+    "default cycle: "+      <> Text.intercalate " -> " (fmap renderRuleName (NonEmpty.toList (problem ^. #rules)))++-- | Render non-fatal diagnostics in deterministic source and key order.+renderWarningsText :: [ConfigWarning] -> Text+renderWarningsText = Text.unlines . fmap renderWarningText++renderWarningText :: ConfigWarning -> Text+renderWarningText = \case+  UnknownKeyWarning problem ->+    renderKey (problem ^. #key)+      <> ": unknown key in "+      <> originDescription (problem ^. #origin)++-- | Render a schema as versioned deterministic JSON.+renderSchemaJson :: Schema -> Text+renderSchemaJson schema =+  versionedJson+    "settei.schema"+    [ ("settings", jsonArray (fmap schemaSettingJson (schemaPossible schema))),+      ("conditions", jsonArray (fmap conditionJson (schemaConditions schema)))+    ]++schemaSettingJson :: SchemaSetting -> Text+schemaSettingJson schemaEntry =+  jsonObject+    [ ("key", jsonString (renderKey (schemaSettingKey schemaEntry))),+      ("description", jsonString (schemaSettingDescription schemaEntry)),+      ("sensitivity", jsonString (sensitivityText (schemaSettingSensitivity schemaEntry))),+      ("requirement", jsonString (requirementText (schemaSettingRequirement schemaEntry))),+      ("presence", jsonString (presenceText (schemaSettingPresence schemaEntry)))+    ]++conditionJson :: Condition -> Text+conditionJson condition =+  jsonObject+    [ ("dependencies", jsonKeyArray (Set.toAscList (conditionDependencies condition))),+      ("settings", jsonKeyArray (Set.toAscList (conditionSettings condition)))+    ]++-- | Render a successful resolution as versioned deterministic JSON.+renderResolutionJson :: ResolutionReport -> Text+renderResolutionJson report =+  versionedJson+    "settei.resolution"+    [ ("nodes", jsonArray (fmap resolutionNodeJson (reportNodes report))),+      ("branches", jsonArray (fmap branchJson (reportBranches report)))+    ]++resolutionNodeJson :: ResolutionNode -> Text+resolutionNodeJson node =+  jsonObject+    [ ("key", jsonString (renderKey (node ^. #key))),+      ("sensitivity", jsonString (sensitivityText (node ^. #sensitivity))),+      ("outcome", jsonString (outcomeTag (node ^. #outcome))),+      ("value", outcomeValueJson (node ^. #outcome)),+      ("origin", maybe "null" originJson (node ^. #origin)),+      ("shadowed", jsonArray (fmap originJson (node ^. #shadowed))),+      ("derivation", maybe "null" derivationJson (node ^. #derivation))+    ]++derivationJson :: Derivation -> Text+derivationJson derivation =+  jsonObject+    [ ("rule", jsonString (derivation ^. #rule)),+      ("explanation", jsonString (derivation ^. #explanation)),+      ("dependencies", jsonKeyArray (derivation ^. #dependencies))+    ]++branchJson :: BranchTrace -> Text+branchJson branch =+  jsonObject+    [ ("dependencies", jsonKeyArray (branch ^. #dependencies)),+      ("settings", jsonKeyArray (branch ^. #settings)),+      ("selected", if branch ^. #selected then "true" else "false")+    ]++originJson :: Origin -> Text+originJson origin =+  jsonObject+    [ ("kind", jsonString (sourceKindTag (origin ^. #kind))),+      ("kindDetail", maybe "null" jsonString (sourceKindDetail (origin ^. #kind))),+      ("name", jsonString (origin ^. #name)),+      ("key", jsonString (renderKey (origin ^. #key))),+      ("location", maybe "null" locationJson (origin ^. #location)),+      ("annotations", jsonTextMap (origin ^. #annotations))+    ]++locationJson :: SourceLocation -> Text+locationJson location =+  jsonObject+    [ ("path", jsonString (location ^. #path)),+      ("line", maybe "null" jsonInt (location ^. #line)),+      ("column", maybe "null" jsonInt (location ^. #column))+    ]++-- | Render failures as a versioned deterministic JSON document.+renderErrorsJson :: NonEmpty ConfigError -> Text+renderErrorsJson errors =+  versionedJson+    "settei.errors"+    [("errors", jsonArray (fmap errorJson (NonEmpty.toList errors)))]++errorJson :: ConfigError -> Text+errorJson = \case+  MissingRequired problem ->+    jsonObject+      [ ("kind", jsonString "missing-required"),+        ("key", jsonString (renderKey (problem ^. #key)))+      ]+  DecodeError problem ->+    jsonObject+      [ ("kind", jsonString "decode-error"),+        ("key", jsonString (renderKey (problem ^. #key))),+        ("expected", jsonString (problem ^. #expected)),+        ("origin", originJson (problem ^. #origin)),+        ("rejected", jsonString (renderReportedValue (problem ^. #rejected)))+      ]+  StructuralConflict problem ->+    jsonObject+      [ ("kind", jsonString "structural-conflict"),+        ("key", jsonString (renderKey (problem ^. #key))),+        ("blockedAt", jsonString (renderKey (problem ^. #blockedAt))),+        ("shape", jsonString (rawShapeText (problem ^. #shape))),+        ("origin", originJson (problem ^. #origin))+      ]+  UnknownKeyError problem ->+    jsonObject+      [ ("kind", jsonString "unknown-key"),+        ("key", jsonString (renderKey (problem ^. #key))),+        ("origin", originJson (problem ^. #origin))+      ]+  DefaultError problem ->+    jsonObject+      [ ("kind", jsonString "default-error"),+        ("key", jsonString (renderKey (problem ^. #key))),+        ("rule", jsonString (renderRuleName (problem ^. #rule))),+        ("message", jsonString (problem ^. #message))+      ]+  DefaultCycle problem ->+    jsonObject+      [ ("kind", jsonString "default-cycle"),+        ("rules", jsonArray (fmap (jsonString . renderRuleName) (NonEmpty.toList (problem ^. #rules))))+      ]++-- | Render warnings as a versioned deterministic JSON document.+renderWarningsJson :: [ConfigWarning] -> Text+renderWarningsJson warnings =+  versionedJson+    "settei.warnings"+    [("warnings", jsonArray (fmap warningJson warnings))]++warningJson :: ConfigWarning -> Text+warningJson = \case+  UnknownKeyWarning problem ->+    jsonObject+      [ ("kind", jsonString "unknown-key"),+        ("key", jsonString (renderKey (problem ^. #key))),+        ("origin", originJson (problem ^. #origin))+      ]++outcomeValueText :: ResolutionOutcome -> Text+outcomeValueText = \case+  Resolved value -> renderReportedValue value+  MissingValue -> "<missing>"+  NotSelected -> "<not selected>"++outcomeTag :: ResolutionOutcome -> Text+outcomeTag = \case+  Resolved _ -> "resolved"+  MissingValue -> "missing"+  NotSelected -> "not-selected"++outcomeValueJson :: ResolutionOutcome -> Text+outcomeValueJson = \case+  Resolved value -> jsonString (renderReportedValue value)+  MissingValue -> "null"+  NotSelected -> "null"++requirementText :: Requirement -> Text+requirementText Required = "required"+requirementText Optional = "optional"++presenceText :: Presence -> Text+presenceText Necessary = "necessary"+presenceText Conditional = "conditional"++sensitivityText :: Sensitivity -> Text+sensitivityText Public = "public"+sensitivityText Secret = "secret"++rawShapeText :: RawShape -> Text+rawShapeText NullShape = "null"+rawShapeText ScalarShape = "scalar"+rawShapeText ArrayShape = "array"++sourceKindTag :: SourceKind -> Text+sourceKindTag BuiltInSource = "built-in"+sourceKindTag (FileSource _) = "file"+sourceKindTag EnvironmentSource = "environment"+sourceKindTag CommandLineSource = "command-line"+sourceKindTag DerivedSource = "derived"+sourceKindTag (CustomSource _) = "custom"++sourceKindDetail :: SourceKind -> Maybe Text+sourceKindDetail (FileSource value) = Just value+sourceKindDetail (CustomSource value) = Just value+sourceKindDetail _ = Nothing++commaKeys :: [Key] -> Text+commaKeys = Text.intercalate ", " . fmap renderKey++jsonKeyArray :: [Key] -> Text+jsonKeyArray = jsonArray . fmap (jsonString . renderKey)++jsonTextMap :: Map Text Text -> Text+jsonTextMap =+  jsonObject . fmap (\(key, value) -> (key, jsonString value)) . Map.toAscList++jsonInt :: Int -> Text+jsonInt = Text.pack . show++versionedJson :: Text -> [(Text, Text)] -> Text+versionedJson documentType fields =+  jsonObject+    ( [ ("schemaVersion", "1"),+        ("type", jsonString documentType)+      ]+        <> fields+    )++jsonObject :: [(Text, Text)] -> Text+jsonObject fields =+  "{"+    <> Text.intercalate+      ","+      [jsonString key <> ":" <> value | (key, value) <- fields]+    <> "}"++jsonArray :: [Text] -> Text+jsonArray values = "[" <> Text.intercalate "," values <> "]"++jsonString :: Text -> Text+jsonString value = "\"" <> Text.concatMap escapeJsonChar value <> "\""++escapeJsonChar :: Char -> Text+escapeJsonChar = \case+  '"' -> "\\\""+  '\\' -> "\\\\"+  '\b' -> "\\b"+  '\f' -> "\\f"+  '\n' -> "\\n"+  '\r' -> "\\r"+  '\t' -> "\\t"+  character+    | ord character < 0x20 -> "\\u" <> paddedHex (ord character)+    | otherwise -> Text.singleton character++paddedHex :: Int -> Text+paddedHex value =+  let rendered = Text.pack (showHex value "")+   in Text.replicate (4 - Text.length rendered) "0" <> rendered
+ src/Settei/Report.hs view
@@ -0,0 +1,70 @@+-- |+-- Module: Settei.Report+-- Description: Secret-safe data describing one resolution run.+module Settei.Report+  ( BranchTrace (..),+    Derivation (..),+    ResolutionNode (..),+    ResolutionOutcome (..),+    ResolutionReport (..),+    reportBranches,+    reportNodes,+  )+where++import Data.Generics.Labels ()+import Data.Map.Strict qualified as Map+import Settei.Key (Key)+import Settei.Origin (Origin)+import Settei.Prelude+import Settei.Provenance (ReportedValue)+import Settei.Setting (Sensitivity)++-- | What happened to a statically possible setting in this run.+data ResolutionOutcome+  = Resolved !ReportedValue+  | MissingValue+  | NotSelected+  deriving stock (Generic, Eq, Show)++-- | A named default rule that produced a setting value.+data Derivation = Derivation+  { rule :: !Text,+    explanation :: !Text,+    dependencies :: ![Key]+  }+  deriving stock (Generic, Eq, Show)++-- | One evaluated or skipped setting, keyed independently in the report map.+data ResolutionNode = ResolutionNode+  { key :: !Key,+    sensitivity :: !Sensitivity,+    outcome :: !ResolutionOutcome,+    origin :: !(Maybe Origin),+    shadowed :: ![Origin],+    derivation :: !(Maybe Derivation)+  }+  deriving stock (Generic, Eq, Show)++-- | Whether one selective branch was evaluated for this run.+data BranchTrace = BranchTrace+  { dependencies :: ![Key],+    settings :: ![Key],+    selected :: !Bool+  }+  deriving stock (Generic, Eq, Show)++-- | Complete, secret-safe trace for one successful resolution.+data ResolutionReport = ResolutionReport+  { nodes :: !(Map Key ResolutionNode),+    branches :: ![BranchTrace]+  }+  deriving stock (Generic, Eq, Show)++-- | Return resolution nodes in stable key order.+reportNodes :: ResolutionReport -> [ResolutionNode]+reportNodes value = value ^. #nodes . to Map.elems++-- | Return branch decisions in evaluation order.+reportBranches :: ResolutionReport -> [BranchTrace]+reportBranches value = value ^. #branches
+ src/Settei/Resolve.hs view
@@ -0,0 +1,477 @@+{-# LANGUAGE GADTs #-}++-- |+-- Module: Settei.Resolve+-- Description: Deterministic interpretation of declarations against ordered sources.+module Settei.Resolve+  ( ResolveOptions (..),+    ResolveResult (..),+    UnknownKeyPolicy (..),+    defaultResolveOptions,+    resolve,+  )+where++import Data.Generics.Labels ()+import Data.List.NonEmpty qualified as NonEmpty+import Data.Map.Strict qualified as Map+import Settei.Error+import Settei.Internal.Config+  ( Config (..),+    Default (..),+    Request (..),+    RuleName,+    describeConfig,+    renderRuleName,+  )+import Settei.Internal.Schema (Schema)+import Settei.Key (Key, keySegments)+import Settei.Origin (Origin (..), SourceKind (DerivedSource))+import Settei.Prelude+import Settei.Provenance+  ( Candidate,+    ReportedValue,+    candidateOrigin,+    candidateValue,+    derivedReportedValue,+    reportedValue,+    visibleReportedValue,+  )+import Settei.Report+import Settei.Schema+  ( SchemaSetting,+    schemaPossible,+    schemaSettingKey,+    schemaSettingSensitivity,+  )+import Settei.Setting+  ( Sensitivity (..),+    Setting,+    decodeSetting,+    settingKey,+    settingSensitivity,+    settingValueRenderer,+  )+import Settei.Source (Source, lookupSource, sourceLeaves)+import Settei.Value (decodeFailureExpected)++-- | How undeclared source leaves affect resolution.+data UnknownKeyPolicy = WarnUnknownKeys | RejectUnknownKeys+  deriving stock (Generic, Eq, Ord, Show)++-- | Resolver behavior independent of any source adapter.+data ResolveOptions = ResolveOptions+  { unknownKeyPolicy :: !UnknownKeyPolicy+  }+  deriving stock (Generic, Eq, Show)++-- | The typed result plus its safe explanation and non-fatal diagnostics.+data ResolveResult a = ResolveResult+  { value :: !a,+    report :: !ResolutionReport,+    warnings :: ![ConfigWarning]+  }+  deriving stock (Generic)++-- | Warn about unknown keys while retaining all other default resolver semantics.+defaultResolveOptions :: ResolveOptions+defaultResolveOptions = ResolveOptions {unknownKeyPolicy = WarnUnknownKeys}++-- | Resolve sources ordered from lowest to highest precedence.+--+-- 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)+resolve options sources config =+  case NonEmpty.nonEmpty (validateDefaultCycles config) of+    Just errors -> Left errors+    Nothing -> resolveValidated+  where+    resolveValidated =+      case NonEmpty.nonEmpty structuralErrors of+        Just errors -> Left 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+                  }+    schemaSettings = schemaPossible (describeEvaluation config)+    structuralErrors = validateStructure schemaSettings sources+    evaluation = evaluate sources config+    unknownProblems = findUnknownKeys schemaSettings sources+    unknownWarnings = case options ^. #unknownKeyPolicy of+      WarnUnknownKeys -> fmap UnknownKeyWarning unknownProblems+      RejectUnknownKeys -> []+    strictUnknownErrors = case options ^. #unknownKeyPolicy of+      WarnUnknownKeys -> Right ()+      RejectUnknownKeys -> errorsOnly (fmap UnknownKeyError unknownProblems)+    completeNodes = addNotSelected schemaSettings (evaluation ^. #nodes)++validateStructure :: [SchemaSetting] -> [Source] -> [ConfigError]+validateStructure schemaSettings sources =+  unique+    [ StructuralConflict structuralError+    | schemaSetting <- schemaSettings,+      sourceValue <- sources,+      Left structuralError <- [lookupSource (schemaSettingKey schemaSetting) sourceValue]+    ]++unique :: (Eq a) => [a] -> [a]+unique = foldl appendIfNew []+  where+    appendIfNew values value+      | value `elem` values = values+      | otherwise = values <> [value]++validateDefaultCycles :: Config a -> [ConfigError]+validateDefaultCycles = go []+  where+    go :: [RuleName] -> Config b -> [ConfigError]+    go active = \case+      PureConfig _ -> []+      MapConfig _ config -> go active config+      ApplyConfig function inputConfig -> go active function <> go active inputConfig+      RequestConfig _ -> []+      DefaultConfig _ defaultSpec -> validateDefault active defaultSpec+      SelectConfig selector branch -> go active selector <> go active branch++    validateDefault :: [RuleName] -> Default b -> [ConfigError]+    validateDefault active defaultSpec =+      let rule = defaultRule defaultSpec+       in if rule `elem` active+            then [DefaultCycle (DefaultCycleProblem {rules = cycleRules rule active})]+            else case defaultSpec of+              ConstantDefault _ _ _ -> []+              DerivedDefault _ _ dependency _ -> go (active <> [rule]) dependency+              CaseDefault _ _ dependency _ _ -> go (active <> [rule]) dependency++    cycleRules rule active =+      case NonEmpty.nonEmpty (dropWhile (/= rule) active <> [rule]) of+        Just rules -> rules+        Nothing -> rule :| []++defaultRule :: Default a -> RuleName+defaultRule = \case+  ConstantDefault rule _ _ -> rule+  DerivedDefault rule _ _ _ -> rule+  CaseDefault rule _ _ _ _ -> rule++data Evaluation a = Evaluation+  { answer :: !(Either [ConfigError] a),+    nodes :: !(Map Key ResolutionNode),+    branches :: ![BranchTrace]+  }+  deriving stock (Generic)++evaluate :: [Source] -> Config a -> Evaluation a+evaluate sources = \case+  PureConfig value -> successful value+  MapConfig mapValue config -> mapEvaluation mapValue (evaluate sources config)+  ApplyConfig function inputConfig ->+    applyEvaluation (evaluate sources function) (evaluate sources inputConfig)+  RequestConfig request -> evaluateRequest sources request+  DefaultConfig settingSpec defaultSpec ->+    evaluateDefaultRequest sources settingSpec defaultSpec+  SelectConfig selector branch ->+    let selectorEvaluation = evaluate sources selector+        selectorKeys = Map.keys (selectorEvaluation ^. #nodes)+        branchKeys = fmap schemaSettingKey (schemaPossible (describeEvaluation branch))+     in case selectorEvaluation ^. #answer of+          Left errors -> selectorEvaluation & #answer .~ Left errors+          Right (Right value) ->+            selectorEvaluation+              & #answer+              .~ Right value+              & #branches+              %~ (<> [BranchTrace {dependencies = selectorKeys, settings = branchKeys, selected = False}])+          Right (Left input) ->+            let branchEvaluation = evaluate sources branch+                combined = mapEvaluation ($ input) branchEvaluation+             in Evaluation+                  { answer = combined ^. #answer,+                    nodes = Map.union (selectorEvaluation ^. #nodes) (branchEvaluation ^. #nodes),+                    branches =+                      selectorEvaluation ^. #branches+                        <> branchEvaluation ^. #branches+                        <> [BranchTrace {dependencies = selectorKeys, settings = branchKeys, selected = True}]+                  }++-- | Static inspection implemented locally to keep the raw constructors private from the+-- public resolver surface.+describeEvaluation :: Config a -> Schema+describeEvaluation = describeConfig++evaluateRequest :: [Source] -> Request a -> Evaluation a+evaluateRequest sources = \case+  RequiredRequest settingSpec ->+    case evaluateSetting sources settingSpec of+      SettingAbsent node ->+        failed+          [MissingRequired (MissingProblem {key = settingKey settingSpec})]+          (Map.singleton (settingKey settingSpec) node)+      SettingFailed errors node -> failed errors (Map.singleton (settingKey settingSpec) node)+      SettingPresent value node -> withNode value node+  OptionalRequest settingSpec ->+    case evaluateSetting 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+    SettingFailed errors node -> failed errors (Map.singleton (settingKey settingSpec) node)+    SettingPresent value node -> withNode value node+    SettingAbsent _ -> evaluateFallback sources settingSpec defaultSpec++evaluateFallback :: [Source] -> Setting a -> Default a -> Evaluation a+evaluateFallback sources settingSpec = \case+  ConstantDefault rule explanation value ->+    derivedEvaluation settingSpec rule explanation [] value+  DerivedDefault rule explanation dependency derive ->+    let dependencyEvaluation = evaluate sources dependency+     in case dependencyEvaluation ^. #answer of+          Left errors -> evaluationFailure dependencyEvaluation errors+          Right dependencyValue ->+            derivedFromDependencies+              settingSpec+              rule+              explanation+              dependencyEvaluation+              (derive dependencyValue)+  CaseDefault rule explanation dependency choices fallback ->+    let dependencyEvaluation = evaluate 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+              Nothing -> case fallback of+                Just value ->+                  derivedFromDependencies settingSpec rule explanation dependencyEvaluation value+                Nothing ->+                  evaluationFailure+                    dependencyEvaluation+                    [ DefaultError+                        DefaultProblem+                          { key = settingKey settingSpec,+                            rule,+                            message = "no case matched and no fallback was declared"+                          }+                    ]++derivedFromDependencies ::+  Setting a ->+  RuleName ->+  Text ->+  Evaluation d ->+  a ->+  Evaluation a+derivedFromDependencies settingSpec rule explanation dependencyEvaluation value =+  Evaluation+    { answer = Right value,+      nodes =+        dependencyEvaluation+          ^. #nodes+          & at (settingKey settingSpec)+          ?~ derivedNode 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)++derivedNode :: Setting a -> RuleName -> Text -> [Key] -> a -> ResolutionNode+derivedNode settingSpec rule explanation dependencies value =+  ResolutionNode+    { key = settingKey settingSpec,+      sensitivity = settingSensitivity settingSpec,+      outcome = Resolved (defaultReportedValue settingSpec value),+      origin =+        Just+          Origin+            { kind = DerivedSource,+              name = renderRuleName rule,+              key = settingKey settingSpec,+              location = Nothing,+              annotations = Map.singleton "settei.default-rule" (renderRuleName rule)+            },+      shadowed = [],+      derivation = Just Derivation {rule = renderRuleName rule, explanation, dependencies}+    }++defaultReportedValue :: Setting a -> a -> ReportedValue+defaultReportedValue settingSpec value =+  case settingSensitivity settingSpec of+    Secret -> derivedReportedValue Secret+    Public -> case settingValueRenderer settingSpec of+      Just renderValue -> visibleReportedValue (renderValue value)+      Nothing -> derivedReportedValue Public++evaluationFailure :: Evaluation d -> [ConfigError] -> Evaluation a+evaluationFailure dependencyEvaluation errors =+  Evaluation+    { answer = Left errors,+      nodes = dependencyEvaluation ^. #nodes,+      branches = dependencyEvaluation ^. #branches+    }++data SettingEvaluation a+  = SettingAbsent !ResolutionNode+  | SettingFailed ![ConfigError] !ResolutionNode+  | SettingPresent a !ResolutionNode++evaluateSetting :: [Source] -> Setting a -> SettingEvaluation a+evaluateSetting sources settingSpec =+  case collectCandidates (settingKey settingSpec) sources of+    Left structuralErrors ->+      SettingFailed+        (fmap StructuralConflict structuralErrors)+        (missingNode settingSpec)+    Right [] -> SettingAbsent (missingNode settingSpec)+    Right candidates ->+      let winner = last candidates+          lower = init candidates+          rawValue = candidateValue winner+          node =+            ResolutionNode+              { key = settingKey settingSpec,+                sensitivity = settingSensitivity settingSpec,+                outcome = Resolved (reportedValue (settingSensitivity settingSpec) rawValue),+                origin = Just (candidateOrigin winner),+                shadowed = fmap candidateOrigin (reverse lower),+                derivation = Nothing+              }+       in case decodeSetting settingSpec rawValue of+            Left decodeFailure ->+              SettingFailed+                [ DecodeError+                    DecodeProblem+                      { key = settingKey settingSpec,+                        expected = decodeFailureExpected decodeFailure,+                        origin = candidateOrigin winner,+                        rejected = reportedValue (settingSensitivity settingSpec) rawValue+                      }+                ]+                node+            Right value -> SettingPresent value node++collectCandidates :: Key -> [Source] -> Either [StructuralError] [Candidate]+collectCandidates key sources =+  case foldr collect ([], []) (fmap (lookupSource key) sources) of+    ([], candidates) -> Right candidates+    (errors, _) -> Left errors+  where+    collect (Left structuralError) (errors, candidates) = (structuralError : errors, candidates)+    collect (Right Nothing) result = result+    collect (Right (Just foundCandidate)) (errors, candidates) =+      (errors, foundCandidate : candidates)++missingNode :: Setting a -> ResolutionNode+missingNode settingSpec =+  ResolutionNode+    { key = settingKey settingSpec,+      sensitivity = settingSensitivity settingSpec,+      outcome = MissingValue,+      origin = Nothing,+      shadowed = [],+      derivation = Nothing+    }++withNode :: a -> ResolutionNode -> Evaluation a+withNode value node =+  Evaluation+    { answer = Right value,+      nodes = Map.singleton (node ^. #key) node,+      branches = []+    }++successful :: a -> Evaluation a+successful value = Evaluation {answer = Right value, nodes = Map.empty, branches = []}++failed :: [ConfigError] -> Map Key ResolutionNode -> Evaluation a+failed errors nodes = Evaluation {answer = Left errors, nodes, branches = []}++mapEvaluation :: (a -> b) -> Evaluation a -> Evaluation b+mapEvaluation mapValue evaluation = evaluation & #answer %~ fmap mapValue++applyEvaluation :: Evaluation (a -> b) -> Evaluation a -> Evaluation b+applyEvaluation function inputConfig =+  Evaluation+    { answer = applyAnswer (function ^. #answer) (inputConfig ^. #answer),+      nodes = Map.union (function ^. #nodes) (inputConfig ^. #nodes),+      branches = function ^. #branches <> inputConfig ^. #branches+    }++applyAnswer :: Either [ConfigError] (a -> b) -> Either [ConfigError] a -> Either [ConfigError] b+applyAnswer (Right function) (Right value) = Right (function value)+applyAnswer (Left leftErrors) (Left rightErrors) = Left (leftErrors <> rightErrors)+applyAnswer (Left errors) _ = Left errors+applyAnswer _ (Left errors) = Left errors++findUnknownKeys :: [SchemaSetting] -> [Source] -> [UnknownKeyProblem]+findUnknownKeys schemaSettings = concatMap unknownInSource+  where+    declared = fmap schemaSettingKey schemaSettings+    unknownInSource source =+      [ UnknownKeyProblem {key, origin = candidateOrigin foundCandidate}+      | (key, foundCandidate) <- sourceLeaves source,+        not (any (`declares` key) declared)+      ]++declares :: Key -> Key -> Bool+declares declared leaf =+  NonEmpty.toList (keySegments declared)+    `isPrefixOf` NonEmpty.toList (keySegments leaf)++isPrefixOf :: (Eq a) => [a] -> [a] -> Bool+isPrefixOf [] _ = True+isPrefixOf _ [] = False+isPrefixOf (left : leftRest) (right : rightRest) =+  left == right && isPrefixOf leftRest rightRest++addNotSelected :: [SchemaSetting] -> Map Key ResolutionNode -> Map Key ResolutionNode+addNotSelected schemaSettings existingNodes = foldl addNode existingNodes schemaSettings+  where+    addNode nodes schemaSetting =+      nodes+        & at (schemaSettingKey schemaSetting)+        %~ ( \case+               Just node -> Just node+               Nothing ->+                 Just+                   ResolutionNode+                     { key = schemaSettingKey schemaSetting,+                       sensitivity = schemaSettingSensitivity schemaSetting,+                       outcome = NotSelected,+                       origin = Nothing,+                       shadowed = [],+                       derivation = Nothing+                     }+           )++errorsOnly :: [ConfigError] -> Either [ConfigError] ()+errorsOnly [] = Right ()+errorsOnly errors = Left errors++appendErrors :: Either [ConfigError] a -> Either [ConfigError] () -> Either [ConfigError] a+appendErrors (Right value) (Right ()) = Right value+appendErrors (Left errors) (Right ()) = Left errors+appendErrors (Right _) (Left errors) = Left errors+appendErrors (Left leftErrors) (Left rightErrors) = Left (leftErrors <> rightErrors)++toNonEmpty :: [ConfigError] -> NonEmpty ConfigError+toNonEmpty errors =+  case NonEmpty.nonEmpty errors of+    Just values -> values+    Nothing -> error "Settei.Resolve: impossible empty error collection"
+ src/Settei/Schema.hs view
@@ -0,0 +1,78 @@+-- |+-- Module: Settei.Schema+-- Description: Static setting and branch metadata returned by Settei.Config.describe.+--+-- Possible settings occur somewhere in a declaration. Necessary settings are+-- conservatively known to run on every path. Required versus optional is separate: it+-- controls whether absence is an error when a request actually runs.+module Settei.Schema+  ( Condition,+    Presence (..),+    Requirement (..),+    Schema,+    SchemaSetting,+    conditionDependencies,+    conditionSettings,+    schemaConditions,+    schemaNecessary,+    schemaPossible,+    schemaSettingDescription,+    schemaSettingKey,+    schemaSettingPresence,+    schemaSettingRequirement,+    schemaSettingSensitivity,+  )+where++import Data.Generics.Labels ()+import Data.Map.Strict qualified as Map+import Settei.Internal.Schema+  ( Condition,+    Presence (..),+    Requirement (..),+    Schema,+    SchemaSetting,+  )+import Settei.Key (Key)+import Settei.Prelude+import Settei.Setting (Sensitivity)++-- | Every setting that may be requested, in key order.+schemaPossible :: Schema -> [SchemaSetting]+schemaPossible schema = Map.elems (schema ^. #settings)++-- | Settings evaluated on every execution path, in key order.+schemaNecessary :: Schema -> [SchemaSetting]+schemaNecessary = filter ((== Necessary) . schemaSettingPresence) . schemaPossible++-- | The conservative selective relationships in declaration order.+schemaConditions :: Schema -> [Condition]+schemaConditions schema = schema ^. #conditions++-- | Return a schema entry's validated key.+schemaSettingKey :: SchemaSetting -> Key+schemaSettingKey schemaEntry = schemaEntry ^. #key++-- | Return a schema entry's human-readable purpose.+schemaSettingDescription :: SchemaSetting -> Text+schemaSettingDescription schemaEntry = schemaEntry ^. #description++-- | Return whether reports must redact a schema entry's value.+schemaSettingSensitivity :: SchemaSetting -> Sensitivity+schemaSettingSensitivity schemaEntry = schemaEntry ^. #sensitivity++-- | Return whether absence is an error when this request runs.+schemaSettingRequirement :: SchemaSetting -> Requirement+schemaSettingRequirement schemaEntry = schemaEntry ^. #requirement++-- | Return whether this request is statically necessary or conditional.+schemaSettingPresence :: SchemaSetting -> Presence+schemaSettingPresence schemaEntry = schemaEntry ^. #presence++-- | Return the selector keys on which a condition depends.+conditionDependencies :: Condition -> Set Key+conditionDependencies condition = condition ^. #dependencies++-- | Return the setting keys activated by a condition.+conditionSettings :: Condition -> Set Key+conditionSettings condition = condition ^. #settings
+ src/Settei/Setting.hs view
@@ -0,0 +1,78 @@+-- |+-- Module: Settei.Setting+-- Description: Metadata and decoders for individual configuration settings.+module Settei.Setting+  ( Sensitivity (..),+    Setting,+    decodeSetting,+    publicSetting,+    publicSettingWithRenderer,+    secretSetting,+    settingDescription,+    settingKey,+    settingSensitivity,+    settingValueRenderer,+  )+where++import Data.Generics.Labels ()+import Settei.Key (Key)+import Settei.Prelude+import Settei.Value (DecodeFailure, Decoder, RawValue, runDecoder)++-- | Whether reports may display a setting's resolved value.+data Sensitivity = Public | Secret+  deriving stock (Generic, Eq, Ord, Show)++-- | Metadata and decoding behavior for one logical setting.+--+-- The constructor stays private so callers use the explicit public or secret smart+-- constructors. The type has no 'Show' instance because its decoder will receive raw+-- values that may be sensitive.+data Setting a = Setting+  { key :: !Key,+    description :: !Text,+    sensitivity :: !Sensitivity,+    decoder :: !(Decoder a),+    renderer :: !(Maybe (a -> Text))+  }+  deriving stock (Generic)++-- | Declare a setting whose resolved value may appear in reports.+publicSetting :: Key -> Text -> Decoder a -> Setting a+publicSetting key description decoder =+  Setting {key, description, sensitivity = Public, decoder, renderer = Nothing}++-- | Declare a public setting with a renderer for typed default values.+--+-- Source candidates render directly from 'RawValue'; this renderer is used only after a+-- typed constant or derived default has been evaluated.+publicSettingWithRenderer :: Key -> Text -> Decoder a -> (a -> Text) -> Setting a+publicSettingWithRenderer key description decoder renderer =+  Setting {key, description, sensitivity = Public, decoder, renderer = Just renderer}++-- | 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}++-- | Decode one raw candidate using the setting's validated key.+decodeSetting :: Setting a -> RawValue -> Either DecodeFailure a+decodeSetting settingSpec =+  runDecoder (settingSpec ^. #decoder) (settingSpec ^. #key)++-- | Inspect the setting's key.+settingKey :: Setting a -> Key+settingKey settingSpec = settingSpec ^. #key++-- | Inspect the setting's human-readable purpose.+settingDescription :: Setting a -> Text+settingDescription settingSpec = settingSpec ^. #description++-- | Inspect whether the setting is public or secret.+settingSensitivity :: Setting a -> Sensitivity+settingSensitivity settingSpec = settingSpec ^. #sensitivity++-- | Return the optional renderer for a public typed default.+settingValueRenderer :: Setting a -> Maybe (a -> Text)+settingValueRenderer settingSpec = settingSpec ^. #renderer
+ src/Settei/Source.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE ImportQualifiedPost #-}++-- |+-- Module: Settei.Source+-- Description: Ordered, hierarchical configuration inputs.+module Settei.Source+  ( Source,+    annotateSource,+    annotateSourceAt,+    locateSource,+    lookupSource,+    source,+    sourceAnnotations,+    sourceKind,+    sourceLeaves,+    sourceName,+  )+where++import Data.Generics.Labels ()+import Data.List.NonEmpty qualified as NonEmpty+import Data.Map.Strict qualified as Map+import Settei.Error (RawShape (..), StructuralError (..))+import Settei.Key (Key, keySegments, mkKey)+import Settei.Origin (Origin (..), SourceKind, SourceLocation)+import Settei.Prelude+import Settei.Provenance (Candidate, candidate)+import Settei.Value (RawValue (..))++-- | A reusable source tree. Precedence is supplied by its position in @[Source]@.+--+-- There is deliberately no 'Show' instance because 'root' may contain secrets.+data Source = Source+  { name :: !Text,+    kind :: !SourceKind,+    root :: !RawValue,+    locationAt :: !(Key -> Maybe SourceLocation),+    annotationsAt :: !(Key -> Map Text Text),+    annotations :: !(Map Text Text)+  }+  deriving stock (Generic)++-- | Construct a source with no retained locations or annotations.+source :: Text -> SourceKind -> RawValue -> Source+source name kind root =+  Source+    { name,+      kind,+      root,+      locationAt = const Nothing,+      annotationsAt = const Map.empty,+      annotations = Map.empty+    }++-- | Attach adapter-specific descriptive metadata. It never changes precedence.+annotateSource :: Map Text Text -> Source -> Source+annotateSource annotations sourceValue = sourceValue & #annotations .~ annotations++-- | Attach descriptive metadata for individual keys.+--+-- Later calls compose with earlier hooks. New per-key entries take precedence over+-- earlier per-key and source-wide entries with the same annotation name.+annotateSourceAt :: (Key -> Map Text Text) -> Source -> Source+annotateSourceAt additions sourceValue =+  sourceValue+    & #annotationsAt+    %~ \existing key -> additions key <> existing key++-- | Attach exact-key locations retained by an adapter parser.+locateSource :: (Key -> Maybe SourceLocation) -> Source -> Source+locateSource locationAt sourceValue = sourceValue & #locationAt .~ locationAt++-- | Return a source's stable descriptive name.+sourceName :: Source -> Text+sourceName value = value ^. #name++-- | Return a source's format-independent category.+sourceKind :: Source -> SourceKind+sourceKind value = value ^. #kind++-- | Return descriptive annotations shared by every candidate from the source.+sourceAnnotations :: Source -> Map Text Text+sourceAnnotations value = value ^. #annotations++-- | Look up one exact structural key.+--+-- A scalar or array is a valid value at the final segment. Traversing through one is a+-- structural error; dotted textual prefix tricks are never used.+lookupSource :: Key -> Source -> Either StructuralError (Maybe Candidate)+lookupSource target sourceValue =+  walk [] (NonEmpty.toList (keySegments target)) (sourceValue ^. #root)+  where+    walk _ [] rawValue = Right (Just (candidate rawValue (originFor target sourceValue)))+    walk prefix (segment : rest) rawValue = case rawValue of+      RawObject object ->+        case Map.lookup segment object of+          Nothing -> Right Nothing+          Just child -> walk (prefix <> [segment]) rest child+      RawNull -> Left (blocked prefix NullShape)+      RawArray _ -> Left (blocked prefix ArrayShape)+      RawText _ -> Left (blocked prefix ScalarShape)+      RawBool _ -> Left (blocked prefix ScalarShape)+      RawNumber _ -> Left (blocked prefix ScalarShape)++    blocked prefix shape =+      StructuralError+        { key = target,+          blockedAt = prefixKey target prefix,+          origin = originFor (prefixKey target prefix) sourceValue,+          shape+        }++-- | Enumerate addressable leaves in key order for unknown-key diagnostics.+--+-- Arrays and scalars are whole leaves. Empty objects contain no leaves.+sourceLeaves :: Source -> [(Key, Candidate)]+sourceLeaves sourceValue = go [] (sourceValue ^. #root)+  where+    go prefix = \case+      RawObject object ->+        concatMap+          (\(segment, rawValue) -> go (prefix <> [segment]) rawValue)+          (Map.toAscList object)+      rawValue -> case NonEmpty.nonEmpty prefix of+        Nothing -> []+        Just segments -> case mkKey segments of+          Left _ -> []+          Right key -> [(key, candidate rawValue (originFor key sourceValue))]++originFor :: Key -> Source -> Origin+originFor key sourceValue =+  Origin+    { kind = sourceValue ^. #kind,+      name = sourceValue ^. #name,+      key,+      location = (sourceValue ^. #locationAt) key,+      annotations =+        (sourceValue ^. #annotationsAt) key+          <> sourceValue ^. #annotations+    }++prefixKey :: Key -> [Text] -> Key+prefixKey target prefix =+  case NonEmpty.nonEmpty prefix >>= either (const Nothing) Just . mkKey of+    Just key -> key+    Nothing -> target
+ src/Settei/Value.hs view
@@ -0,0 +1,128 @@+-- |+-- Module: Settei.Value+-- Description: Parser-neutral raw values and secret-safe typed decoders.+module Settei.Value+  ( RawValue (..),+    DecodeFailure,+    Decoder,+    boolDecoder,+    boundedIntegralDecoder,+    enumDecoder,+    decodeFailure,+    decodeFailureExpected,+    decoder,+    renderDecodeFailure,+    runDecoder,+    textDecoder,+  )+where++import Data.Generics.Labels ()+import Data.Ratio qualified as Ratio+import Data.Text qualified as Text+import Data.Text.Read qualified as TextRead+import Settei.Key (Key, renderKey)+import Settei.Prelude++-- | The parser-neutral value tree produced by source adapters.+--+-- 'RawValue' deliberately has no 'Show' instance: it may contain a secret before a+-- setting decoder has had a chance to redact it.+data RawValue+  = RawNull+  | RawText !Text+  | RawBool !Bool+  | RawNumber !Rational+  | RawArray ![RawValue]+  | RawObject !(Map Text RawValue)+  deriving stock (Generic, Eq)++-- | A secret-safe explanation of what a decoder expected.+--+-- The rejected raw input is intentionally absent.+data DecodeFailure = DecodeFailure+  { key :: !Key,+    expected :: !Text+  }+  deriving stock (Generic, Eq, Show)++-- | A reusable decoder that receives the owning setting key for safe errors.+newtype Decoder a = Decoder+  { decode :: Key -> RawValue -> Either DecodeFailure a+  }+  deriving stock (Generic)++-- | Construct a decoder whose failures carry only safe expectation metadata.+decoder :: (Key -> RawValue -> Either DecodeFailure a) -> Decoder a+decoder decode = Decoder {decode}++-- | Construct a rejection without retaining the rejected raw value.+decodeFailure :: Key -> Text -> DecodeFailure+decodeFailure key expected = DecodeFailure {key, expected}++-- | Inspect the safe expectation text for a failed decode.+decodeFailureExpected :: DecodeFailure -> Text+decodeFailureExpected value = value ^. #expected++-- | Run a decoder for one setting key.+runDecoder :: Decoder a -> Key -> RawValue -> Either DecodeFailure a+runDecoder value = value ^. #decode++-- | Decode a text scalar.+textDecoder :: Decoder Text+textDecoder = Decoder $ \key -> \case+  RawText value -> Right value+  _ -> failure key "text"++-- | Decode a boolean scalar or an exact, case-insensitive textual boolean.+boolDecoder :: Decoder Bool+boolDecoder = Decoder $ \key -> \case+  RawBool value -> Right value+  RawText value -> case Text.toCaseFold value of+    "true" -> Right True+    "false" -> Right False+    _ -> failure key "boolean"+  _ -> failure key "boolean"++-- | Decode a whole number that fits the requested bounded integral type.+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"++-- | Decode one of a finite set of exact text spellings.+enumDecoder :: [(Text, a)] -> Decoder a+enumDecoder choices = Decoder $ \key -> \case+  RawText value ->+    maybe+      (failure key expectedValues)+      Right+      (lookup value choices)+  _ -> failure key expectedValues+  where+    names = fmap fst choices+    expectedValues = case names of+      [] -> "an allowed value"+      _ -> "one of " <> Text.intercalate ", " names++-- | Render a failure without including the rejected value.+renderDecodeFailure :: DecodeFailure -> Text+renderDecodeFailure value =+  renderKey (value ^. #key) <> ": expected " <> value ^. #expected++failure :: Key -> Text -> Either DecodeFailure a+failure key expected = Left DecodeFailure {key, expected}++integralValue :: RawValue -> Maybe Integer+integralValue = \case+  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
+ test/Main.hs view
@@ -0,0 +1,24 @@+module Main (main) where++import Settei.ConfigTest qualified as ConfigTest+import Settei.DefaultTest qualified as DefaultTest+import Settei.KeyTest qualified as KeyTest+import Settei.RenderTest qualified as RenderTest+import Settei.ResolveTest qualified as ResolveTest+import Settei.SourceTest qualified as SourceTest+import Settei.ValueTest qualified as ValueTest+import Test.Tasty (defaultMain, testGroup)++main :: IO ()+main =+  defaultMain $+    testGroup+      "Settei"+      [ KeyTest.tests,+        ValueTest.tests,+        ConfigTest.tests,+        SourceTest.tests,+        ResolveTest.tests,+        DefaultTest.tests,+        RenderTest.tests+      ]
+ test/Settei/ConfigTest.hs view
@@ -0,0 +1,95 @@+module Settei.ConfigTest (tests) where++import Control.Selective (select)+import Data.Bifunctor (first)+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+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, (@?=))++tests :: TestTree+tests =+  testGroup+    "Settei.Config"+    [ testCase "applicative settings are necessary" $ do+        let schema = describe ((,) <$> required environmentSetting <*> required passwordSetting)+        keySet (schemaNecessary schema)+          @?= Set.fromList [environmentKey, passwordKey],+      testCase "selective production secret is conditional" $ do+        let schema = describe productionOnly+        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)),+      testCase "free-selective prototype agrees on possible effects" $+        Set.fromList (freePossibleKeys environmentKey passwordKey)+          @?= Set.fromList [environmentKey, passwordKey],+      testCase "free-selective prototype agrees on necessary effects" $+        Set.fromList (freeNecessaryKeys environmentKey passwordKey)+          @?= Set.singleton environmentKey,+      testCase "development skips production secret" $+        runConfig (interpret developmentValues) productionOnly+          @?= Right Nothing,+      testCase "production requests its secret" $+        runConfig (interpret productionValues) productionOnly+          @?= Left (Missing passwordKey)+    ]++data RuntimeError+  = Missing !Key+  | Decode !DecodeFailure+  deriving stock (Generic, Eq, Show)++productionOnly :: Config (Maybe Text)+productionOnly = select selector productionBranch+  where+    selector =+      (\environment -> if environment == "production" then Left () else Right Nothing)+        <$> required environmentSetting+    productionBranch = (\password _ -> Just password) <$> required passwordSetting++interpret :: Map Key RawValue -> Request a -> Either RuntimeError a+interpret values = \case+  RequiredRequest settingSpec ->+    case Map.lookup (settingKey settingSpec) values of+      Nothing -> Left (Missing (settingKey settingSpec))+      Just rawValue -> first Decode (decodeSetting settingSpec rawValue)+  OptionalRequest settingSpec ->+    case Map.lookup (settingKey settingSpec) values of+      Nothing -> Right Nothing+      Just rawValue -> Just <$> first Decode (decodeSetting settingSpec rawValue)++developmentValues :: Map Key RawValue+developmentValues = Map.singleton environmentKey (RawText "development")++productionValues :: Map Key RawValue+productionValues = Map.singleton environmentKey (RawText "production")++environmentSetting :: Setting Text+environmentSetting =+  publicSetting environmentKey "Runtime environment" textDecoder++passwordSetting :: Setting Text+passwordSetting =+  secretSetting passwordKey "Database password" textDecoder++environmentKey :: Key+environmentKey = validKey "runtime.environment"++passwordKey :: Key+passwordKey = validKey "database.password"++validKey :: Text -> Key+validKey value = either (error . show) id (parseKey value)++keySet :: [SchemaSetting] -> Set Key+keySet = Set.fromList . fmap schemaSettingKey
+ test/Settei/DefaultTest.hs view
@@ -0,0 +1,210 @@+{-# LANGUAGE ImportQualifiedPost #-}++module Settei.DefaultTest (tests) where++import Data.Generics.Labels ()+import Data.List.NonEmpty qualified as NonEmpty+import Data.Map.Strict qualified as Map+import Data.Text qualified as Text+import Settei+import Settei.Prelude+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "Settei.Default"+    [ testCase "constant default resolves without a source" $ do+        result <- expectSuccess (resolve defaultResolveOptions [] constantPort)+        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+        case result ^. #report . #nodes . at servicePort of+          Just node -> case node ^. #derivation of+            Just derivation -> do+              derivation ^. #rule @?= "service-port-by-environment"+              derivation ^. #dependencies @?= [runtimeEnvironment]+              case node ^. #outcome of+                Resolved displayValue -> renderReportedValue displayValue @?= "443"+                _ -> fail "expected a resolved default value"+            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+        case result ^. #report . #nodes . at runtimeEnvironment of+          Just node -> node ^. #outcome @?= NotSelected+          Nothing -> fail "expected the skipped dependency in the report"+        case result ^. #report . #nodes . at servicePort of+          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+          Left errors -> case NonEmpty.toList errors of+            [DefaultError problem] -> do+              problem ^. #key @?= servicePort+              problem ^. #rule @?= RuleName "service-port-by-environment"+            _ -> fail "expected one default error"+          Right _ -> fail "expected the case default to fail",+      testCase "a case fallback handles values outside the finite table" $ do+        let withFallback =+              withDefault+                portSetting+                ( caseDefault+                    (RuleName "port-with-fallback")+                    "Use a fallback outside known environments"+                    (required environmentSetting)+                    ((Development, 8080) :| [])+                    (Just 9000)+                )+        result <- expectSuccess (resolve defaultResolveOptions [environmentSource Staging] withFallback)+        result ^. #value @?= 9000,+      testCase "default dependencies remain conditional in the static schema" $ do+        let schema = describe casePort+            necessaryKeys = fmap schemaSettingKey (schemaNecessary schema)+        necessaryKeys @?= [servicePort]+        case filter ((== servicePort) . schemaSettingKey) (schemaPossible schema) of+          [portSchema] -> schemaSettingRequirement portSchema @?= Optional+          _ -> fail "expected one port schema entry",+      testCase "cyclic defaults fail before source evaluation" $ do+        case resolve defaultResolveOptions [poisonSource] cyclicA 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"+    ]++data Environment = Development | Test | Staging | Production+  deriving stock (Generic, Eq, Ord, Show)++constantPort :: Config Int+constantPort =+  withDefault+    portSetting+    (constantDefault (RuleName "built-in-port") "Built-in service port" 8080)++casePort :: Config Int+casePort =+  withDefault+    portSetting+    ( caseDefault+        (RuleName "service-port-by-environment")+        "Choose the conventional port for the runtime environment"+        (required environmentSetting)+        ((Development, 8080) :| [(Test, 8081), (Production, 443)])+        Nothing+    )++cyclicA :: Config Text+cyclicA =+  withDefault+    cycleASetting+    (derivedDefault (RuleName "cycle-a") "Depends on cycle B" cyclicB id)++cyclicB :: Config Text+cyclicB =+  withDefault+    cycleBSetting+    (derivedDefault (RuleName "cycle-b") "Depends on cycle A" cyclicA id)++portSetting :: Setting Int+portSetting =+  publicSettingWithRenderer+    servicePort+    "Service port"+    boundedIntegralDecoder+    (Text.pack . show)++environmentSetting :: Setting Environment+environmentSetting =+  publicSetting+    runtimeEnvironment+    "Runtime environment"+    ( enumDecoder+        [ ("development", Development),+          ("test", Test),+          ("staging", Staging),+          ("production", Production)+        ]+    )++cycleASetting :: Setting Text+cycleASetting = publicSetting cycleAKey "Cycle A" textDecoder++cycleBSetting :: Setting Text+cycleBSetting = publicSetting cycleBKey "Cycle B" textDecoder++environmentSource :: Environment -> Source+environmentSource environment =+  source+    "environment"+    EnvironmentSource+    ( RawObject+        ( Map.singleton+            "runtime"+            (RawObject (Map.singleton "environment" (RawText (environmentText environment))))+        )+    )++portSource :: Int -> Source+portSource value =+  source+    "command-line"+    CommandLineSource+    ( RawObject+        ( Map.singleton+            "service"+            (RawObject (Map.singleton "port" (RawNumber (fromIntegral value))))+        )+    )++poisonSource :: Source+poisonSource =+  locateSource+    (const (error "a cyclic default attempted to inspect a source"))+    ( source+        "poison"+        (CustomSource "test")+        ( RawObject+            ( Map.fromList+                [ ("cycle-a", RawText "unused"),+                  ("cycle-b", RawText "unused")+                ]+            )+        )+    )++environmentText :: Environment -> Text+environmentText Development = "development"+environmentText Test = "test"+environmentText Staging = "staging"+environmentText Production = "production"++expectSuccess :: Either (NonEmpty ConfigError) a -> IO a+expectSuccess = \case+  Left _ -> fail "expected successful resolution"+  Right value -> pure value++servicePort :: Key+servicePort = validKey "service.port"++runtimeEnvironment :: Key+runtimeEnvironment = validKey "runtime.environment"++cycleAKey :: Key+cycleAKey = validKey "cycle-a"++cycleBKey :: Key+cycleBKey = validKey "cycle-b"++validKey :: Text -> Key+validKey value = either (error . show) id (parseKey value)
+ test/Settei/KeyTest.hs view
@@ -0,0 +1,24 @@+module Settei.KeyTest (tests) where++import Settei.Key+import Settei.Prelude+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "Settei.Key"+    [ testCase "dotted keys round-trip" $ do+        (renderKey <$> parseKey "database.pool.size")+          @?= Right "database.pool.size",+      testCase "empty keys are rejected" $+        parseKey "" @?= Left KeyIsEmpty,+      testCase "empty middle segments are rejected" $+        parseKey "database..size" @?= Left KeySegmentIsEmpty,+      testCase "empty leading segments are rejected" $+        parseKey ".database" @?= Left KeySegmentIsEmpty,+      testCase "structural segments cannot contain dots" $+        mkKey ("database.name" :| [])+          @?= Left (KeySegmentContainsDot "database.name")+    ]
+ test/Settei/Prototype/Free.hs view
@@ -0,0 +1,38 @@+module Settei.Prototype.Free+  ( freeNecessaryKeys,+    freePossibleKeys,+  )+where++import Control.Selective (select)+import Control.Selective.Free+  ( Select,+    getEffects,+    getNecessaryEffects,+    liftSelect,+  )+import Settei.Key (Key)+import Settei.Prelude++data Probe a = Probe !Key a+  deriving stock (Generic)++instance Functor Probe where+  fmap mapValue (Probe key value) = Probe key (mapValue value)++freePossibleKeys :: Key -> Key -> [Key]+freePossibleKeys environment password =+  fmap probeKey (getEffects (prototype environment password))++freeNecessaryKeys :: Key -> Key -> [Key]+freeNecessaryKeys environment password =+  fmap probeKey (getNecessaryEffects (prototype environment password))++prototype :: Key -> Key -> Select Probe ()+prototype environment password =+  select+    (liftSelect (Probe environment (Left ())))+    (liftSelect (Probe password id))++probeKey :: Probe a -> Key+probeKey (Probe key _) = key
+ test/Settei/RenderTest.hs view
@@ -0,0 +1,245 @@+{-# LANGUAGE ImportQualifiedPost #-}++module Settei.RenderTest (tests) where++import Data.Generics.Labels ()+import Data.Map.Strict qualified as Map+import Data.Text qualified as Text+import Data.Text.IO qualified as TextIO+import Settei+import Settei.Prelude+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "Settei.Render"+    [ testCase "schema text matches its golden snapshot" $+        assertGolden "test/golden/schema.txt" (renderSchemaText snapshotSchema),+      testCase "schema JSON matches its versioned golden snapshot" $+        assertGolden "test/golden/schema.json" (renderSchemaJson snapshotSchema),+      testCase "resolution text matches its golden snapshot" $+        assertGolden "test/golden/resolution.txt" (renderResolutionText snapshotReport),+      testCase "resolution JSON matches its versioned golden snapshot" $+        assertGolden "test/golden/resolution.json" (renderResolutionJson snapshotReport),+      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 ()))+        assertGolden "test/golden/warnings.txt" (renderWarningsText (result ^. #warnings))+        assertGolden "test/golden/warnings.json" (renderWarningsJson (result ^. #warnings)),+      testCase "renderers distinguish missing from not selected" $ do+        let textOutput = renderResolutionText absentReport+            jsonOutput = renderResolutionJson absentReport+        assertBool "text omitted the missing outcome" ("<missing>" `Text.isInfixOf` textOutput)+        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+    ]++assertGolden :: FilePath -> Text -> IO ()+assertGolden path actual = do+  expected <- Text.stripEnd <$> TextIO.readFile path+  Text.stripEnd actual @?= expected++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 report = success ^. #report+      warnings = warningResult ^. #warnings+      outputs =+        [ renderSchemaText (describe (required secretTextSetting)),+          renderSchemaJson (describe (required secretTextSetting)),+          renderResolutionText report,+          renderResolutionJson report,+          renderErrorsText errors,+          renderErrorsJson errors,+          renderWarningsText warnings,+          renderWarningsJson warnings,+          Text.pack (show report),+          Text.pack (show errors),+          Text.pack (show warnings)+        ]+  assertBool+    "a secret sentinel reached a supported output"+    (all (not . Text.isInfixOf secretSentinel) outputs)+  assertBool "decode error did not show a redaction marker" $+    "<redacted>" `Text.isInfixOf` renderErrorsText errors++expectSuccess :: Either (NonEmpty ConfigError) a -> IO a+expectSuccess = \case+  Left _ -> fail "expected successful resolution"+  Right value -> pure value++expectFailure :: Either (NonEmpty ConfigError) a -> IO (NonEmpty ConfigError)+expectFailure = \case+  Left errors -> pure errors+  Right _ -> fail "expected resolution to fail"++snapshotSchema :: Schema+snapshotSchema = describe (required passwordSetting)++snapshotReport :: ResolutionReport+snapshotReport =+  ResolutionReport+    { nodes =+        Map.fromList+          [ (databasePassword, passwordNode),+            (runtimeEnvironment, environmentNode),+            (servicePort, portNode)+          ],+      branches = []+    }++passwordNode :: ResolutionNode+passwordNode =+  ResolutionNode+    { key = databasePassword,+      sensitivity = Secret,+      outcome = Resolved (reportedValue Secret (RawText secretSentinel)),+      origin = Just (environmentOrigin databasePassword "DATABASE_PASSWORD"),+      shadowed = [],+      derivation = Nothing+    }++environmentNode :: ResolutionNode+environmentNode =+  ResolutionNode+    { key = runtimeEnvironment,+      sensitivity = Public,+      outcome = Resolved (reportedValue Public (RawText "Production")),+      origin = Just (environmentOrigin runtimeEnvironment "HASKELL_ENV"),+      shadowed = [],+      derivation = Nothing+    }++portNode :: ResolutionNode+portNode =+  ResolutionNode+    { key = servicePort,+      sensitivity = Public,+      outcome = Resolved (visibleReportedValue "443"),+      origin = Just defaultOrigin,+      shadowed = [builtInOrigin],+      derivation =+        Just+          Derivation+            { rule = "service-port-by-environment",+              explanation = "Choose the conventional production port",+              dependencies = [runtimeEnvironment]+            }+    }++absentReport :: ResolutionReport+absentReport =+  ResolutionReport+    { nodes =+        Map.fromList+          [ ( databasePassword,+              ResolutionNode+                { key = databasePassword,+                  sensitivity = Secret,+                  outcome = NotSelected,+                  origin = Nothing,+                  shadowed = [],+                  derivation = Nothing+                }+            ),+            ( servicePort,+              ResolutionNode+                { key = servicePort,+                  sensitivity = Public,+                  outcome = MissingValue,+                  origin = Nothing,+                  shadowed = [],+                  derivation = Nothing+                }+            )+          ],+      branches =+        [ BranchTrace+            { dependencies = [runtimeEnvironment],+              settings = [databasePassword],+              selected = False+            }+        ]+    }++environmentOrigin :: Key -> Text -> Origin+environmentOrigin key variable =+  Origin+    { kind = EnvironmentSource,+      name = "environment",+      key,+      location = Nothing,+      annotations = Map.singleton "environment.variable" variable+    }++defaultOrigin :: Origin+defaultOrigin =+  Origin+    { kind = DerivedSource,+      name = "service-port-by-environment",+      key = servicePort,+      location = Nothing,+      annotations = Map.singleton "settei.default-rule" "service-port-by-environment"+    }++builtInOrigin :: Origin+builtInOrigin =+  Origin+    { kind = BuiltInSource,+      name = "built-in",+      key = servicePort,+      location = Nothing,+      annotations = Map.empty+    }++passwordSetting :: Setting Text+passwordSetting = secretSetting databasePassword "Database password" textDecoder++secretTextSetting :: Setting Text+secretTextSetting = secretSetting databasePassword "Database password" textDecoder++secretBoolSetting :: Setting Bool+secretBoolSetting = secretSetting databasePassword "Database password" boolDecoder++secretSource :: Source+secretSource =+  source+    "environment"+    EnvironmentSource+    ( RawObject+        ( Map.singleton+            "database"+            (RawObject (Map.singleton "password" (RawText secretSentinel)))+        )+    )++unknownSecretSource :: Source+unknownSecretSource =+  source+    "document"+    (FileSource "memory")+    (RawObject (Map.singleton "unknown" (RawText secretSentinel)))++secretSentinel :: Text+secretSentinel = "S3cr3t-\"\\\n-[]{}-雪"++databasePassword :: Key+databasePassword = validKey "database.password"++runtimeEnvironment :: Key+runtimeEnvironment = validKey "runtime.environment"++servicePort :: Key+servicePort = validKey "service.port"++validKey :: Text -> Key+validKey value = either (error . show) id (parseKey value)
+ test/Settei/ResolveTest.hs view
@@ -0,0 +1,247 @@+{-# LANGUAGE ImportQualifiedPost #-}++module Settei.ResolveTest (tests) where++import Control.Selective (select)+import Data.Generics.Labels ()+import Data.List (permutations)+import Data.List.NonEmpty qualified as NonEmpty+import Data.Map.Strict qualified as Map+import Settei+import Settei.Prelude+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "Settei.Resolve"+    [ testCase "rightmost source wins per leaf" $ do+        result <- expectSuccess (resolve defaultResolveOptions layeredSources serviceConfig)+        result ^. #value @?= ("file.example", 443)+        let nodes = result ^. #report . #nodes+        case nodes ^. at serviceHost of+          Just node -> do+            fmap (^. #name) (node ^. #origin) @?= Just "file"+            fmap (^. #name) (node ^. #shadowed) @?= ["built-in"]+          Nothing -> fail "expected host report node"+        case nodes ^. at servicePort of+          Just node -> do+            fmap (^. #name) (node ^. #origin) @?= Just "environment"+            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),+      testCase "shadowed origins are ordered from highest to lowest precedence" $ do+        result <- expectSuccess (resolve defaultResolveOptions (fmap snd lawSources) (required portSetting))+        case result ^. #report . #nodes . at servicePort of+          Just node -> fmap (^. #name) (node ^. #shadowed) @?= ["two", "one"]+          Nothing -> fail "expected the port resolution node",+      testCase "rightmost-wins law holds for every three-source ordering" $+        mapM_ checkOrdering (permutations lawSources),+      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+          Left errors -> case NonEmpty.toList errors of+            [DecodeError problem] -> do+              problem ^. #key @?= servicePort+              problem ^. #origin . #name @?= "higher"+            _ -> fail "expected one decode error"+          Right _ -> fail "expected the malformed winner to fail",+      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"],+      testCase "unknown keys warn by default and can be promoted" $ do+        let values =+              RawObject+                ( Map.fromList+                    [ ("known", RawText "yes"),+                      ("typo", RawText "unused")+                    ]+                )+            input = source "document" (FileSource "memory") values+            declaration = required knownSetting+        result <- expectSuccess (resolve defaultResolveOptions [input] declaration)+        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+          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+          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+        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] -> 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+          Left errors -> fmap errorKey (NonEmpty.toList errors) @?= [databasePassword]+          Right _ -> fail "production should require a password",+      testCase "structural conflicts are rejected even under an unselected branch" $ do+        let development = environmentSource "development"+            conflicting =+              source+                "conflicting"+                (FileSource "memory")+                (RawObject (Map.singleton "database" (RawText "not-an-object")))+        case resolve defaultResolveOptions [development, conflicting] productionPassword 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"+    ]++checkOrdering :: [(Int, Source)] -> IO ()+checkOrdering orderedSources = do+  result <-+    expectSuccess+      (resolve defaultResolveOptions (fmap snd orderedSources) (required portSetting))+  result ^. #value @?= fst (last orderedSources)++lawSources :: [(Int, Source)]+lawSources =+  [ (1001, treeSource "one" (RawNumber 1001) Map.empty),+    (2002, treeSource "two" (RawNumber 2002) Map.empty),+    (3003, treeSource "three" (RawNumber 3003) Map.empty)+  ]++expectSuccess :: Either (NonEmpty ConfigError) a -> IO a+expectSuccess = \case+  Left _ -> fail "expected successful resolution"+  Right value -> pure value++errorKey :: ConfigError -> Key+errorKey = \case+  MissingRequired problem -> problem ^. #key+  DecodeError problem -> problem ^. #key+  StructuralConflict problem -> problem ^. #key+  UnknownKeyError problem -> problem ^. #key+  DefaultError problem -> problem ^. #key+  DefaultCycle _ -> error "a cycle has no single setting key"++serviceConfig :: Config (Text, Int)+serviceConfig = (,) <$> required hostSetting <*> required portSetting++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++hostSetting :: Setting Text+hostSetting = publicSetting serviceHost "Service host" textDecoder++portSetting :: Setting Int+portSetting = publicSetting servicePort "Service port" boundedIntegralDecoder++hostsSetting :: Setting [Text]+hostsSetting = publicSetting serviceHosts "Service hosts" textArrayDecoder++knownSetting :: Setting Text+knownSetting = publicSetting knownKey "Known value" textDecoder++environmentSetting :: Setting Text+environmentSetting = publicSetting runtimeEnvironment "Runtime environment" textDecoder++passwordSetting :: Setting Text+passwordSetting = secretSetting databasePassword "Database password" textDecoder++textArrayDecoder :: Decoder [Text]+textArrayDecoder = decoder $ \key -> \case+  RawArray values -> traverse (decodeOne key) values+  _ -> Left (decodeFailure key "array of text")+  where+    decodeOne _ (RawText value) = Right value+    decodeOne key _ = Left (decodeFailure key "array of text")++layeredSources :: [Source]+layeredSources =+  [ treeSource "built-in" (RawNumber 8080) (Map.singleton "host" (RawText "built-in.example")),+    source+      "file"+      (FileSource "memory")+      (RawObject (Map.singleton "service" (RawObject (Map.singleton "host" (RawText "file.example"))))),+    treeSource "environment" (RawNumber 443) Map.empty+  ]++treeSource :: Text -> RawValue -> Map Text RawValue -> Source+treeSource name portValue extraServiceValues =+  source+    name+    (CustomSource "test")+    ( RawObject+        ( Map.singleton+            "service"+            (RawObject (extraServiceValues & at "port" ?~ portValue))+        )+    )++arraySource :: Text -> [Text] -> Source+arraySource name values =+  source+    name+    (CustomSource "test")+    ( RawObject+        ( Map.singleton+            "service"+            (RawObject (Map.singleton "hosts" (RawArray (fmap RawText values))))+        )+    )++environmentSource :: Text -> Source+environmentSource value =+  source+    "environment"+    EnvironmentSource+    ( RawObject+        ( Map.singleton+            "runtime"+            (RawObject (Map.singleton "environment" (RawText value)))+        )+    )++serviceHost :: Key+serviceHost = validKey "service.host"++servicePort :: Key+servicePort = validKey "service.port"++serviceHosts :: Key+serviceHosts = validKey "service.hosts"++runtimeEnvironment :: Key+runtimeEnvironment = validKey "runtime.environment"++databasePassword :: Key+databasePassword = validKey "database.password"++knownKey :: Key+knownKey = validKey "known"++typoKey :: Key+typoKey = validKey "typo"++validKey :: Text -> Key+validKey value = either (error . show) id (parseKey value)
+ test/Settei/SourceTest.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE ImportQualifiedPost #-}++module Settei.SourceTest (tests) where++import Data.Generics.Labels ()+import Data.Map.Strict qualified as Map+import Settei+import Settei.Prelude+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "Settei.Source"+    [ testCase "hierarchical keys traverse objects by segment" $ do+        let result = lookupSource servicePort sampleSource+        case result of+          Right (Just found) -> do+            assertBool "expected the nested port" (candidateValue found == RawNumber 8080)+            candidateOrigin found ^. #key @?= servicePort+          _ -> fail "expected one candidate",+      testCase "arrays are values at their exact declared key" $ do+        let result = lookupSource serviceHosts sampleSource+        case result of+          Right (Just found) ->+            assertBool+              "expected the complete array"+              (candidateValue found == RawArray [RawText "one", RawText "two"])+          _ -> fail "expected one array candidate",+      testCase "traversal through a scalar is a structural error" $ do+        let result = lookupSource servicePortChild sampleSource+        case result of+          Left structuralError -> do+            structuralError ^. #key @?= servicePortChild+            structuralError ^. #blockedAt @?= servicePort+            structuralError ^. #shape @?= ScalarShape+          _ -> fail "expected a structural error",+      testCase "leaf enumeration is ordered and treats arrays wholesale" $+        fmap (renderKey . fst) (sourceLeaves sampleSource)+          @?= ["service.hosts", "service.port"],+      testCase "per-key annotations reach only their matching origins" $ do+        let annotated =+              annotateSourceAt+                (\key -> if key == servicePort then Map.singleton "environment.variable" "PORT" else Map.empty)+                sampleSource+        case (lookupSource servicePort annotated, lookupSource serviceHosts annotated) of+          (Right (Just port), Right (Just hosts)) -> do+            port ^. to candidateOrigin . #annotations . at "environment.variable" @?= Just "PORT"+            hosts ^. to candidateOrigin . #annotations . at "environment.variable" @?= Nothing+          _ -> fail "expected both annotated source candidates"+    ]++sampleSource :: Source+sampleSource =+  source+    "built-in"+    BuiltInSource+    ( RawObject+        ( Map.singleton+            "service"+            ( RawObject+                ( Map.fromList+                    [ ("hosts", RawArray [RawText "one", RawText "two"]),+                      ("port", RawNumber 8080)+                    ]+                )+            )+        )+    )++servicePort :: Key+servicePort = validKey "service.port"++serviceHosts :: Key+serviceHosts = validKey "service.hosts"++servicePortChild :: Key+servicePortChild = validKey "service.port.number"++validKey :: Text -> Key+validKey value = either (error . show) id (parseKey value)
+ test/Settei/ValueTest.hs view
@@ -0,0 +1,55 @@+module Settei.ValueTest (tests) where++import Data.Text qualified as Text+import Settei+import Settei.Prelude+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "Settei.Value"+    [ testCase "text values decode" $+        decodeSetting publicText (RawText "hello") @?= Right "hello",+      testCase "textual booleans decode case-insensitively" $+        decodeSetting publicBoolean (RawText "TRUE") @?= Right True,+      testCase "bounded integral values decode" $+        decodeSetting publicInteger (RawText "42") @?= Right (42 :: Int),+      testCase "explicit enumerations decode" $+        decodeSetting environment (RawText "production") @?= Right Production,+      testCase "secret decoder failures omit rejected values" $ case decodeSetting secretText (RawText "supersecret") of+        Right _ -> fail "expected decoding to fail"+        Left failureValue ->+          assertBool+            "rendered failure leaked the rejected secret"+            (not (Text.isInfixOf "supersecret" (renderDecodeFailure failureValue)))+    ]++data Environment = Development | Production+  deriving stock (Generic, Eq, Show)++publicText :: Setting Text+publicText = publicSetting exampleKey "Example text" textDecoder++secretText :: Setting Bool+secretText = secretSetting exampleKey "Example secret" boolDecoder++publicBoolean :: Setting Bool+publicBoolean = publicSetting exampleKey "Example boolean" boolDecoder++publicInteger :: Setting Int+publicInteger = publicSetting exampleKey "Example integer" boundedIntegralDecoder++environment :: Setting Environment+environment =+  publicSetting+    exampleKey+    "Runtime environment"+    (enumDecoder [("development", Development), ("production", Production)])++exampleKey :: Key+exampleKey = validKey "example.value"++validKey :: Text -> Key+validKey value = either (error . show) id (parseKey value)
+ test/golden/errors.json view
@@ -0,0 +1,1 @@+{"schemaVersion":1,"type":"settei.errors","errors":[{"kind":"decode-error","key":"database.password","expected":"boolean","origin":{"kind":"environment","kindDetail":null,"name":"environment","key":"database.password","location":null,"annotations":{}},"rejected":"<redacted>"}]}
+ test/golden/errors.txt view
@@ -0,0 +1,1 @@+database.password: expected boolean from environment source environment, rejected <redacted>
+ test/golden/resolution.json view
@@ -0,0 +1,1 @@+{"schemaVersion":1,"type":"settei.resolution","nodes":[{"key":"database.password","sensitivity":"secret","outcome":"resolved","value":"<redacted>","origin":{"kind":"environment","kindDetail":null,"name":"environment","key":"database.password","location":null,"annotations":{"environment.variable":"DATABASE_PASSWORD"}},"shadowed":[],"derivation":null},{"key":"runtime.environment","sensitivity":"public","outcome":"resolved","value":"\"Production\"","origin":{"kind":"environment","kindDetail":null,"name":"environment","key":"runtime.environment","location":null,"annotations":{"environment.variable":"HASKELL_ENV"}},"shadowed":[],"derivation":null},{"key":"service.port","sensitivity":"public","outcome":"resolved","value":"443","origin":{"kind":"derived","kindDetail":null,"name":"service-port-by-environment","key":"service.port","location":null,"annotations":{"settei.default-rule":"service-port-by-environment"}},"shadowed":[{"kind":"built-in","kindDetail":null,"name":"built-in","key":"service.port","location":null,"annotations":{}}],"derivation":{"rule":"service-port-by-environment","explanation":"Choose the conventional production port","dependencies":["runtime.environment"]}}],"branches":[]}
+ test/golden/resolution.txt view
@@ -0,0 +1,9 @@+database.password = <redacted>+  from environment variable DATABASE_PASSWORD+runtime.environment = "Production"+  from environment variable HASKELL_ENV+service.port = 443+  from default rule service-port-by-environment+  because runtime.environment = "Production"+    from environment variable HASKELL_ENV+  shadowed: built-in source built-in
+ test/golden/schema.json view
@@ -0,0 +1,1 @@+{"schemaVersion":1,"type":"settei.schema","settings":[{"key":"database.password","description":"Database password","sensitivity":"secret","requirement":"required","presence":"necessary"}],"conditions":[]}
+ test/golden/schema.txt view
@@ -0,0 +1,1 @@+database.password [required, necessary, secret] Database password
+ test/golden/warnings.json view
@@ -0,0 +1,1 @@+{"schemaVersion":1,"type":"settei.warnings","warnings":[{"kind":"unknown-key","key":"unknown","origin":{"kind":"file","kindDetail":"memory","name":"document","key":"unknown","location":null,"annotations":{}}}]}
+ test/golden/warnings.txt view
@@ -0,0 +1,1 @@+unknown: unknown key in file source document (memory)