settei 0.2.0.0 → 0.3.0.0
raw patch · 22 files changed
+1463/−75 lines, 22 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Settei.Contract: CaseShape :: ![Key] -> !Int -> !Bool -> DefaultShape
+ Settei.Contract: ConflictingSensitivity :: !Key -> ContractDiagnostic
+ Settei.Contract: ConstantShape :: !DefaultValue -> DefaultShape
+ Settei.Contract: ContractInputs :: ![InputBinding] -> ![Source] -> !Maybe DeploymentProfile -> ContractInputs
+ Settei.Contract: ContractSetting :: !Key -> !Text -> !Sensitivity -> !Requirement -> !Presence -> ![InputBinding] -> ![DeclaredDefault] -> !Maybe SourceDefault -> !Maybe Text -> !ExternalInput -> ContractSetting
+ Settei.Contract: CoveredByDeclaration :: ![Key] -> DefaultCoverage
+ Settei.Contract: CoveredBySource :: DefaultCoverage
+ Settei.Contract: CustomInput :: !Text -> InputChannel
+ Settei.Contract: DeclaredDefault :: !RuleName -> !Text -> !DefaultShape -> DeclaredDefault
+ Settei.Contract: DefaultStructuralConflict :: !StructuralError -> ContractDiagnostic
+ Settei.Contract: DerivedShape :: ![Key] -> DefaultShape
+ Settei.Contract: EnvironmentVariable :: InputChannel
+ Settei.Contract: InputConditional :: !InputReason -> ExternalInput
+ Settei.Contract: InputDefaulted :: !DefaultCoverage -> ExternalInput
+ Settei.Contract: InputOptional :: ExternalInput
+ Settei.Contract: InputRequired :: !InputReason -> ExternalInput
+ Settei.Contract: InvalidDefault :: !Text -> DefaultValidity
+ Settei.Contract: InvalidSourceDefault :: InputReason
+ Settei.Contract: NoDefault :: InputReason
+ Settei.Contract: ProfileRequirement :: InputReason
+ Settei.Contract: RedactedDefault :: DefaultValue
+ Settei.Contract: RequiredRequest :: InputReason
+ Settei.Contract: SourceDefault :: !Origin -> ![Origin] -> !ReportedValue -> !DefaultValidity -> SourceDefault
+ Settei.Contract: UndeclaredBindingKey :: !InputBinding -> ContractDiagnostic
+ Settei.Contract: UndeclaredDefaultLeaf :: !UnknownKeyProblem -> ContractDiagnostic
+ Settei.Contract: UndeclaredProfileKey :: !Key -> ContractDiagnostic
+ Settei.Contract: UnrenderableDefault :: DefaultValue
+ Settei.Contract: ValidDefault :: DefaultValidity
+ Settei.Contract: VisibleDefault :: !Text -> DefaultValue
+ Settei.Contract: [declaredDefaults] :: ContractSetting -> ![DeclaredDefault]
+ Settei.Contract: [defaultSources] :: ContractInputs -> ![Source]
+ Settei.Contract: [deploymentRequirement] :: ContractSetting -> !Maybe Text
+ Settei.Contract: [description] :: ContractSetting -> !Text
+ Settei.Contract: [explanation] :: DeclaredDefault -> !Text
+ Settei.Contract: [externalInput] :: ContractSetting -> !ExternalInput
+ Settei.Contract: [inputs] :: ContractSetting -> ![InputBinding]
+ Settei.Contract: [key] :: ContractSetting -> !Key
+ Settei.Contract: [origin] :: SourceDefault -> !Origin
+ Settei.Contract: [presence] :: ContractSetting -> !Presence
+ Settei.Contract: [profile] :: ContractInputs -> !Maybe DeploymentProfile
+ Settei.Contract: [requirement] :: ContractSetting -> !Requirement
+ Settei.Contract: [rule] :: DeclaredDefault -> !RuleName
+ Settei.Contract: [sensitivity] :: ContractSetting -> !Sensitivity
+ Settei.Contract: [shadowed] :: SourceDefault -> ![Origin]
+ Settei.Contract: [shape] :: DeclaredDefault -> !DefaultShape
+ Settei.Contract: [sourceDefault] :: ContractSetting -> !Maybe SourceDefault
+ Settei.Contract: [validity] :: SourceDefault -> !DefaultValidity
+ Settei.Contract: [value] :: SourceDefault -> !ReportedValue
+ Settei.Contract: annotateInputBinding :: Map Text Text -> InputBinding -> InputBinding
+ Settei.Contract: contractConditions :: DeploymentContract -> [Condition]
+ Settei.Contract: contractDiagnostics :: DeploymentContract -> [ContractDiagnostic]
+ Settei.Contract: contractProfile :: DeploymentContract -> Maybe Text
+ Settei.Contract: contractSettings :: DeploymentContract -> [ContractSetting]
+ Settei.Contract: data ContractDiagnostic
+ Settei.Contract: data ContractInputs
+ Settei.Contract: data ContractSetting
+ Settei.Contract: data DeclaredDefault
+ Settei.Contract: data DefaultCoverage
+ Settei.Contract: data DefaultShape
+ Settei.Contract: data DefaultValidity
+ Settei.Contract: data DefaultValue
+ Settei.Contract: data DeploymentContract
+ Settei.Contract: data DeploymentProfile
+ Settei.Contract: data ExternalInput
+ Settei.Contract: data InputBinding
+ Settei.Contract: data InputChannel
+ Settei.Contract: data InputReason
+ Settei.Contract: data SourceDefault
+ Settei.Contract: deploymentContract :: ContractInputs -> Config a -> Either (NonEmpty ConfigError) DeploymentContract
+ Settei.Contract: deploymentProfile :: Text -> [(Key, Text)] -> DeploymentProfile
+ Settei.Contract: emptyContractInputs :: ContractInputs
+ Settei.Contract: inputBinding :: InputChannel -> Text -> Key -> InputBinding
+ Settei.Contract: inputBindingAnnotations :: InputBinding -> Map Text Text
+ Settei.Contract: inputBindingChannel :: InputBinding -> InputChannel
+ Settei.Contract: inputBindingKey :: InputBinding -> Key
+ Settei.Contract: inputBindingName :: InputBinding -> Text
+ Settei.Contract: instance GHC.Classes.Eq Settei.Contract.ContractDiagnostic
+ Settei.Contract: instance GHC.Classes.Eq Settei.Contract.ContractSetting
+ Settei.Contract: instance GHC.Classes.Eq Settei.Contract.DeclaredDefault
+ Settei.Contract: instance GHC.Classes.Eq Settei.Contract.DefaultCoverage
+ Settei.Contract: instance GHC.Classes.Eq Settei.Contract.DefaultShape
+ Settei.Contract: instance GHC.Classes.Eq Settei.Contract.DefaultValidity
+ Settei.Contract: instance GHC.Classes.Eq Settei.Contract.DefaultValue
+ Settei.Contract: instance GHC.Classes.Eq Settei.Contract.DeploymentContract
+ Settei.Contract: instance GHC.Classes.Eq Settei.Contract.DeploymentProfile
+ Settei.Contract: instance GHC.Classes.Eq Settei.Contract.ExternalInput
+ Settei.Contract: instance GHC.Classes.Eq Settei.Contract.InputBinding
+ Settei.Contract: instance GHC.Classes.Eq Settei.Contract.InputChannel
+ Settei.Contract: instance GHC.Classes.Eq Settei.Contract.InputReason
+ Settei.Contract: instance GHC.Classes.Eq Settei.Contract.SourceDefault
+ Settei.Contract: instance GHC.Internal.Generics.Generic Settei.Contract.ContractDiagnostic
+ Settei.Contract: instance GHC.Internal.Generics.Generic Settei.Contract.ContractInputs
+ Settei.Contract: instance GHC.Internal.Generics.Generic Settei.Contract.ContractSetting
+ Settei.Contract: instance GHC.Internal.Generics.Generic Settei.Contract.DeclaredDefault
+ Settei.Contract: instance GHC.Internal.Generics.Generic Settei.Contract.DefaultCoverage
+ Settei.Contract: instance GHC.Internal.Generics.Generic Settei.Contract.DefaultShape
+ Settei.Contract: instance GHC.Internal.Generics.Generic Settei.Contract.DefaultValidity
+ Settei.Contract: instance GHC.Internal.Generics.Generic Settei.Contract.DefaultValue
+ Settei.Contract: instance GHC.Internal.Generics.Generic Settei.Contract.DeploymentContract
+ Settei.Contract: instance GHC.Internal.Generics.Generic Settei.Contract.DeploymentProfile
+ Settei.Contract: instance GHC.Internal.Generics.Generic Settei.Contract.ExternalInput
+ Settei.Contract: instance GHC.Internal.Generics.Generic Settei.Contract.InputBinding
+ Settei.Contract: instance GHC.Internal.Generics.Generic Settei.Contract.InputChannel
+ Settei.Contract: instance GHC.Internal.Generics.Generic Settei.Contract.InputReason
+ Settei.Contract: instance GHC.Internal.Generics.Generic Settei.Contract.SourceDefault
+ Settei.Contract: instance GHC.Internal.Show.Show Settei.Contract.ContractDiagnostic
+ Settei.Contract: instance GHC.Internal.Show.Show Settei.Contract.ContractSetting
+ Settei.Contract: instance GHC.Internal.Show.Show Settei.Contract.DeclaredDefault
+ Settei.Contract: instance GHC.Internal.Show.Show Settei.Contract.DefaultCoverage
+ Settei.Contract: instance GHC.Internal.Show.Show Settei.Contract.DefaultShape
+ Settei.Contract: instance GHC.Internal.Show.Show Settei.Contract.DefaultValidity
+ Settei.Contract: instance GHC.Internal.Show.Show Settei.Contract.DefaultValue
+ Settei.Contract: instance GHC.Internal.Show.Show Settei.Contract.DeploymentContract
+ Settei.Contract: instance GHC.Internal.Show.Show Settei.Contract.DeploymentProfile
+ Settei.Contract: instance GHC.Internal.Show.Show Settei.Contract.ExternalInput
+ Settei.Contract: instance GHC.Internal.Show.Show Settei.Contract.InputBinding
+ Settei.Contract: instance GHC.Internal.Show.Show Settei.Contract.InputChannel
+ Settei.Contract: instance GHC.Internal.Show.Show Settei.Contract.InputReason
+ Settei.Contract: instance GHC.Internal.Show.Show Settei.Contract.SourceDefault
+ Settei.Contract: profileName :: DeploymentProfile -> Text
+ Settei.Contract: profileRequirements :: DeploymentProfile -> Map Key Text
+ Settei.Error: InvariantError :: !InvariantProblem -> ConfigError
+ Settei.Error: InvariantProblem :: !InvariantRule -> ![Key] -> !Text -> !Maybe Text -> InvariantProblem
+ Settei.Error: InvariantRule :: Text -> InvariantRule
+ Settei.Error: [detail] :: InvariantProblem -> !Maybe Text
+ Settei.Error: [expectation] :: InvariantProblem -> !Text
+ Settei.Error: [keys] :: InvariantProblem -> ![Key]
+ Settei.Error: data InvariantProblem
+ Settei.Error: instance GHC.Classes.Eq Settei.Error.InvariantProblem
+ Settei.Error: instance GHC.Classes.Eq Settei.Error.InvariantRule
+ Settei.Error: instance GHC.Classes.Ord Settei.Error.InvariantRule
+ Settei.Error: instance GHC.Internal.Generics.Generic Settei.Error.InvariantProblem
+ Settei.Error: instance GHC.Internal.Generics.Generic Settei.Error.InvariantRule
+ Settei.Error: instance GHC.Internal.Show.Show Settei.Error.InvariantProblem
+ Settei.Error: instance GHC.Internal.Show.Show Settei.Error.InvariantRule
+ Settei.Error: newtype InvariantRule
+ Settei.Error: renderInvariantRule :: InvariantRule -> Text
+ Settei.Render: renderContractJson :: DeploymentContract -> Text
+ Settei.Render: renderContractText :: DeploymentContract -> Text
+ Settei.Render: renderValidatedResolutionJson :: ResolutionReport -> ValidationReport -> Text
+ Settei.Render: renderValidationText :: ValidationReport -> Text
+ Settei.Report: InvariantFailed :: !Int -> InvariantStatus
+ Settei.Report: InvariantNotRun :: InvariantStatus
+ Settei.Report: InvariantOutcome :: !InvariantRule -> ![Key] -> !Text -> ![InvariantRule] -> !InvariantStatus -> InvariantOutcome
+ Settei.Report: InvariantPassed :: InvariantStatus
+ Settei.Report: InvariantSkipped :: !NonEmpty InvariantRule -> InvariantStatus
+ Settei.Report: ValidationReport :: [InvariantOutcome] -> ValidationReport
+ Settei.Report: [expectation] :: InvariantOutcome -> !Text
+ Settei.Report: [invariants] :: ValidationReport -> [InvariantOutcome]
+ Settei.Report: [keys] :: InvariantOutcome -> ![Key]
+ Settei.Report: [prerequisites] :: InvariantOutcome -> ![InvariantRule]
+ Settei.Report: [status] :: InvariantOutcome -> !InvariantStatus
+ Settei.Report: data InvariantOutcome
+ Settei.Report: data InvariantStatus
+ Settei.Report: instance GHC.Classes.Eq Settei.Report.InvariantOutcome
+ Settei.Report: instance GHC.Classes.Eq Settei.Report.InvariantStatus
+ Settei.Report: instance GHC.Classes.Eq Settei.Report.ValidationReport
+ Settei.Report: instance GHC.Internal.Generics.Generic Settei.Report.InvariantOutcome
+ Settei.Report: instance GHC.Internal.Generics.Generic Settei.Report.InvariantStatus
+ Settei.Report: instance GHC.Internal.Generics.Generic Settei.Report.ValidationReport
+ Settei.Report: instance GHC.Internal.Show.Show Settei.Report.InvariantOutcome
+ Settei.Report: instance GHC.Internal.Show.Show Settei.Report.InvariantStatus
+ Settei.Report: instance GHC.Internal.Show.Show Settei.Report.ValidationReport
+ Settei.Report: newtype ValidationReport
+ Settei.Report: validationOutcomes :: ValidationReport -> [InvariantOutcome]
+ Settei.Validate: CyclicDeclaration :: !DefaultCycleProblem -> ValidatorError
+ Settei.Validate: DuplicateInvariantRule :: !InvariantRule -> ValidatorError
+ Settei.Validate: EmptyInvariantKeys :: !InvariantRule -> ValidatorError
+ Settei.Validate: InvalidInvariantRule :: !InvariantRule -> ValidatorError
+ Settei.Validate: UndeclaredInvariantKey :: !InvariantRule -> !Key -> ValidatorError
+ Settei.Validate: UnknownPrerequisite :: !InvariantRule -> !InvariantRule -> ValidatorError
+ Settei.Validate: ValidatedResult :: !Either (NonEmpty ConfigError) a -> !ResolutionReport -> ![ConfigWarning] -> !ValidationReport -> ValidatedResult a
+ Settei.Validate: [answer] :: ValidatedResult a -> !Either (NonEmpty ConfigError) a
+ Settei.Validate: [report] :: ValidatedResult a -> !ResolutionReport
+ Settei.Validate: [validation] :: ValidatedResult a -> !ValidationReport
+ Settei.Validate: [warnings] :: ValidatedResult a -> ![ConfigWarning]
+ Settei.Validate: check :: InvariantRule -> [Key] -> Text -> (a -> Bool) -> Validator a
+ Settei.Validate: data ValidatedResult a
+ Settei.Validate: data Validator a
+ Settei.Validate: data ValidatorError
+ Settei.Validate: data Validators a
+ Settei.Validate: data Violation
+ Settei.Validate: describeValidators :: Validators a -> ValidationReport
+ Settei.Validate: instance GHC.Classes.Eq Settei.Validate.ValidatorError
+ Settei.Validate: instance GHC.Classes.Eq Settei.Validate.Violation
+ Settei.Validate: instance GHC.Internal.Generics.Generic (Settei.Validate.ValidatedResult a)
+ Settei.Validate: instance GHC.Internal.Generics.Generic Settei.Validate.ValidatorError
+ Settei.Validate: instance GHC.Internal.Generics.Generic Settei.Validate.Violation
+ Settei.Validate: instance GHC.Internal.Show.Show Settei.Validate.ValidatorError
+ Settei.Validate: instance GHC.Internal.Show.Show Settei.Validate.Violation
+ Settei.Validate: invariant :: InvariantRule -> [Key] -> Text -> (a -> [Violation]) -> Validator a
+ Settei.Validate: renderValidatorErrorText :: ValidatorError -> Text
+ Settei.Validate: renderValidatorErrorsText :: NonEmpty ValidatorError -> Text
+ Settei.Validate: requires :: [InvariantRule] -> Validator a -> Validator a
+ Settei.Validate: runValidators :: Validators a -> a -> (ValidationReport, [InvariantProblem])
+ Settei.Validate: validate :: Validators a -> ResolveResult a -> ValidatedResult a
+ Settei.Validate: validators :: Config a -> [Validator a] -> Either (NonEmpty ValidatorError) (Validators a)
+ Settei.Validate: violation :: Violation
+ Settei.Validate: violationWithDetail :: Text -> Violation
- Settei.Error: [rule] :: DefaultProblem -> !RuleName
+ Settei.Error: [rule] :: InvariantProblem -> !InvariantRule
- Settei.Report: [rule] :: Derivation -> !Text
+ Settei.Report: [rule] :: InvariantOutcome -> !InvariantRule
Files
- CHANGELOG.md +28/−0
- README.md +9/−1
- settei.cabal +50/−37
- src/Settei.hs +4/−0
- src/Settei/Contract.hs +333/−0
- src/Settei/Error.hs +22/−1
- src/Settei/Internal/DefaultValidation.hs +42/−0
- src/Settei/Render.hs +240/−1
- src/Settei/Report.hs +34/−0
- src/Settei/Resolve.hs +1/−33
- src/Settei/Validate.hs +185/−0
- test/Main.hs +5/−1
- test/Settei/ConfigTest.hs +1/−1
- test/Settei/ContractTest.hs +198/−0
- test/Settei/ResolveTest.hs +1/−0
- test/Settei/ValidateTest.hs +230/−0
- test/golden/contract.json +1/−0
- test/golden/contract.txt +62/−0
- test/golden/invariant-errors.json +1/−0
- test/golden/invariant-errors.txt +4/−0
- test/golden/validation.json +1/−0
- test/golden/validation.txt +11/−0
CHANGELOG.md view
@@ -1,5 +1,33 @@ # Changelog for settei +## 0.3.0.0 — 2026-10-21++### Breaking Changes++- Add `InvariantError` to `ConfigError`; update exhaustive matches. Version-1 error JSON+ gains kind `invariant`. Use the `settei-upgrade` Seihou blueprint to migrate from+ 0.2.0.0 (`seihou agent migrate settei-upgrade`).++### New Features++- Add `Settei.Validate`: checked opaque rule collections, ordered accumulation,+ prerequisite skipping, role composition, and `ValidatedResult` preserving provenance.+ Validator metadata must be safe to publish; details are not automatically sanitised.+- Add validation report types, `renderValidationText`, and+ `renderValidatedResolutionJson`. Validated resolution JSON gains an `invariants` array+ (empty when no rules are declared). Existing bare report output is unchanged.+- Add public `Settei.Contract` and re-export it from `Settei`: adapter-neutral input+ bindings, explicit default sources, deployment profiles, occurrence-aware input+ verdicts, and safe default availability/provenance metadata.+- Add `renderContractText` and version 1 `settei.contract` JSON via `renderContractJson`.+ Existing schema and resolution JSON are unchanged. Derived/case computations remain+ deferred; secret defaults are redacted before storage.++### Other Changes++- Share cycle preflight through an internal module; resolver behavior is unchanged.+- All family packages move to 0.3.0.0 with exact intra-family pins.+ ## 0.2.0.0 — 2026-07-19 - `Settei.Prelude` is now documented as internal to the settei package family and is
README.md view
@@ -3,7 +3,15 @@ `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.+text and JSON reports. It also exports source-free deployment contracts (`Settei.Contract`)+and pure post-resolution application validation (`Settei.Validate`). Both were added+in the shared 0.3.0.0 release.++Use `deploymentContract` to inspect input bindings, safe defaults, and explicit profile+requirements. Use `validators` to check rule declarations once, then `validate` to retain+provenance and accumulate structured invariant failures after resolution. Validators+receive real typed secrets: keep rule metadata and optional details safe to publish.+The original `resolve` API is unchanged. 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
settei.cabal view
@@ -1,47 +1,50 @@-cabal-version: 3.8-name: settei-version: 0.2.0.0-synopsis: Typed, layered, explainable configuration+cabal-version: 3.8+name: settei+version: 0.3.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+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+ type: git location: https://github.com/shinzui/settei.git common common- default-language: GHC2024+ default-language: GHC2024 default-extensions: DeriveAnyClass DuplicateRecordFields OverloadedLabels OverloadedStrings - ghc-options: -Wall -Wcompat+ ghc-options:+ -Wall+ -Wcompat library- import: common- hs-source-dirs: src+ import: common+ hs-source-dirs: src exposed-modules: Settei Settei.Config+ Settei.Contract Settei.Default Settei.Error Settei.Key@@ -54,33 +57,41 @@ Settei.Schema Settei.Setting Settei.Source+ Settei.Validate Settei.Value other-modules: Settei.Internal.Config+ Settei.Internal.DefaultValidation 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+ 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+ import: common+ type: exitcode-stdio-1.0+ hs-source-dirs:+ test+ src++ main-is: Main.hs other-modules: Settei Settei.Config Settei.ConfigTest+ Settei.Contract+ Settei.ContractTest Settei.Default Settei.DefaultTest Settei.Error Settei.Internal.Config+ Settei.Internal.DefaultValidation Settei.Internal.Schema Settei.Key Settei.KeyTest@@ -97,15 +108,17 @@ Settei.Setting Settei.Source Settei.SourceTest+ Settei.Validate+ Settei.ValidateTest 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+ 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
@@ -1,6 +1,7 @@ -- | Typed, inspectable configuration declarations. module Settei ( module Settei.Config,+ module Settei.Contract, module Settei.Default, module Settei.Error, module Settei.Key,@@ -13,10 +14,12 @@ module Settei.Setting, module Settei.Source, module Settei.Value,+ module Settei.Validate, ) where import Settei.Config+import Settei.Contract import Settei.Default import Settei.Error import Settei.Key@@ -28,4 +31,5 @@ import Settei.Schema import Settei.Setting import Settei.Source+import Settei.Validate import Settei.Value
+ src/Settei/Contract.hs view
@@ -0,0 +1,333 @@+{-# LANGUAGE GADTs #-}++-- | Pure deployment inspection. Inputs are explicit metadata and default sources;+-- no source is read and no derived or case default computation is run.+module Settei.Contract+ ( InputChannel (..),+ InputBinding,+ inputBinding,+ annotateInputBinding,+ inputBindingChannel,+ inputBindingName,+ inputBindingKey,+ inputBindingAnnotations,+ DeploymentProfile,+ deploymentProfile,+ profileName,+ profileRequirements,+ ContractInputs (..),+ emptyContractInputs,+ deploymentContract,+ DeploymentContract,+ contractSettings,+ contractConditions,+ contractProfile,+ contractDiagnostics,+ ContractSetting (..),+ DeclaredDefault (..),+ DefaultShape (..),+ DefaultValue (..),+ SourceDefault (..),+ DefaultValidity (..),+ ExternalInput (..),+ InputReason (..),+ DefaultCoverage (..),+ ContractDiagnostic (..),+ )+where++import Data.Generics.Labels ()+import Data.List (isPrefixOf)+import Data.List.NonEmpty qualified as NonEmpty+import Data.Map.Strict qualified as Map+import Data.Maybe (isJust)+import Data.Set qualified as Set+import Settei.Error+import Settei.Internal.Config hiding (Request (..))+import Settei.Internal.Config qualified as Config+import Settei.Internal.DefaultValidation (validateDefaultCycles)+import Settei.Key (Key, keySegments)+import Settei.Origin (Origin)+import Settei.Prelude+import Settei.Provenance+import Settei.Schema+import Settei.Setting+import Settei.Source+import Settei.Value (decodeFailureExpected)++-- | Adapter-neutral external channel. Custom channel identity is descriptive.+data InputChannel = EnvironmentVariable | CustomInput !Text+ deriving stock (Generic, Eq, Show)++-- | One external input name mapped to a declared key. This is descriptive metadata,+-- not a value reader; names and annotations must be safe to publish.+data InputBinding = InputBinding+ {channel :: !InputChannel, name :: !Text, key :: !Key, annotations :: !(Map Text Text)}+ deriving stock (Generic, Eq, Show)++-- | Construct a binding with no annotations. No source is read or key membership checked.+inputBinding :: InputChannel -> Text -> Key -> InputBinding+inputBinding channel name key = InputBinding {channel, name, key, annotations = Map.empty}++-- | Later annotations win; metadata must never contain candidate values.+annotateInputBinding :: Map Text Text -> InputBinding -> InputBinding+annotateInputBinding additions binding = binding & #annotations %~ (additions <>)++-- | The adapter-neutral channel carrying this external input.+inputBindingChannel :: InputBinding -> InputChannel+inputBindingChannel binding = binding ^. #channel++-- | The external name, such as an environment-variable name.+inputBindingName :: InputBinding -> Text+inputBindingName binding = binding ^. #name++-- | The declaration key targeted by this binding.+inputBindingKey :: InputBinding -> Key+inputBindingKey binding = binding ^. #key++-- | Trusted descriptive metadata, without candidate values.+inputBindingAnnotations :: InputBinding -> Map Text Text+inputBindingAnnotations binding = binding ^. #annotations++-- | Explicit deployment policy: a name and reasons that selected keys need external+-- input even when defaults exist. Exporting a profile does not enforce it at runtime.+data DeploymentProfile = DeploymentProfile {name :: !Text, requirements :: !(Map Key Text)}+ deriving stock (Generic, Eq, Show)++-- | Build a named profile. Repeated keys keep the last reason; all text must be+-- safe to publish. Undeclared keys are diagnosed by 'deploymentContract'.+deploymentProfile :: Text -> [(Key, Text)] -> DeploymentProfile+deploymentProfile name requirements = DeploymentProfile {name, requirements = Map.fromList requirements}++-- | The operator-facing profile name.+profileName :: DeploymentProfile -> Text+profileName value = value ^. #name++-- | Keys requiring deliberate external input, mapped to their policy reasons.+profileRequirements :: DeploymentProfile -> Map Key Text+profileRequirements value = value ^. #requirements++-- | Default sources are lowest to highest precedence. This input container has+-- no Show instance because sources retain raw, potentially secret values.+data ContractInputs = ContractInputs+ {inputs :: ![InputBinding], defaultSources :: ![Source], profile :: !(Maybe DeploymentProfile)}+ deriving stock (Generic)++-- | No bindings, default sources, or deployment profile.+emptyContractInputs :: ContractInputs+emptyContractInputs = ContractInputs [] [] Nothing++-- | A deterministic, secret-redacted deployment description. Derived computations+-- are deferred; its verdicts do not establish runtime acceptance or connectivity.+data DeploymentContract = DeploymentContract+ {settings :: ![ContractSetting], conditions :: ![Condition], profile :: !(Maybe Text), diagnostics :: ![ContractDiagnostic]}+ deriving stock (Generic, Eq, Show)++-- | Per-key entries in deterministic key order.+contractSettings :: DeploymentContract -> [ContractSetting]+contractSettings value = value ^. #settings++-- | Conditional declaration relationships in declaration order.+contractConditions :: DeploymentContract -> [Condition]+contractConditions value = value ^. #conditions++-- | The selected profile name, when one was supplied.+contractProfile :: DeploymentContract -> Maybe Text+contractProfile value = value ^. #profile++-- | Nonfatal structural, sensitivity, or undeclared-input inconsistencies.+-- Default cycles instead fail construction with a configuration error.+contractDiagnostics :: DeploymentContract -> [ContractDiagnostic]+contractDiagnostics value = value ^. #diagnostics++-- | Merged schema metadata and every binding/default for one key. The external-input+-- verdict accounts for individual requests and may differ from merged requiredness.+data ContractSetting = ContractSetting+ { key :: !Key,+ description :: !Text,+ sensitivity :: !Sensitivity,+ requirement :: !Requirement,+ presence :: !Presence,+ inputs :: ![InputBinding],+ declaredDefaults :: ![DeclaredDefault],+ sourceDefault :: !(Maybe SourceDefault),+ deploymentRequirement :: !(Maybe Text),+ externalInput :: !ExternalInput+ }+ deriving stock (Generic, Eq, Show)++-- | A fallback rule and its safe static shape, without evaluating its computation.+data DeclaredDefault = DeclaredDefault {rule :: !RuleName, explanation :: !Text, shape :: !DefaultShape}+ deriving stock (Generic, Eq, Show)++-- | A constant display, derived dependency keys, or case dependency keys with+-- alternative count and fallback presence. Coverage does not prove evaluation succeeds.+data DefaultShape = ConstantShape !DefaultValue | DerivedShape ![Key] | CaseShape ![Key] !Int !Bool+ deriving stock (Generic, Eq, Show)++-- | A safe constant display: public rendered text, a redacted secret, or a public+-- value whose setting has no renderer.+data DefaultValue = VisibleDefault !Text | RedactedDefault | UnrenderableDefault+ deriving stock (Generic, Eq, Show)++-- | The winning explicit default candidate, its shadowed origins, safe reported+-- value, and decoder validity. Invalid winners never reveal a lower fallback.+data SourceDefault = SourceDefault+ {origin :: !Origin, shadowed :: ![Origin], value :: !ReportedValue, validity :: !DefaultValidity}+ deriving stock (Generic, Eq, Show)++-- | Whether all applicable decoders accept the winning default candidate.+-- Invalid text describes decoder expectations rather than rejected secret values.+data DefaultValidity = ValidDefault | InvalidDefault !Text+ deriving stock (Generic, Eq, Show)++-- | Whether external input is required, conditional, covered by a default, or optional.+-- A conditional input may still be required on the selected runtime path.+data ExternalInput = InputRequired !InputReason | InputConditional !InputReason | InputDefaulted !DefaultCoverage | InputOptional+ deriving stock (Generic, Eq, Show)++-- | Why the contract requires external input or marks it conditional.+data InputReason = NoDefault | InvalidSourceDefault | RequiredRequest | ProfileRequirement+ deriving stock (Generic, Eq, Show)++-- | Coverage from an explicit source or a declared fallback with dependency keys.+-- Declared coverage does not establish that dependencies or computations will succeed.+data DefaultCoverage = CoveredBySource | CoveredByDeclaration ![Key]+ deriving stock (Generic, Eq, Show)++-- | An inconsistency retained in a useful contract rather than a fatal cycle error.+data ContractDiagnostic+ = ConflictingSensitivity !Key+ | DefaultStructuralConflict !StructuralError+ | UndeclaredDefaultLeaf !UnknownKeyProblem+ | UndeclaredBindingKey !InputBinding+ | UndeclaredProfileKey !Key+ deriving stock (Generic, Eq, Show)++-- These records exist only during construction and never retain decoded values.+data Occurrence where+ Occurrence :: Presence -> Bool -> Setting a -> Occurrence++-- | Build a deterministic contract, rejecting cycles before inspecting sources.+-- Decoders check winning source candidates; declaration fallback coverage makes+-- no claim about successful computation or complete case coverage.+deploymentContract :: ContractInputs -> Config a -> Either (NonEmpty ConfigError) DeploymentContract+deploymentContract supplied declaration = case NonEmpty.nonEmpty (validateDefaultCycles declaration) of+ Just errors -> Left errors+ Nothing ->+ Right+ DeploymentContract+ { settings = fmap build entries,+ conditions = schemaConditions schema,+ profile = profileName <$> selectedProfile,+ diagnostics = sensitivityProblems <> structuralProblems <> leafProblems <> bindingProblems <> profileProblems+ }+ where+ schema = describeConfig declaration+ entries = schemaPossible schema+ declaredKeys = fmap schemaSettingKey entries+ selectedProfile = supplied ^. #profile+ requirements = maybe Map.empty profileRequirements selectedProfile+ sources = supplied ^. #defaultSources+ (occurrences, defaults) = inspect Necessary declaration+ occurrencesAt key = [entry | (target, entry) <- occurrences, target == key]+ defaultsAt key = [entry | (target, entry) <- defaults, target == key]+ effective key = maybe Secret schemaSettingSensitivity (findEntry key)+ findEntry key = case filter ((== key) . schemaSettingKey) entries of+ entry : _ -> Just entry+ [] -> Nothing+ sensitivityProblems =+ [ConflictingSensitivity (schemaSettingKey entry) | entry <- entries, Set.size (entry ^. #declaredSensitivities) > 1]+ lookups key = fmap (lookupSource key) sources+ structuralProblems = [DefaultStructuralConflict problem | key <- declaredKeys, Left problem <- lookups key]+ leafProblems =+ [ UndeclaredDefaultLeaf (UnknownKeyProblem key (candidateOrigin candidateValue'))+ | sourceValue <- sources,+ (key, candidateValue') <- sourceLeaves sourceValue,+ not (any (\declared -> NonEmpty.toList (keySegments declared) `isPrefixOf` NonEmpty.toList (keySegments key)) declaredKeys)+ ]+ bindingProblems = [UndeclaredBindingKey binding | binding <- supplied ^. #inputs, inputBindingKey binding `notElem` declaredKeys]+ profileProblems = [UndeclaredProfileKey key | key <- Map.keys requirements, key `notElem` declaredKeys]+ build entry =+ let key = schemaSettingKey entry+ requests = occurrencesAt key+ rules = defaultsAt key+ candidates = [found | Right (Just found) <- lookups key]+ winner = case reverse candidates of+ [] -> Nothing+ candidateValue' : rest -> Just (candidateValue', fmap candidateOrigin rest)+ failures = case winner of+ Nothing -> []+ Just (found, _) ->+ [ (presence, decodeFailureExpected problem)+ | Occurrence presence _ settingSpec <- requests,+ Left problem <- [decodeSetting settingSpec (candidateValue found)]+ ]+ sourceDefault =+ fmap+ ( \(found, shadowed) ->+ SourceDefault+ { origin = candidateOrigin found,+ shadowed,+ value = reportedValue (schemaSettingSensitivity entry) (candidateValue found),+ validity = case failures of [] -> ValidDefault; (_, expected) : _ -> InvalidDefault expected+ }+ )+ winner+ deploymentRequirement = Map.lookup key requirements+ requiredPresences = [presence | Occurrence presence True _ <- requests]+ reason = if null rules then NoDefault else RequiredRequest+ requiredVerdict+ | Necessary `elem` requiredPresences = InputRequired reason+ | Conditional `elem` requiredPresences = InputConditional reason+ | not (null rules) = InputDefaulted (CoveredByDeclaration (Set.toAscList (Set.fromList (concatMap dependencies rules))))+ | otherwise = InputOptional+ externalInput+ | isJust deploymentRequirement = InputRequired ProfileRequirement+ | isJust winner =+ if any ((== Necessary) . fst) failures+ then InputRequired InvalidSourceDefault+ else if null failures then InputDefaulted CoveredBySource else InputConditional InvalidSourceDefault+ | otherwise = requiredVerdict+ in ContractSetting+ { key,+ description = schemaSettingDescription entry,+ sensitivity = schemaSettingSensitivity entry,+ requirement = schemaSettingRequirement entry,+ presence = schemaSettingPresence entry,+ inputs = filter ((== key) . inputBindingKey) (supplied ^. #inputs),+ declaredDefaults = rules,+ sourceDefault,+ deploymentRequirement,+ externalInput+ }+ inspect :: Presence -> Config b -> ([(Key, Occurrence)], [(Key, DeclaredDefault)])+ inspect presence = \case+ PureConfig _ -> ([], [])+ MapConfig _ config -> inspect presence config+ ApplyConfig function inputConfig -> combine (inspect presence function) (inspect presence inputConfig)+ RequestConfig request -> case request of+ Config.RequiredRequest settingSpec -> ([(settingKey settingSpec, Occurrence presence True settingSpec)], [])+ Config.OptionalRequest settingSpec -> ([(settingKey settingSpec, Occurrence presence False settingSpec)], [])+ SelectConfig selector branch -> combine (inspect presence selector) (inspect Conditional branch)+ DefaultConfig settingSpec defaultSpec ->+ let key = settingKey settingSpec+ valueShape value =+ if effective key == Secret+ then RedactedDefault+ else+ maybe UnrenderableDefault (\renderer -> VisibleDefault (renderer value)) (settingValueRenderer settingSpec)+ (entry, nested) = case defaultSpec of+ ConstantDefault rule explanation value -> (DeclaredDefault rule explanation (ConstantShape (valueShape value)), ([], []))+ DerivedDefault rule explanation dependency _ ->+ (DeclaredDefault rule explanation (DerivedShape (keys dependency)), inspect Conditional dependency)+ CaseDefault rule explanation dependency alternatives fallback ->+ (DeclaredDefault rule explanation (CaseShape (keys dependency) (NonEmpty.length alternatives) (isJust fallback)), inspect Conditional dependency)+ in combine ([(key, Occurrence presence False settingSpec)], [(key, entry)]) nested+ keys = fmap schemaSettingKey . schemaPossible . describeConfig+ combine (leftOccurrences, leftDefaults) (rightOccurrences, rightDefaults) =+ (leftOccurrences <> rightOccurrences, leftDefaults <> rightDefaults)+ dependencies entry = case entry ^. #shape of+ ConstantShape _ -> []+ DerivedShape keys' -> keys'+ CaseShape keys' _ _ -> keys'
src/Settei/Error.hs view
@@ -8,6 +8,9 @@ DefaultProblem (..), DecodeProblem (..), MissingProblem (..),+ InvariantRule (..),+ renderInvariantRule,+ InvariantProblem (..), RawShape (..), SensitivityConflictProblem (..), StructuralError (..),@@ -76,7 +79,24 @@ } deriving stock (Generic, Eq, Show) --- | A fatal resolver error. Every constructor is safe to render or show.+-- | A stable application-owned rule identifier; validators checks its spelling.+newtype InvariantRule = InvariantRule Text+ deriving stock (Generic, Eq, Ord, Show)++-- | The stable identifier spelling used in structured errors and validation traces.+renderInvariantRule :: InvariantRule -> Text+renderInvariantRule (InvariantRule name) = name++-- | Metadata only: authors must ensure every field is safe to publish.+data InvariantProblem = InvariantProblem+ { rule :: !InvariantRule,+ keys :: ![Key],+ expectation :: !Text,+ detail :: !(Maybe Text)+ }+ deriving stock (Generic, Eq, Show)++-- | A configuration failure. Author-supplied invariant metadata must be safe to publish. data ConfigError = MissingRequired !MissingProblem | DecodeError !DecodeProblem@@ -85,6 +105,7 @@ | DefaultError !DefaultProblem | DefaultCycle !DefaultCycleProblem | SensitivityConflict !SensitivityConflictProblem+ | InvariantError !InvariantProblem deriving stock (Generic, Eq, Show) -- | A non-fatal resolver diagnostic.
+ src/Settei/Internal/DefaultValidation.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE GADTs #-}++-- | Shared preflight for interpreters that must reject recursive defaults before inspection.+module Settei.Internal.DefaultValidation (validateDefaultCycles, defaultRule) where++import Data.List.NonEmpty qualified as NonEmpty+import Settei.Error+import Settei.Internal.Config+import Settei.Prelude++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
src/Settei/Render.hs view
@@ -4,10 +4,14 @@ -- Module: Settei.Render -- Description: Deterministic text and versioned JSON presentation. module Settei.Render- ( renderErrorsJson,+ ( renderContractText,+ renderContractJson,+ renderErrorsJson, renderErrorsText, renderResolutionJson, renderResolutionText,+ renderValidationText,+ renderValidatedResolutionJson, renderSchemaJson, renderSchemaText, renderWarningsJson,@@ -24,6 +28,7 @@ import Data.Set qualified as Set import Data.Text qualified as Text import Numeric (showHex)+import Settei.Contract import Settei.Default (renderRuleName) import Settei.Error import Settei.Key (Key, renderKey)@@ -206,6 +211,13 @@ SensitivityConflict problem -> renderKey (problem ^. #key) <> ": declared with both public and secret sensitivity; treated as secret"+ InvariantError problem ->+ commaKeys (problem ^. #keys)+ <> ": invariant "+ <> renderInvariantRule (problem ^. #rule)+ <> " failed: "+ <> problem ^. #expectation+ <> maybe "" (\detail -> " (" <> detail <> ")") (problem ^. #detail) -- | Render non-fatal diagnostics in deterministic source and key order. renderWarningsText :: [ConfigWarning] -> Text@@ -353,6 +365,14 @@ [ ("kind", jsonString "sensitivity-conflict"), ("key", jsonString (renderKey (problem ^. #key))) ]+ InvariantError problem ->+ jsonObject+ [ ("kind", jsonString "invariant"),+ ("rule", jsonString (renderInvariantRule (problem ^. #rule))),+ ("keys", jsonKeyArray (problem ^. #keys)),+ ("expectation", jsonString (problem ^. #expectation)),+ ("detail", maybe "null" jsonString (problem ^. #detail))+ ] -- | Render warnings as a versioned deterministic JSON document. renderWarningsJson :: [ConfigWarning] -> Text@@ -471,3 +491,222 @@ paddedHex value = let rendered = Text.pack (showHex value "") in Text.replicate (4 - Text.length rendered) "0" <> rendered++-- | Render deployment inputs, defaults, and deferred dependency information.+renderContractText :: DeploymentContract -> Text+renderContractText contract =+ Text.unlines+ ( concatMap settingLines (contractSettings contract)+ <> concatMap renderConditionText (zip [1 :: Int ..] (contractConditions contract))+ <> fmap (("diagnostic: " <>) . contractDiagnosticText) (contractDiagnostics contract)+ )+ where+ settingLines entry =+ [ renderKey (entry ^. #key)+ <> " ["+ <> requirementText (entry ^. #requirement)+ <> ", "+ <> presenceText (entry ^. #presence)+ <> ", "+ <> sensitivityText (entry ^. #sensitivity)+ <> "] "+ <> entry ^. #description,+ " input: " <> inputText entry+ ]+ <> fmap (\value -> " default: declaration rule " <> renderRuleName (value ^. #rule) <> ", " <> shapeText (value ^. #shape)) (entry ^. #declaredDefaults)+ <> maybe+ []+ ( \value ->+ [ " default: "+ <> renderReportedValue (value ^. #value)+ <> " from "+ <> originDescription (value ^. #origin)+ <> case value ^. #validity of ValidDefault -> ""; InvalidDefault expected -> " (invalid; expected " <> expected <> ")"+ ]+ <> fmap (\origin -> " shadowed: " <> originDescription origin) (value ^. #shadowed)+ )+ (entry ^. #sourceDefault)+ <> fmap (\binding -> " bound: " <> channelText (inputBindingChannel binding) <> " " <> inputBindingName binding <> bindingAnnotationsText binding) (entry ^. #inputs)+ bindingAnnotationsText binding+ | Map.null (inputBindingAnnotations binding) = ""+ | otherwise = " [" <> Text.intercalate ", " [key <> "=" <> value | (key, value) <- Map.toAscList (inputBindingAnnotations binding)] <> "]"+ channelText EnvironmentVariable = "environment variable"+ channelText (CustomInput detail) = detail+ inputText entry = case entry ^. #externalInput of+ InputRequired reason -> "required (" <> reasonText entry reason <> ")"+ InputConditional reason -> "conditional (" <> reasonText entry reason <> ")"+ InputDefaulted CoveredBySource -> case entry ^? #sourceDefault . _Just . #origin . #kind of+ Just BuiltInSource -> "defaulted (built-in source)"+ _ -> "defaulted (source)"+ InputDefaulted (CoveredByDeclaration _) -> "defaulted (declaration fallback)"+ InputOptional -> "optional"+ reasonText entry = \case+ NoDefault -> "no default"+ InvalidSourceDefault -> "invalid source default"+ RequiredRequest -> "required request despite declaration default"+ ProfileRequirement -> "deployment profile " <> fromMaybe "" (contractProfile contract) <> ": " <> fromMaybe "" (entry ^. #deploymentRequirement)+ shapeText = \case+ ConstantShape (VisibleDefault value) -> "constant " <> value+ ConstantShape RedactedDefault -> "constant <redacted>"+ ConstantShape UnrenderableDefault -> "constant <unrenderable>"+ DerivedShape dependencies -> "derived from " <> commaKeys dependencies <> "; value not computed"+ CaseShape dependencies count fallback -> "case on " <> commaKeys dependencies <> ", " <> jsonInt count <> " alternatives, " <> (if fallback then "fallback" else "no fallback") <> "; value not computed"++contractDiagnosticText :: ContractDiagnostic -> Text+contractDiagnosticText = \case+ ConflictingSensitivity key -> renderKey key <> ": declared with both public and secret sensitivity; treated as secret"+ DefaultStructuralConflict problem -> renderErrorText (StructuralConflict problem)+ UndeclaredDefaultLeaf problem -> renderErrorText (UnknownKeyError problem)+ UndeclaredBindingKey binding -> inputBindingName binding <> ": binding targets undeclared key " <> renderKey (inputBindingKey binding)+ UndeclaredProfileKey key -> renderKey key <> ": deployment profile targets undeclared key"++-- | Version 1 deployment contract. Existing schema and resolution encodings are unchanged.+renderContractJson :: DeploymentContract -> Text+renderContractJson contract =+ versionedJson+ "settei.contract"+ [ ("profile", maybe "null" jsonString (contractProfile contract)),+ ("settings", jsonArray (fmap contractSettingJson (contractSettings contract))),+ ("conditions", jsonArray (fmap conditionJson (contractConditions contract))),+ ("diagnostics", jsonArray (fmap contractDiagnosticJson (contractDiagnostics contract)))+ ]++contractSettingJson :: ContractSetting -> Text+contractSettingJson entry =+ jsonObject+ [ ("key", jsonString (renderKey (entry ^. #key))),+ ("description", jsonString (entry ^. #description)),+ ("sensitivity", jsonString (sensitivityText (entry ^. #sensitivity))),+ ("requirement", jsonString (requirementText (entry ^. #requirement))),+ ("presence", jsonString (presenceText (entry ^. #presence))),+ ("bindings", jsonArray (fmap inputBindingJson (entry ^. #inputs))),+ ("declaredDefaults", jsonArray (fmap declaredDefaultJson (entry ^. #declaredDefaults))),+ ("sourceDefault", maybe "null" sourceDefaultJson (entry ^. #sourceDefault)),+ ("deploymentRequirement", maybe "null" jsonString (entry ^. #deploymentRequirement)),+ ("externalInput", externalInputJson (entry ^. #externalInput))+ ]++inputBindingJson :: InputBinding -> Text+inputBindingJson binding =+ jsonObject+ [ ("channel", jsonString (case inputBindingChannel binding of EnvironmentVariable -> "environment"; CustomInput _ -> "custom")),+ ("channelDetail", case inputBindingChannel binding of EnvironmentVariable -> "null"; CustomInput detail -> jsonString detail),+ ("name", jsonString (inputBindingName binding)),+ ("annotations", jsonTextMap (inputBindingAnnotations binding))+ ]++declaredDefaultJson :: DeclaredDefault -> Text+declaredDefaultJson entry =+ let (kind, value, availability, dependencies, alternatives, fallback) = case entry ^. #shape of+ ConstantShape value' ->+ let (rendered, available) = case value' of+ VisibleDefault textValue -> (jsonString textValue, "visible")+ RedactedDefault -> ("null", "redacted")+ UnrenderableDefault -> ("null", "unrenderable")+ in ("constant", rendered, jsonString available, [], "null", "null")+ DerivedShape keys -> ("derived", "null", "null", keys, "null", "null")+ CaseShape keys count hasFallback -> ("case", "null", "null", keys, jsonInt count, if hasFallback then "true" else "false")+ in jsonObject+ [ ("rule", jsonString (renderRuleName (entry ^. #rule))),+ ("explanation", jsonString (entry ^. #explanation)),+ ("kind", jsonString kind),+ ("value", value),+ ("valueAvailability", availability),+ ("dependencies", jsonKeyArray dependencies),+ ("alternatives", alternatives),+ ("fallback", fallback)+ ]++sourceDefaultJson :: SourceDefault -> Text+sourceDefaultJson value =+ jsonObject+ [ ("origin", originJson (value ^. #origin)),+ ("shadowed", jsonArray (fmap originJson (value ^. #shadowed))),+ ("value", jsonString (renderReportedValue (value ^. #value))),+ ("validity", jsonString (case value ^. #validity of ValidDefault -> "valid"; InvalidDefault _ -> "invalid")),+ ("expected", case value ^. #validity of ValidDefault -> "null"; InvalidDefault expected -> jsonString expected)+ ]++externalInputJson :: ExternalInput -> Text+externalInputJson input =+ let (verdict, reason, coverage, dependencies) = case input of+ InputRequired why -> ("required", Just why, Nothing, [])+ InputConditional why -> ("conditional", Just why, Nothing, [])+ InputDefaulted CoveredBySource -> ("defaulted", Nothing, Just "source", [])+ InputDefaulted (CoveredByDeclaration keys) -> ("defaulted", Nothing, Just "declaration", keys)+ InputOptional -> ("optional", Nothing, Nothing, [])+ reasonTag = \case NoDefault -> "no-default"; InvalidSourceDefault -> "invalid-source-default"; RequiredRequest -> "required-request"; ProfileRequirement -> "deployment-profile"+ in jsonObject+ [ ("verdict", jsonString verdict),+ ("reason", maybe "null" (jsonString . reasonTag) reason),+ ("coverage", maybe "null" jsonString coverage),+ ("dependencies", jsonKeyArray dependencies)+ ]++contractDiagnosticJson :: ContractDiagnostic -> Text+contractDiagnosticJson diagnostic = jsonObject $ case diagnostic of+ ConflictingSensitivity key -> [("kind", jsonString "conflicting-sensitivity"), ("key", jsonString (renderKey key))]+ DefaultStructuralConflict problem ->+ [ ("kind", jsonString "default-structural-conflict"),+ ("key", jsonString (renderKey (problem ^. #key))),+ ("blockedAt", jsonString (renderKey (problem ^. #blockedAt))),+ ("shape", jsonString (rawShapeText (problem ^. #shape))),+ ("origin", originJson (problem ^. #origin))+ ]+ UndeclaredDefaultLeaf problem -> [("kind", jsonString "undeclared-default-leaf"), ("key", jsonString (renderKey (problem ^. #key))), ("origin", originJson (problem ^. #origin))]+ UndeclaredBindingKey binding -> [("kind", jsonString "undeclared-binding-key"), ("key", jsonString (renderKey (inputBindingKey binding))), ("binding", inputBindingJson binding)]+ UndeclaredProfileKey key -> [("kind", jsonString "undeclared-profile-key"), ("key", jsonString (renderKey key))]++-- | Render every invariant outcome in declaration order.+renderValidationText :: ValidationReport -> Text+renderValidationText = Text.concat . fmap renderOutcome . validationOutcomes+ where+ renderOutcome entry =+ "invariant "+ <> renderInvariantRule (entry ^. #rule)+ <> " ["+ <> statusText (entry ^. #status)+ <> "]: "+ <> commaKeys (entry ^. #keys)+ <> "\n expects "+ <> entry ^. #expectation+ <> "\n"+ <> (if null (entry ^. #prerequisites) then "" else " after " <> commaRules (entry ^. #prerequisites) <> "\n")+ statusText = \case+ InvariantPassed -> "passed"+ InvariantFailed n -> "failed (" <> Text.pack (show n) <> (if n == 1 then " violation)" else " violations)")+ InvariantSkipped unmet -> "skipped after " <> commaRules (NonEmpty.toList unmet)+ InvariantNotRun -> "not run"++commaRules :: [InvariantRule] -> Text+commaRules = Text.intercalate ", " . fmap renderInvariantRule++-- | Version-1 resolution document extended with an optional invariant trace.+-- 'renderResolutionJson' retains its original representation.+renderValidatedResolutionJson :: ResolutionReport -> ValidationReport -> Text+renderValidatedResolutionJson report validation =+ versionedJson+ "settei.resolution"+ [ ("nodes", jsonArray (fmap resolutionNodeJson (reportNodes report))),+ ("branches", jsonArray (fmap branchJson (reportBranches report))),+ ("invariants", jsonArray (fmap invariantOutcomeJson (validationOutcomes validation)))+ ]++invariantOutcomeJson :: InvariantOutcome -> Text+invariantOutcomeJson entry =+ let (tag, count, blocked) = case entry ^. #status of+ InvariantPassed -> ("passed", 0, [])+ InvariantFailed n -> ("failed", n, [])+ InvariantSkipped unmet -> ("skipped", 0, NonEmpty.toList unmet)+ InvariantNotRun -> ("not-run", 0, [])+ in jsonObject+ [ ("rule", jsonString (renderInvariantRule (entry ^. #rule))),+ ("keys", jsonKeyArray (entry ^. #keys)),+ ("expectation", jsonString (entry ^. #expectation)),+ ("prerequisites", ruleArray (entry ^. #prerequisites)),+ ("status", jsonString tag),+ ("violations", jsonInt count),+ ("blockedBy", ruleArray blocked)+ ]+ where+ ruleArray = jsonArray . fmap (jsonString . renderInvariantRule)
src/Settei/Report.hs view
@@ -7,6 +7,10 @@ ResolutionNode (..), ResolutionOutcome (..), ResolutionReport (..),+ InvariantStatus (..),+ InvariantOutcome (..),+ ValidationReport (..),+ validationOutcomes, reportBranches, reportNodes, )@@ -14,6 +18,7 @@ import Data.Generics.Labels () import Data.Map.Strict qualified as Map+import Settei.Error (InvariantRule) import Settei.Key (Key) import Settei.Origin (Origin) import Settei.Prelude@@ -68,3 +73,32 @@ -- | Return branch decisions in evaluation order. reportBranches :: ResolutionReport -> [BranchTrace] reportBranches value = value ^. #branches++-- | The result of one application rule, without retaining application values.+data InvariantStatus+ = InvariantPassed+ | InvariantFailed !Int+ | InvariantSkipped !(NonEmpty InvariantRule)+ | InvariantNotRun+ deriving stock (Generic, Eq, Show)++-- | Public declaration metadata and one rule's execution status.+data InvariantOutcome = InvariantOutcome+ { rule :: !InvariantRule,+ keys :: ![Key],+ expectation :: !Text,+ prerequisites :: ![InvariantRule],+ status :: !InvariantStatus+ }+ deriving stock (Generic, Eq, Show)++-- | Ordered application-rule outcomes, without retaining typed configuration values.+-- Resolution failure records every declared rule as not run.+newtype ValidationReport = ValidationReport+ { invariants :: [InvariantOutcome]+ }+ deriving stock (Generic, Eq, Show)++-- | Outcomes in validator declaration order.+validationOutcomes :: ValidationReport -> [InvariantOutcome]+validationOutcomes value = value ^. #invariants
src/Settei/Resolve.hs view
@@ -26,6 +26,7 @@ describeConfig, renderRuleName, )+import Settei.Internal.DefaultValidation (defaultRule, validateDefaultCycles) import Settei.Internal.Schema (Schema, mergeSensitivity) import Settei.Key (Key, keySegments) import Settei.Origin (Origin (..), SourceKind (DerivedSource))@@ -213,39 +214,6 @@ 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),
+ src/Settei/Validate.hs view
@@ -0,0 +1,185 @@+-- |+-- Module: Settei.Validate+-- Description: Pure, structured application invariants after resolution.+--+-- Validators receive the typed configuration. They must be total and return finite+-- lists; this API cannot catch exceptions or stop divergence. All rule metadata must+-- be safe to publish. Expectations are fixed at declaration time; expectations and+-- details used in line-oriented text must be single-line. Details are for public+-- labels only: never interpolate a Secret setting or log the typed record. Settei+-- cannot sanitise author-supplied text.+module Settei.Validate+ ( Violation,+ violation,+ violationWithDetail,+ Validator,+ invariant,+ check,+ requires,+ ValidatorError (..),+ renderValidatorErrorText,+ renderValidatorErrorsText,+ Validators,+ validators,+ describeValidators,+ runValidators,+ ValidatedResult (..),+ validate,+ )+where++import Data.Char (isControl, isSpace)+import Data.Generics.Labels ()+import Data.List (mapAccumL, nub)+import Data.List.NonEmpty qualified as NonEmpty+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text qualified as Text+import Settei.Config (Config, describe)+import Settei.Default (renderRuleName)+import Settei.Error+import Settei.Internal.DefaultValidation (validateDefaultCycles)+import Settei.Key (Key, renderKey)+import Settei.Prelude+import Settei.Report+import Settei.Resolve (ResolveResult)+import Settei.Schema (schemaPossible, schemaSettingKey)++-- | One failing instance, optionally carrying author-supplied public text.+newtype Violation = Violation (Maybe Text)+ deriving stock (Generic, Eq, Show)++-- | A failure with no per-run detail: prefer this for ordinary rules.+violation :: Violation+violation = Violation Nothing++-- | Retain a public label verbatim. Never embed secret values here; Settei cannot+-- sanitise this channel. Keep the label single-line for line-oriented diagnostics.+violationWithDetail :: Text -> Violation+violationWithDetail = Violation . Just++-- No Generic instance: generic conversion would expose private implementation.++-- | One pure application rule with declared keys, a fixed expectation, and optional+-- prerequisites. Construct with 'invariant' or 'check'; validate collections once+-- with 'validators'. Rule functions must be total and return finite lists.+data Validator a = Validator !InvariantRule ![Key] !Text ![InvariantRule] (a -> [Violation])++-- | Declare a named rule over declared setting keys, with a fixed expectation.+invariant :: InvariantRule -> [Key] -> Text -> (a -> [Violation]) -> Validator a+invariant rule keys expectation = Validator rule keys expectation []++-- | A boolean rule fails with one detail-free violation when its predicate is false.+check :: InvariantRule -> [Key] -> Text -> (a -> Bool) -> Validator a+check rule keys expectation predicate =+ invariant rule keys expectation (\value -> if predicate value then [] else [violation])++-- | Append prerequisites, preserving their first occurrence across repeated calls.+-- Every prerequisite must name an earlier rule in the same checked collection.+requires :: [InvariantRule] -> Validator a -> Validator a+requires additional (Validator rule keys expectation prerequisites run) =+ Validator rule keys expectation (nub (prerequisites <> additional)) run++-- | Static declaration errors; no validator function is applied during construction.+data ValidatorError+ = InvalidInvariantRule !InvariantRule+ | DuplicateInvariantRule !InvariantRule+ | EmptyInvariantKeys !InvariantRule+ | UndeclaredInvariantKey !InvariantRule !Key+ | UnknownPrerequisite !InvariantRule !InvariantRule+ | CyclicDeclaration !DefaultCycleProblem+ deriving stock (Generic, Eq, Show)++-- | Render one static declaration error without inspecting application values.+renderValidatorErrorText :: ValidatorError -> Text+renderValidatorErrorText = \case+ InvalidInvariantRule rule -> "invalid invariant rule " <> escapedRule rule+ DuplicateInvariantRule rule -> "duplicate invariant rule " <> escapedRule rule+ EmptyInvariantKeys rule -> "invariant " <> escapedRule rule <> ": no declared keys"+ UndeclaredInvariantKey rule key -> "invariant " <> escapedRule rule <> ": undeclared key " <> renderKey key+ UnknownPrerequisite rule prerequisite ->+ "invariant " <> escapedRule rule <> ": prerequisite is not an earlier rule: " <> escapedRule prerequisite+ CyclicDeclaration problem ->+ "default cycle: " <> Text.intercalate " -> " (fmap renderRuleName (NonEmpty.toList (problem ^. #rules)))++escapedRule :: InvariantRule -> Text+escapedRule = Text.pack . show . renderInvariantRule++-- | Render static declaration errors in order, one per line.+renderValidatorErrorsText :: NonEmpty ValidatorError -> Text+renderValidatorErrorsText = Text.unlines . fmap renderValidatorErrorText . NonEmpty.toList++-- Opaque and deliberately without Generic or writable optics: all public values+-- have passed the construction checks below.++-- | An opaque, checked rule collection paired by the caller with the same 'Config'+-- used for resolution. An empty collection is valid; use 'validate' after resolution.+newtype Validators a = Validators [Validator a]++-- | Check every rule and possible key, including conditional keys, without sources.+-- Cycles precede other problems and suppress only key-membership checks.+validators :: Config a -> [Validator a] -> Either (NonEmpty ValidatorError) (Validators a)+validators config declarations =+ case NonEmpty.nonEmpty (cycleErrors <> concat problems) of+ Nothing -> Right (Validators declarations)+ Just errors -> Left errors+ where+ cycleErrors = [CyclicDeclaration problem | DefaultCycle problem <- validateDefaultCycles config]+ possible = if null cycleErrors then Just (Set.fromList (fmap schemaSettingKey (schemaPossible (describe config)))) else Nothing+ (_, problems) = mapAccumL inspect (Set.empty, Set.empty) declarations+ inspect (earlier, duplicates) (Validator rule keys _ prerequisites _) =+ ( (Set.insert rule earlier, if Set.member rule earlier then Set.insert rule duplicates else duplicates),+ [InvalidInvariantRule rule | let name = renderInvariantRule rule, Text.null name || Text.any (\c -> isSpace c || isControl c) name]+ <> [DuplicateInvariantRule rule | Set.member rule earlier, Set.notMember rule duplicates]+ <> [EmptyInvariantKeys rule | null keys]+ <> [UndeclaredInvariantKey rule key | key <- keys, Just known <- [possible], Set.notMember key known]+ <> [UnknownPrerequisite rule prerequisite | prerequisite <- prerequisites, Set.notMember prerequisite earlier]+ )++-- | Inspect declarations with every rule marked not run. No rule function is forced.+describeValidators :: Validators a -> ValidationReport+describeValidators (Validators declarations) =+ ValidationReport [validatorOutcome declaration InvariantNotRun | declaration <- declarations]++validatorOutcome :: Validator a -> InvariantStatus -> InvariantOutcome+validatorOutcome (Validator rule keys expectation prerequisites _) status =+ InvariantOutcome {rule, keys, expectation, prerequisites, status}++-- | Run eligible rules in declaration order, accumulating independent violations.+-- Failed or skipped prerequisites block a rule without evaluating its function.+runValidators :: Validators a -> a -> (ValidationReport, [InvariantProblem])+runValidators (Validators declarations) value =+ (ValidationReport (fmap fst results), concatMap snd results)+ where+ (_, results) = mapAccumL runOne Map.empty declarations+ runOne statuses declaration@(Validator rule keys expectation prerequisites run) =+ let blocked = filter (\prerequisite -> Map.lookup prerequisite statuses /= Just InvariantPassed) prerequisites+ (status, problems) = case NonEmpty.nonEmpty blocked of+ Just unmet -> (InvariantSkipped unmet, [])+ Nothing ->+ let violations = run value+ failures = [InvariantProblem {rule, keys, expectation, detail} | Violation detail <- violations]+ in (if null failures then InvariantPassed else InvariantFailed (length failures), failures)+ in (Map.insert rule status statuses, (validatorOutcome declaration status, problems))++-- | A typed answer with unchanged resolution provenance and validation outcomes.+-- No Show or Eq instance: the answer may contain secrets.+data ValidatedResult a = ValidatedResult+ { answer :: !(Either (NonEmpty ConfigError) a),+ report :: !ResolutionReport,+ warnings :: ![ConfigWarning],+ validation :: !ValidationReport+ }+ deriving stock (Generic)++-- | Validate only a successful answer. Use the collection checked against the same+-- declaration that produced this result; the type alone cannot prove that pairing.+-- Conditional membership does not imply evaluation: handle optional values totally.+validate :: Validators a -> ResolveResult a -> ValidatedResult a+validate declarations result =+ let (answer, validation) = case result ^. #answer of+ Left errors -> (Left errors, describeValidators declarations)+ Right value ->+ let (validationReport, problems) = runValidators declarations value+ in (maybe (Right value) (Left . fmap InvariantError) (NonEmpty.nonEmpty problems), validationReport)+ in ValidatedResult {answer, report = result ^. #report, warnings = result ^. #warnings, validation}
test/Main.hs view
@@ -1,11 +1,13 @@ module Main (main) where import Settei.ConfigTest qualified as ConfigTest+import Settei.ContractTest qualified as ContractTest 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.ValidateTest qualified as ValidateTest import Settei.ValueTest qualified as ValueTest import Test.Tasty (defaultMain, testGroup) @@ -20,5 +22,7 @@ SourceTest.tests, ResolveTest.tests, DefaultTest.tests,- RenderTest.tests+ RenderTest.tests,+ ContractTest.tests,+ ValidateTest.tests ]
test/Settei/ConfigTest.hs view
@@ -5,7 +5,7 @@ import Data.Map.Strict qualified as Map import Data.Set qualified as Set import Data.Text qualified as Text-import Settei+import Settei hiding (RequiredRequest) import Settei.Internal.Config (Request (..), runConfig) import Settei.Prelude import Settei.Prototype.Free (freeNecessaryKeys, freePossibleKeys)
+ test/Settei/ContractTest.hs view
@@ -0,0 +1,198 @@+module Settei.ContractTest (tests) where++import Data.Generics.Labels ()+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, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+ testGroup+ "Settei.Contract"+ [ testCase "renders the golden contract text" $ do+ expected <- TextIO.readFile "test/golden/contract.txt"+ renderContractText comprehensive @?= expected,+ testCase "renders the golden contract JSON" $ do+ expected <- TextIO.readFile "test/golden/contract.json"+ renderContractJson comprehensive <> "\n" @?= expected,+ testCase "joins bindings in supplied order and keeps unbound keys" $ do+ let contract = comprehensive+ fmap inputBindingName (entry "required" contract ^. #inputs) @?= ["FIRST", "SECOND"]+ entry "optional" contract ^. #inputs @?= []+ assertBool "missing orphan binding diagnostic" (UndeclaredBindingKey (inputBinding EnvironmentVariable "ORPHAN" (validKey "nothing.here")) `elem` contractDiagnostics contract),+ testCase "reports all default shapes without evaluating computations or case values" $ do+ let contract = comprehensive+ entry "constant" contract ^. #declaredDefaults @?= [DeclaredDefault (RuleName "constant-rule") "constant" (ConstantShape (VisibleDefault "42"))]+ shapes "opaque" contract @?= [ConstantShape UnrenderableDefault]+ shapes "secret" contract @?= [ConstantShape RedactedDefault]+ shapes "derived" contract @?= [DerivedShape [validKey "required"]]+ shapes "case" contract @?= [CaseShape [validKey "required"] 1 False]+ shapes "caseFallback" contract @?= [CaseShape [validKey "required"] 1 True]+ assertBool "deferred computation omitted" ("value not computed" `Text.isInfixOf` renderContractText contract),+ testCase "source candidates retain validity, winning origin and ordered shadows" $ do+ let contract = comprehensive+ fmap+ (\value -> (value ^. #origin . #name, fmap (\origin -> origin ^. #name) (value ^. #shadowed), value ^. #validity))+ (entry "source" contract ^. #sourceDefault)+ @?= Just ("high", ["middle", "low"], ValidDefault)+ verdict "source" contract @?= InputDefaulted CoveredBySource+ verdict "invalid" contract @?= InputRequired InvalidSourceDefault+ assertBool "missing invalid validity" ("\"validity\":\"invalid\"" `Text.isInfixOf` renderContractJson contract),+ testCase "diagnostics contain no candidate values and retain all inconsistency kinds" $ do+ let output = renderContractJson comprehensive+ mapM_+ (\kind -> assertBool (Text.unpack kind) (kind `Text.isInfixOf` output))+ ["conflicting-sensitivity", "default-structural-conflict", "undeclared-default-leaf", "undeclared-binding-key", "undeclared-profile-key"]+ assertBool "conflict did not become secret" (entry "mixed" comprehensive ^. #sensitivity == Secret),+ testCase "secret sentinel is absent from Show, text, JSON and diagnostics" $+ mapM_+ (\output -> assertBool "secret leaked" (not (sentinel `Text.isInfixOf` output)))+ [Text.pack (show comprehensive), renderContractText comprehensive, renderContractJson comprehensive, Text.pack (show (contractDiagnostics comprehensive))],+ testCase "identical inputs produce byte-identical outputs" $ do+ renderContractText comprehensive @?= renderContractText (build comprehensiveInputs comprehensiveConfig)+ renderContractJson comprehensive @?= renderContractJson (build comprehensiveInputs comprehensiveConfig),+ testCase "profile requires explicit input while retaining default metadata" $ do+ verdict "profiled" comprehensive @?= InputRequired ProfileRequirement+ assertBool "profile default lost" (not (null (entry "profiled" comprehensive ^. #declaredDefaults))),+ testCase "required occurrence is not satisfied by another occurrence's default" $ do+ let declaration = (,) <$> required x <*> withDefault x (constantDefault (RuleName "x-default") "fallback" "fallback")+ contract = build emptyContractInputs declaration+ verdict "x" contract @?= InputRequired RequiredRequest+ assertBool "required request unexpectedly resolved" (isFailure (resolve defaultResolveOptions [] declaration)),+ testCase "optional plus conditional required keeps occurrence-based verdict and merged schema" $ do+ let declaration = (,) <$> optional x <*> conditional x+ contract = build emptyContractInputs declaration+ entry "x" contract ^. #requirement @?= Required+ entry "x" contract ^. #presence @?= Necessary+ assertVerdict "x" (InputConditional NoDefault) contract+ assertBool "unselected branch failed" (not (isFailure (resolve defaultResolveOptions [environment "development"] declaration)))+ assertBool "selected branch succeeded" (isFailure (resolve defaultResolveOptions [environment "production"] declaration)),+ testCase "declaration default plus conditional required stays conditional" $ do+ let declaration = (,) <$> withDefault x (constantDefault (RuleName "x-default") "fallback" "fallback") <*> conditional x+ contract = build emptyContractInputs declaration+ assertVerdict "x" (InputConditional RequiredRequest) contract+ assertBool "development failed" (not (isFailure (resolve defaultResolveOptions [environment "development"] declaration)))+ assertBool "production succeeded" (isFailure (resolve defaultResolveOptions [environment "production"] declaration)),+ testCase "conditional-only source rejection remains conditional and branch-local" $ do+ let declaration = conditional integerX+ sources = [pairs "bad" [("x", RawText "bad")]]+ contract = build (ContractInputs [] sources Nothing) declaration+ assertVerdict "x" (InputConditional InvalidSourceDefault) contract+ assertBool "unselected invalid branch failed" (not (isFailure (resolve defaultResolveOptions (environment "development" : sources) declaration)))+ assertBool "selected invalid branch succeeded" (isFailure (resolve defaultResolveOptions (environment "production" : sources) declaration)),+ testCase "necessary acceptance plus conditional rejection remains conditional" $ do+ let declaration = (,) <$> required x <*> conditional integerX+ sources = [pairs "bad" [("x", RawText "bad")]]+ contract = build (ContractInputs [] sources Nothing) declaration+ assertVerdict "x" (InputConditional InvalidSourceDefault) contract+ assertBool "necessary accepting request failed" (not (isFailure (resolve defaultResolveOptions (environment "development" : sources) declaration)))+ assertBool "conditional rejecting request succeeded" (isFailure (resolve defaultResolveOptions (environment "production" : sources) declaration)),+ testCase "later necessary rejection outranks earlier conditional rejection" $ do+ let declaration = (,) <$> conditional integerX <*> required integerX+ contract = build (ContractInputs [] [pairs "bad" [("x", RawText "bad")]] Nothing) declaration+ assertVerdict "x" (InputRequired InvalidSourceDefault) contract,+ testCase "secret constants never force their renderer or value" $ do+ let settingSpec = withRenderer (\_ -> error "secret renderer invoked") (secretSetting (validKey "poison") "secret" textDecoder)+ contract = build emptyContractInputs (withDefault settingSpec (constantDefault (RuleName "poison") "secret" (error "secret value forced")))+ assertBool "secret default unavailable" ("redacted" `Text.isInfixOf` renderContractJson contract)+ assertBool "secret default unavailable in Show" ("RedactedDefault" `Text.isInfixOf` Text.pack (show contract)),+ testCase "cycle preflight avoids all source hooks" $ do+ let cyclic = withDefault x (derivedDefault (RuleName "cycle") "recursive" cyclic id)+ poison = locateSource (\_ -> error "source hook evaluated") (pairs "poison" [("x", RawText sentinel)])+ case deploymentContract (ContractInputs [] [poison] Nothing) cyclic of+ Left (DefaultCycle _ :| []) -> pure ()+ _ -> assertFailure "expected a default cycle"+ ]++validKey :: Text -> Key+validKey = either (error . show) id . parseKey++publicText :: Text -> Setting Text+publicText name = publicShowSetting (validKey name) name textDecoder++publicInt :: Text -> Setting Int+publicInt name = publicShowSetting (validKey name) name boundedIntegralDecoder++x :: Setting Text+x = publicText "x"++integerX :: Setting Int+integerX = publicInt "x"++conditional :: Setting a -> Config (Maybe a)+conditional settingSpec = whenEq (required (publicText "environment")) "production" (required settingSpec)++environment :: Text -> Source+environment value = pairs "environment" [("environment", RawText value)]++pairs :: Text -> [(Text, RawValue)] -> Source+pairs name values = either (error . show) id (sourceFromPairs name BuiltInSource [(validKey target, value) | (target, value) <- values])++build :: ContractInputs -> Config a -> DeploymentContract+build supplied = either (error . show) id . deploymentContract supplied++entry :: Text -> DeploymentContract -> ContractSetting+entry target contract = case filter ((== validKey target) . view #key) (contractSettings contract) of+ value : _ -> value+ [] -> error ("missing contract key: " <> Text.unpack target)++verdict :: Text -> DeploymentContract -> ExternalInput+verdict target contract = entry target contract ^. #externalInput++shapes :: Text -> DeploymentContract -> [DefaultShape]+shapes target contract = fmap (view #shape) (entry target contract ^. #declaredDefaults)++isFailure :: ResolveResult a -> Bool+isFailure result = case result ^. #answer of Left _ -> True; Right _ -> False++assertVerdict :: Text -> ExternalInput -> DeploymentContract -> IO ()+assertVerdict target expected contract = do+ verdict target contract @?= expected+ let verdictTag = case expected of InputRequired _ -> "required"; InputConditional _ -> "conditional"; InputDefaulted _ -> "defaulted"; InputOptional -> "optional"+ assertBool "text verdict absent" (("input: " <> verdictTag) `Text.isInfixOf` renderContractText contract)+ assertBool "JSON verdict absent" (("\"verdict\":\"" <> verdictTag <> "\"") `Text.isInfixOf` renderContractJson contract)++sentinel :: Text+sentinel = "SECRET-CONTRACT-SENTINEL-雪"++comprehensive :: DeploymentContract+comprehensive = build comprehensiveInputs comprehensiveConfig++comprehensiveInputs :: ContractInputs+comprehensiveInputs =+ ContractInputs+ [inputBinding EnvironmentVariable "FIRST" (validKey "required"), inputBinding (CustomInput "mounted") "SECOND" (validKey "required"), inputBinding EnvironmentVariable "ORPHAN" (validKey "nothing.here")]+ [ pairs "low" [("source", RawText "low"), ("secretSource", RawText sentinel), ("invalid", RawText "bad"), ("unknown", RawText sentinel), ("blocked", RawText sentinel)],+ pairs "middle" [("source", RawText "middle")],+ pairs "high" [("source", RawText "high")]+ ]+ (Just (deploymentProfile "production" [(validKey "profiled", "state explicitly"), (validKey "unknownProfile", "absent")]))++comprehensiveConfig :: Config ()+comprehensiveConfig =+ sequenceA_+ [ () <$ required (publicText "required"),+ () <$ required (secretSetting (validKey "requiredSecret") "secret" textDecoder),+ () <$ optional (publicText "optional"),+ () <$ withDefault (publicInt "constant") (constantDefault (RuleName "constant-rule") "constant" 42),+ () <$ withDefault (publicSetting (validKey "opaque") "opaque" textDecoder) (constantDefault (RuleName "opaque-rule") "opaque" "opaque"),+ () <$ withDefault (secretSetting (validKey "secret") "secret" textDecoder) (constantDefault (RuleName "secret-rule") "secret" sentinel),+ () <$ withDefault (publicText "derived") (derivedDefault (RuleName "derived-rule") "derived" (required (publicText "required")) (\_ -> error "derived evaluated")),+ () <$ withDefault (publicText "case") (caseDefault (RuleName "case-rule") "case" (required (publicText "required")) (("development", error "case evaluated") :| []) Nothing),+ () <$ withDefault (publicText "caseFallback") (caseDefault (RuleName "fallback-rule") "fallback" (required (publicText "required")) (("development", error "case evaluated") :| []) (Just (error "fallback evaluated"))),+ () <$ conditional (publicText "conditional"),+ () <$ required (publicText "requiredDefault"),+ () <$ withDefault (publicText "requiredDefault") (constantDefault (RuleName "competing-default") "fallback on another request" "fallback"),+ () <$ required (publicText "source"),+ () <$ required (publicInt "invalid"),+ () <$ required (secretSetting (validKey "secretSource") "secret source" textDecoder),+ () <$ required (publicText "blocked.child"),+ () <$ withDefault (publicText "mixed") (constantDefault (RuleName "mixed-rule") "mixed" sentinel),+ () <$ optional (secretSetting (validKey "mixed") "mixed" textDecoder),+ () <$ withDefault (publicText "profiled") (constantDefault (RuleName "profile-rule") "profile" "default")+ ]+ where+ sequenceA_ = foldr (*>) (pure ())
test/Settei/ResolveTest.hs view
@@ -382,6 +382,7 @@ DefaultError problem -> problem ^. #key DefaultCycle _ -> error "a cycle has no single setting key" SensitivityConflict problem -> problem ^. #key+ InvariantError _ -> error "an invariant can involve multiple setting keys" serviceConfig :: Config (Text, Int) serviceConfig = (,) <$> required hostSetting <*> required portSetting
+ test/Settei/ValidateTest.hs view
@@ -0,0 +1,230 @@+module Settei.ValidateTest (tests) where++import Data.Generics.Labels ()+import Data.List.NonEmpty qualified as NonEmpty+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.Validate"+ [ testCase "empty collection preserves the typed answer" $ do+ let result = validate (collection []) (resolved [])+ assertBool "answer changed" (result ^. #answer == resolved [] ^. #answer)+ validationOutcomes (result ^. #validation) @?= [],+ testCase "valid configuration passes all rules without changing values" $ do+ let base = resolved []; result = validate workerValidators base+ assertBool "answer changed" (result ^. #answer == base ^. #answer)+ statuses result @?= replicate 5 InvariantPassed+ result ^. #report @?= base ^. #report+ result ^. #warnings @?= base ^. #warnings,+ testCase "independent failures accumulate in declaration and violation order" $ do+ problems <- failures failingResult+ fmap (^. #rule) problems @?= fmap InvariantRule ["pool-capacity", "visibility-timeout", "provider-account", "provider-account"]+ fmap (^. #keys) problems @?= [validKeys ["workers.jobPoolSize", "workers.concurrency"], validKeys ["workers.visibilityTimeoutSeconds", "workers.concurrency"], validKeys ["email.accounts", "email.credentials"], validKeys ["email.accounts", "email.credentials"]]+ fmap (^. #detail) problems @?= [Nothing, Nothing, Just "account alpha", Just "account beta"]+ statuses failingResult @?= [InvariantFailed 1, InvariantFailed 1, InvariantPassed, InvariantPassed, InvariantFailed 2],+ testCase "failed prerequisite skips an unforced validator function" $ do+ let rules = take 3 hubRules <> [requires [InvariantRule "replica"] (invariant (InvariantRule "replica-pool-share") (validKeys ["workers.jobPoolSize", "workers.replica.count"]) "pool covers replicas" (error "skipped function forced"))]+ result = validate (collection rules) (resolved [("workers.replica.index", RawText "2")])+ statuses result @?= [InvariantPassed, InvariantPassed, InvariantFailed 1, InvariantSkipped (InvariantRule "replica" :| [])],+ testCase "requires composes and blocked prerequisites preserve order transitively" $ do+ let rule name = check (InvariantRule name) (validKeys ["workers.concurrency"]) "safe" (const False)+ rules = [rule "a", requires [InvariantRule "a"] (rule "b"), requires [InvariantRule "a", InvariantRule "b"] (requires [InvariantRule "b", InvariantRule "a"] (invariant (InvariantRule "c") (validKeys ["workers.concurrency"]) "safe" (error "blocked")))]+ report = validate (collection rules) (resolved []) ^. #validation+ fmap (^. #status) (validationOutcomes report) @?= [InvariantFailed 1, InvariantSkipped (InvariantRule "a" :| []), InvariantSkipped (InvariantRule "b" :| [InvariantRule "a"])]+ fmap (^. #prerequisites) (validationOutcomes report) @?= [[], [InvariantRule "a"], [InvariantRule "b", InvariantRule "a"]]+ assertBool "skipped JSON absent" ("\"blockedBy\":[\"b\",\"a\"]" `Text.isInfixOf` renderValidatedResolutionJson (ResolutionReport mempty []) report)+ assertBool "skipped text absent" ("[skipped after b, a]" `Text.isInfixOf` renderValidationText report),+ testCase "failed resolution retains errors report warnings and never runs functions" $ do+ let base = resolve defaultResolveOptions [fixture (filter ((/= "workers.concurrency") . fst) validPairs)] hubConfig+ declarations = collection [requires (entry ^. #prerequisites) (invariant (entry ^. #rule) (entry ^. #keys) (entry ^. #expectation) (error "failed-resolution function forced")) | entry <- validationOutcomes (describeValidators workerValidators)]+ result = validate declarations base+ assertBool "errors changed" (result ^. #answer == base ^. #answer)+ case result ^. #answer of+ Left (MissingRequired _ :| []) -> pure ()+ _ -> fail "expected original missing error"+ result ^. #report @?= base ^. #report+ result ^. #warnings @?= base ^. #warnings+ statuses result @?= replicate 5 InvariantNotRun,+ testCase "role collections select shared rules" $ do+ let base = resolved [("workers.jobPoolSize", RawText "2")]+ assertBool "server rejected" (case validate serverValidators base ^. #answer of Right _ -> True; _ -> False)+ statuses (validate workerValidators base) @?= [InvariantFailed 1, InvariantPassed, InvariantPassed, InvariantPassed, InvariantPassed],+ testCase "describe and direct execution are source free" $ do+ let report = describeValidators workerValidators+ fmap (^. #status) (validationOutcomes report) @?= replicate 5 InvariantNotRun+ fmap (^. #prerequisites) (validationOutcomes report) @?= [[], [], [], [InvariantRule "replica"], []]+ case resolved [] ^. #answer of+ Left _ -> fail "fixture failed"+ Right value -> do+ let (directReport, problems) = runValidators workerValidators value+ directReport @?= validate workerValidators (resolved []) ^. #validation+ problems @?= [],+ testCase "construction accumulates every offender in defined order" $ do+ let rule name ks = invariant (InvariantRule name) (validKeys ks) "safe" (error "construction forced function")+ declarations = [rule "" [], rule "white space" ["nothing.here"], rule "line\nbreak" ["workers.concurrency"], requires [InvariantRule "later"] (rule "early" ["workers.concurrency"]), requires [InvariantRule "self"] (rule "self" ["workers.concurrency"]), rule "later" ["workers.concurrency"], rule "later" ["workers.concurrency"], rule "later" ["workers.concurrency"]]+ expected = [InvalidInvariantRule (InvariantRule ""), EmptyInvariantKeys (InvariantRule ""), InvalidInvariantRule (InvariantRule "white space"), UndeclaredInvariantKey (InvariantRule "white space") (validKey "nothing.here"), InvalidInvariantRule (InvariantRule "line\nbreak"), UnknownPrerequisite (InvariantRule "early") (InvariantRule "later"), UnknownPrerequisite (InvariantRule "self") (InvariantRule "self"), DuplicateInvariantRule (InvariantRule "later")]+ case validators hubConfig declarations of+ Right _ -> fail "invalid declarations accepted"+ Left errors -> do+ NonEmpty.toList errors @?= expected+ length (Text.lines (renderValidatorErrorsText errors)) @?= length expected+ mapM_ (\problem -> assertBool "empty error" (not (Text.null (renderValidatorErrorText problem)))) expected+ assertBool "newline not escaped" ("line\\nbreak" `Text.isInfixOf` renderValidatorErrorsText errors),+ testCase "cycles precede metadata errors and suppress key-membership checks" $+ case validators cyclicA [check (InvariantRule "") [validKey "nothing.here"] "safe" (const True)] of+ Left errors -> do+ NonEmpty.toList errors @?= [CyclicDeclaration (DefaultCycleProblem (RuleName "cycle-a" :| [RuleName "cycle-b", RuleName "cycle-a"])), InvalidInvariantRule (InvariantRule "")]+ assertBool "cycle path missing" ("cycle-a -> cycle-b -> cycle-a" `Text.isInfixOf` renderValidatorErrorsText errors)+ Right _ -> fail "cycle accepted",+ testCase "optional keys are allowed without assuming presence" $ do+ let config = optional (publicSetting (validKey "maybe.value") "optional" textDecoder)+ case validators config [check (InvariantRule "optional-value") [validKey "maybe.value"] "may be absent" (const True)] of+ Left errors -> fail (Text.unpack (renderValidatorErrorsText errors))+ Right rules -> case validate rules (resolve defaultResolveOptions [] config) ^. #answer of+ Right Nothing -> pure ()+ _ -> fail "optional changed",+ testCase "conditional keys can be referenced on an unselected path" $ do+ let config = whenEq (pure False) True (required (publicSetting (validKey "branch.value") "conditional" textDecoder))+ case validators config [check (InvariantRule "branch-value") [validKey "branch.value"] "may be unselected" (== Nothing)] of+ Left errors -> fail (Text.unpack (renderValidatorErrorsText errors))+ Right rules -> statuses (validate rules (resolve defaultResolveOptions [] config)) @?= [InvariantPassed],+ testCase "direct failing execution agrees with validated resolution" $ do+ case resolved overrides ^. #answer of+ Left _ -> fail "fixture did not resolve"+ Right value -> do+ let (report, problems) = runValidators workerValidators value+ expected <- failures failingResult+ problems @?= expected+ report @?= failingResult ^. #validation,+ testCase "detail is retained verbatim and escaped by JSON" $ do+ let detail = "public \"account\" \\ label"+ result = validate (collection [invariant (InvariantRule "label") (validKeys ["email.accounts"]) "has credential" (const [violationWithDetail detail])]) (resolved [])+ problems <- failures result+ fmap (^. #detail) problems @?= [Just detail]+ errors <- errorList result+ assertBool "detail absent in text" (detail `Text.isInfixOf` renderErrorsText errors)+ assertBool "detail absent in JSON" ("public \\\"account\\\" \\\\ label" `Text.isInfixOf` renderErrorsJson errors),+ testCase "all retained structures and renderers omit raw and escaped secrets" $ do+ problems <- failures failingResult+ errors <- errorList failingResult+ let report = failingResult ^. #report; validation = failingResult ^. #validation+ mapM_ assertSafe [Text.pack (show problems), Text.pack (show errors), Text.pack (show report), Text.pack (show validation), Text.pack (show (validationOutcomes validation)), renderErrorsText errors, renderErrorsJson errors, renderValidationText validation, renderResolutionText report, renderResolutionJson report, renderValidatedResolutionJson report validation]+ assertBool "scan missed escaped leak" (hasSecret (Text.pack (show secretSentinel))),+ testCase "rendering is deterministic and preserves rule order independently of key order" $ do+ let output = renderValidatedResolutionJson (failingResult ^. #report) (failingResult ^. #validation)+ reordered = validate workerValidators (resolve defaultResolveOptions [fixture (reverse (overrides <> filter (\(name, _) -> name `notElem` fmap fst overrides) validPairs))] hubConfig)+ renderValidatedResolutionJson (reordered ^. #report) (reordered ^. #validation) @?= output+ renderValidatedResolutionJson (failingResult ^. #report) (failingResult ^. #validation) @?= output,+ testCase "validation text golden" $ golden "validation.txt" (renderValidationText (failingResult ^. #validation)),+ testCase "validated resolution JSON golden" $ golden "validation.json" (renderValidatedResolutionJson (failingResult ^. #report) (failingResult ^. #validation)),+ testCase "invariant error text golden" $ errorList failingResult >>= golden "invariant-errors.txt" . renderErrorsText,+ testCase "invariant error JSON golden" $ errorList failingResult >>= golden "invariant-errors.json" . renderErrorsJson+ ]++-- Intentionally no Show instance on either secret-bearing type.+newtype Credentials = Credentials [Text] deriving stock (Generic, Eq)++data HubConfig = HubConfig+ { environment :: !Text,+ pool :: !Int,+ jobPool :: !Int,+ concurrency :: !Int,+ visibility :: !Int,+ replicaIndex :: !Int,+ replicaCount :: !Int,+ accounts :: ![Text],+ databaseUrl :: !Text,+ credentials :: !Credentials+ }+ deriving stock (Generic, Eq)++hubConfig :: Config HubConfig+hubConfig =+ HubConfig+ <$> required (publicSetting (validKey "runtime.environment") "environment" (enumDecoder [("development", "development"), ("production", "production")]))+ <*> number "database.poolSize"+ <*> number "workers.jobPoolSize"+ <*> number "workers.concurrency"+ <*> number "workers.visibilityTimeoutSeconds"+ <*> number "workers.replica.index"+ <*> number "workers.replica.count"+ <*> required (publicSetting (validKey "email.accounts") "accounts" (listDecoder textDecoder))+ <*> required (secretSetting (validKey "database.url") "database" textDecoder)+ <*> required (secretSetting (validKey "email.credentials") "credentials" (Credentials <$> listDecoder textDecoder))+ where+ number name = required (publicSetting (validKey name) name boundedIntegralDecoder)++hubRules :: [Validator HubConfig]+hubRules =+ [ check (InvariantRule "pool-capacity") (validKeys ["workers.jobPoolSize", "workers.concurrency"]) "pool covers concurrency" (\c -> c ^. #jobPool >= c ^. #concurrency),+ check (InvariantRule "visibility-timeout") (validKeys ["workers.visibilityTimeoutSeconds", "workers.concurrency"]) "timeout covers twice concurrency" (\c -> toInteger (c ^. #visibility) >= 2 * toInteger (c ^. #concurrency)),+ check (InvariantRule "replica") (validKeys ["workers.replica.index", "workers.replica.count"]) "index is within replica count" (\c -> c ^. #replicaIndex >= 0 && c ^. #replicaIndex < c ^. #replicaCount),+ requires [InvariantRule "replica"] (check (InvariantRule "replica-pool-share") (validKeys ["workers.jobPoolSize", "workers.replica.count"]) "pool covers replicas" (\c -> c ^. #jobPool >= c ^. #replicaCount)),+ invariant (InvariantRule "provider-account") (validKeys ["email.accounts", "email.credentials"]) "every account has a credential" (\c -> let Credentials entries = c ^. #credentials; names = fmap (Text.takeWhile (/= ':')) entries in [violationWithDetail ("account " <> name) | name <- c ^. #accounts, name `notElem` names])+ ]++workerValidators, serverValidators :: Validators HubConfig+workerValidators = collection hubRules+serverValidators = collection [last hubRules]++collection :: [Validator HubConfig] -> Validators HubConfig+collection rules = either (error . Text.unpack . renderValidatorErrorsText) id (validators hubConfig rules)++validPairs :: [(Text, RawValue)]+validPairs = [("runtime.environment", RawText "production"), ("database.poolSize", RawText "10"), ("workers.jobPoolSize", RawText "8"), ("workers.concurrency", RawText "4"), ("workers.visibilityTimeoutSeconds", RawText "30"), ("workers.replica.index", RawText "0"), ("workers.replica.count", RawText "2"), ("email.accounts", RawArray [RawText "alpha", RawText "beta"]), ("database.url", RawText secretSentinel), ("email.credentials", RawArray [RawText ("alpha:" <> secretSentinel), RawText ("beta:" <> secretSentinel)])]++overrides :: [(Text, RawValue)]+overrides = [("workers.jobPoolSize", RawText "2"), ("workers.visibilityTimeoutSeconds", RawText "1"), ("email.credentials", RawArray [RawText ("other:" <> secretSentinel)])]++resolved :: [(Text, RawValue)] -> ResolveResult HubConfig+resolved changes = resolve defaultResolveOptions [fixture (changes <> filter (\(name, _) -> name `notElem` fmap fst changes) validPairs)] hubConfig++fixture :: [(Text, RawValue)] -> Source+fixture pairs = either (const (error "invalid fixture pairs")) id (sourceFromPairs "fixture" EnvironmentSource [(validKey name, value) | (name, value) <- pairs])++failingResult :: ValidatedResult HubConfig+failingResult = validate workerValidators (resolved overrides)++statuses :: ValidatedResult a -> [InvariantStatus]+statuses result = fmap (^. #status) (validationOutcomes (result ^. #validation))++errorList :: ValidatedResult a -> IO (NonEmpty ConfigError)+errorList result = case result ^. #answer of Left errors -> pure errors; Right _ -> fail "expected rejection"++failures :: ValidatedResult a -> IO [InvariantProblem]+failures result = do+ errors <- errorList result+ let problems = [problem | InvariantError problem <- NonEmpty.toList errors]+ length problems @?= length errors+ pure problems++validKey :: Text -> Key+validKey = either (error . show) id . parseKey++validKeys :: [Text] -> [Key]+validKeys = fmap validKey++secretSentinel :: Text+secretSentinel = "SETTEI_VALIDATION_SECRET_29\"\\\n秘密"++hasSecret :: Text -> Bool+hasSecret output = any (`Text.isInfixOf` output) [secretSentinel, "SETTEI_VALIDATION_SECRET_29"]++assertSafe :: Text -> IO ()+assertSafe output = assertBool "secret retained in diagnostic" (not (hasSecret output))++golden :: FilePath -> Text -> IO ()+golden name actual = do+ expected <- TextIO.readFile ("test/golden/" <> name)+ Text.stripEnd actual @?= Text.stripEnd expected++cyclicA, cyclicB :: Config Text+cyclicA = withDefault (publicSetting (validKey "cycle.a") "A" textDecoder) (derivedDefault (RuleName "cycle-a") "A from B" cyclicB id)+cyclicB = withDefault (publicSetting (validKey "cycle.b") "B" textDecoder) (derivedDefault (RuleName "cycle-b") "B from A" cyclicA id)
+ test/golden/contract.json view
@@ -0,0 +1,1 @@+{"schemaVersion":1,"type":"settei.contract","profile":"production","settings":[{"key":"blocked.child","description":"blocked.child","sensitivity":"public","requirement":"required","presence":"necessary","bindings":[],"declaredDefaults":[],"sourceDefault":null,"deploymentRequirement":null,"externalInput":{"verdict":"required","reason":"no-default","coverage":null,"dependencies":[]}},{"key":"case","description":"case","sensitivity":"public","requirement":"optional","presence":"necessary","bindings":[],"declaredDefaults":[{"rule":"case-rule","explanation":"case","kind":"case","value":null,"valueAvailability":null,"dependencies":["required"],"alternatives":1,"fallback":false}],"sourceDefault":null,"deploymentRequirement":null,"externalInput":{"verdict":"defaulted","reason":null,"coverage":"declaration","dependencies":["required"]}},{"key":"caseFallback","description":"caseFallback","sensitivity":"public","requirement":"optional","presence":"necessary","bindings":[],"declaredDefaults":[{"rule":"fallback-rule","explanation":"fallback","kind":"case","value":null,"valueAvailability":null,"dependencies":["required"],"alternatives":1,"fallback":true}],"sourceDefault":null,"deploymentRequirement":null,"externalInput":{"verdict":"defaulted","reason":null,"coverage":"declaration","dependencies":["required"]}},{"key":"conditional","description":"conditional","sensitivity":"public","requirement":"required","presence":"conditional","bindings":[],"declaredDefaults":[],"sourceDefault":null,"deploymentRequirement":null,"externalInput":{"verdict":"conditional","reason":"no-default","coverage":null,"dependencies":[]}},{"key":"constant","description":"constant","sensitivity":"public","requirement":"optional","presence":"necessary","bindings":[],"declaredDefaults":[{"rule":"constant-rule","explanation":"constant","kind":"constant","value":"42","valueAvailability":"visible","dependencies":[],"alternatives":null,"fallback":null}],"sourceDefault":null,"deploymentRequirement":null,"externalInput":{"verdict":"defaulted","reason":null,"coverage":"declaration","dependencies":[]}},{"key":"derived","description":"derived","sensitivity":"public","requirement":"optional","presence":"necessary","bindings":[],"declaredDefaults":[{"rule":"derived-rule","explanation":"derived","kind":"derived","value":null,"valueAvailability":null,"dependencies":["required"],"alternatives":null,"fallback":null}],"sourceDefault":null,"deploymentRequirement":null,"externalInput":{"verdict":"defaulted","reason":null,"coverage":"declaration","dependencies":["required"]}},{"key":"environment","description":"environment","sensitivity":"public","requirement":"required","presence":"necessary","bindings":[],"declaredDefaults":[],"sourceDefault":null,"deploymentRequirement":null,"externalInput":{"verdict":"required","reason":"no-default","coverage":null,"dependencies":[]}},{"key":"invalid","description":"invalid","sensitivity":"public","requirement":"required","presence":"necessary","bindings":[],"declaredDefaults":[],"sourceDefault":{"origin":{"kind":"built-in","kindDetail":null,"name":"low","key":"invalid","location":null,"annotations":{}},"shadowed":[],"value":"\"bad\"","validity":"invalid","expected":"integer between -9223372036854775808 and 9223372036854775807"},"deploymentRequirement":null,"externalInput":{"verdict":"required","reason":"invalid-source-default","coverage":null,"dependencies":[]}},{"key":"mixed","description":"mixed","sensitivity":"secret","requirement":"optional","presence":"necessary","bindings":[],"declaredDefaults":[{"rule":"mixed-rule","explanation":"mixed","kind":"constant","value":null,"valueAvailability":"redacted","dependencies":[],"alternatives":null,"fallback":null}],"sourceDefault":null,"deploymentRequirement":null,"externalInput":{"verdict":"defaulted","reason":null,"coverage":"declaration","dependencies":[]}},{"key":"opaque","description":"opaque","sensitivity":"public","requirement":"optional","presence":"necessary","bindings":[],"declaredDefaults":[{"rule":"opaque-rule","explanation":"opaque","kind":"constant","value":null,"valueAvailability":"unrenderable","dependencies":[],"alternatives":null,"fallback":null}],"sourceDefault":null,"deploymentRequirement":null,"externalInput":{"verdict":"defaulted","reason":null,"coverage":"declaration","dependencies":[]}},{"key":"optional","description":"optional","sensitivity":"public","requirement":"optional","presence":"necessary","bindings":[],"declaredDefaults":[],"sourceDefault":null,"deploymentRequirement":null,"externalInput":{"verdict":"optional","reason":null,"coverage":null,"dependencies":[]}},{"key":"profiled","description":"profiled","sensitivity":"public","requirement":"optional","presence":"necessary","bindings":[],"declaredDefaults":[{"rule":"profile-rule","explanation":"profile","kind":"constant","value":"\"default\"","valueAvailability":"visible","dependencies":[],"alternatives":null,"fallback":null}],"sourceDefault":null,"deploymentRequirement":"state explicitly","externalInput":{"verdict":"required","reason":"deployment-profile","coverage":null,"dependencies":[]}},{"key":"required","description":"required","sensitivity":"public","requirement":"required","presence":"necessary","bindings":[{"channel":"environment","channelDetail":null,"name":"FIRST","annotations":{}},{"channel":"custom","channelDetail":"mounted","name":"SECOND","annotations":{}}],"declaredDefaults":[],"sourceDefault":null,"deploymentRequirement":null,"externalInput":{"verdict":"required","reason":"no-default","coverage":null,"dependencies":[]}},{"key":"requiredDefault","description":"requiredDefault","sensitivity":"public","requirement":"required","presence":"necessary","bindings":[],"declaredDefaults":[{"rule":"competing-default","explanation":"fallback on another request","kind":"constant","value":"\"fallback\"","valueAvailability":"visible","dependencies":[],"alternatives":null,"fallback":null}],"sourceDefault":null,"deploymentRequirement":null,"externalInput":{"verdict":"required","reason":"required-request","coverage":null,"dependencies":[]}},{"key":"requiredSecret","description":"secret","sensitivity":"secret","requirement":"required","presence":"necessary","bindings":[],"declaredDefaults":[],"sourceDefault":null,"deploymentRequirement":null,"externalInput":{"verdict":"required","reason":"no-default","coverage":null,"dependencies":[]}},{"key":"secret","description":"secret","sensitivity":"secret","requirement":"optional","presence":"necessary","bindings":[],"declaredDefaults":[{"rule":"secret-rule","explanation":"secret","kind":"constant","value":null,"valueAvailability":"redacted","dependencies":[],"alternatives":null,"fallback":null}],"sourceDefault":null,"deploymentRequirement":null,"externalInput":{"verdict":"defaulted","reason":null,"coverage":"declaration","dependencies":[]}},{"key":"secretSource","description":"secret source","sensitivity":"secret","requirement":"required","presence":"necessary","bindings":[],"declaredDefaults":[],"sourceDefault":{"origin":{"kind":"built-in","kindDetail":null,"name":"low","key":"secretSource","location":null,"annotations":{}},"shadowed":[],"value":"<redacted>","validity":"valid","expected":null},"deploymentRequirement":null,"externalInput":{"verdict":"defaulted","reason":null,"coverage":"source","dependencies":[]}},{"key":"source","description":"source","sensitivity":"public","requirement":"required","presence":"necessary","bindings":[],"declaredDefaults":[],"sourceDefault":{"origin":{"kind":"built-in","kindDetail":null,"name":"high","key":"source","location":null,"annotations":{}},"shadowed":[{"kind":"built-in","kindDetail":null,"name":"middle","key":"source","location":null,"annotations":{}},{"kind":"built-in","kindDetail":null,"name":"low","key":"source","location":null,"annotations":{}}],"value":"\"high\"","validity":"valid","expected":null},"deploymentRequirement":null,"externalInput":{"verdict":"defaulted","reason":null,"coverage":"source","dependencies":[]}}],"conditions":[{"dependencies":["derived"],"settings":["required"]},{"dependencies":["case"],"settings":["required"]},{"dependencies":["caseFallback"],"settings":["required"]},{"dependencies":["environment"],"settings":["conditional"]}],"diagnostics":[{"kind":"conflicting-sensitivity","key":"mixed"},{"kind":"default-structural-conflict","key":"blocked.child","blockedAt":"blocked","shape":"scalar","origin":{"kind":"built-in","kindDetail":null,"name":"low","key":"blocked","location":null,"annotations":{}}},{"kind":"undeclared-default-leaf","key":"blocked","origin":{"kind":"built-in","kindDetail":null,"name":"low","key":"blocked","location":null,"annotations":{}}},{"kind":"undeclared-default-leaf","key":"unknown","origin":{"kind":"built-in","kindDetail":null,"name":"low","key":"unknown","location":null,"annotations":{}}},{"kind":"undeclared-binding-key","key":"nothing.here","binding":{"channel":"environment","channelDetail":null,"name":"ORPHAN","annotations":{}}},{"kind":"undeclared-profile-key","key":"unknownProfile"}]}
+ test/golden/contract.txt view
@@ -0,0 +1,62 @@+blocked.child [required, necessary, public] blocked.child+ input: required (no default)+case [optional, necessary, public] case+ input: defaulted (declaration fallback)+ default: declaration rule case-rule, case on required, 1 alternatives, no fallback; value not computed+caseFallback [optional, necessary, public] caseFallback+ input: defaulted (declaration fallback)+ default: declaration rule fallback-rule, case on required, 1 alternatives, fallback; value not computed+conditional [required, conditional, public] conditional+ input: conditional (no default)+constant [optional, necessary, public] constant+ input: defaulted (declaration fallback)+ default: declaration rule constant-rule, constant 42+derived [optional, necessary, public] derived+ input: defaulted (declaration fallback)+ default: declaration rule derived-rule, derived from required; value not computed+environment [required, necessary, public] environment+ input: required (no default)+invalid [required, necessary, public] invalid+ input: required (invalid source default)+ default: "bad" from built-in source low (invalid; expected integer between -9223372036854775808 and 9223372036854775807)+mixed [optional, necessary, secret] mixed+ input: defaulted (declaration fallback)+ default: declaration rule mixed-rule, constant <redacted>+opaque [optional, necessary, public] opaque+ input: defaulted (declaration fallback)+ default: declaration rule opaque-rule, constant <unrenderable>+optional [optional, necessary, public] optional+ input: optional+profiled [optional, necessary, public] profiled+ input: required (deployment profile production: state explicitly)+ default: declaration rule profile-rule, constant "default"+required [required, necessary, public] required+ input: required (no default)+ bound: environment variable FIRST+ bound: mounted SECOND+requiredDefault [required, necessary, public] requiredDefault+ input: required (required request despite declaration default)+ default: declaration rule competing-default, constant "fallback"+requiredSecret [required, necessary, secret] secret+ input: required (no default)+secret [optional, necessary, secret] secret+ input: defaulted (declaration fallback)+ default: declaration rule secret-rule, constant <redacted>+secretSource [required, necessary, secret] secret source+ input: defaulted (built-in source)+ default: <redacted> from built-in source low+source [required, necessary, public] source+ input: defaulted (built-in source)+ default: "high" from built-in source high+ shadowed: built-in source middle+ shadowed: built-in source low+condition 1: derived -> required+condition 2: case -> required+condition 3: caseFallback -> required+condition 4: environment -> conditional+diagnostic: mixed: declared with both public and secret sensitivity; treated as secret+diagnostic: blocked.child: cannot traverse blocked through scalar in built-in source low+diagnostic: blocked: unknown key in built-in source low+diagnostic: unknown: unknown key in built-in source low+diagnostic: ORPHAN: binding targets undeclared key nothing.here+diagnostic: unknownProfile: deployment profile targets undeclared key
+ test/golden/invariant-errors.json view
@@ -0,0 +1,1 @@+{"schemaVersion":1,"type":"settei.errors","errors":[{"kind":"invariant","rule":"pool-capacity","keys":["workers.jobPoolSize","workers.concurrency"],"expectation":"pool covers concurrency","detail":null},{"kind":"invariant","rule":"visibility-timeout","keys":["workers.visibilityTimeoutSeconds","workers.concurrency"],"expectation":"timeout covers twice concurrency","detail":null},{"kind":"invariant","rule":"provider-account","keys":["email.accounts","email.credentials"],"expectation":"every account has a credential","detail":"account alpha"},{"kind":"invariant","rule":"provider-account","keys":["email.accounts","email.credentials"],"expectation":"every account has a credential","detail":"account beta"}]}
+ test/golden/invariant-errors.txt view
@@ -0,0 +1,4 @@+workers.jobPoolSize, workers.concurrency: invariant pool-capacity failed: pool covers concurrency+workers.visibilityTimeoutSeconds, workers.concurrency: invariant visibility-timeout failed: timeout covers twice concurrency+email.accounts, email.credentials: invariant provider-account failed: every account has a credential (account alpha)+email.accounts, email.credentials: invariant provider-account failed: every account has a credential (account beta)
+ test/golden/validation.json view
@@ -0,0 +1,1 @@+{"schemaVersion":1,"type":"settei.resolution","nodes":[{"key":"database.poolSize","sensitivity":"public","outcome":"resolved","value":"\"10\"","origin":{"kind":"environment","kindDetail":null,"name":"fixture","key":"database.poolSize","location":null,"annotations":{}},"shadowed":[],"derivation":null},{"key":"database.url","sensitivity":"secret","outcome":"resolved","value":"<redacted>","origin":{"kind":"environment","kindDetail":null,"name":"fixture","key":"database.url","location":null,"annotations":{}},"shadowed":[],"derivation":null},{"key":"email.accounts","sensitivity":"public","outcome":"resolved","value":"[\"alpha\", \"beta\"]","origin":{"kind":"environment","kindDetail":null,"name":"fixture","key":"email.accounts","location":null,"annotations":{}},"shadowed":[],"derivation":null},{"key":"email.credentials","sensitivity":"secret","outcome":"resolved","value":"<redacted>","origin":{"kind":"environment","kindDetail":null,"name":"fixture","key":"email.credentials","location":null,"annotations":{}},"shadowed":[],"derivation":null},{"key":"runtime.environment","sensitivity":"public","outcome":"resolved","value":"\"production\"","origin":{"kind":"environment","kindDetail":null,"name":"fixture","key":"runtime.environment","location":null,"annotations":{}},"shadowed":[],"derivation":null},{"key":"workers.concurrency","sensitivity":"public","outcome":"resolved","value":"\"4\"","origin":{"kind":"environment","kindDetail":null,"name":"fixture","key":"workers.concurrency","location":null,"annotations":{}},"shadowed":[],"derivation":null},{"key":"workers.jobPoolSize","sensitivity":"public","outcome":"resolved","value":"\"2\"","origin":{"kind":"environment","kindDetail":null,"name":"fixture","key":"workers.jobPoolSize","location":null,"annotations":{}},"shadowed":[],"derivation":null},{"key":"workers.replica.count","sensitivity":"public","outcome":"resolved","value":"\"2\"","origin":{"kind":"environment","kindDetail":null,"name":"fixture","key":"workers.replica.count","location":null,"annotations":{}},"shadowed":[],"derivation":null},{"key":"workers.replica.index","sensitivity":"public","outcome":"resolved","value":"\"0\"","origin":{"kind":"environment","kindDetail":null,"name":"fixture","key":"workers.replica.index","location":null,"annotations":{}},"shadowed":[],"derivation":null},{"key":"workers.visibilityTimeoutSeconds","sensitivity":"public","outcome":"resolved","value":"\"1\"","origin":{"kind":"environment","kindDetail":null,"name":"fixture","key":"workers.visibilityTimeoutSeconds","location":null,"annotations":{}},"shadowed":[],"derivation":null}],"branches":[],"invariants":[{"rule":"pool-capacity","keys":["workers.jobPoolSize","workers.concurrency"],"expectation":"pool covers concurrency","prerequisites":[],"status":"failed","violations":1,"blockedBy":[]},{"rule":"visibility-timeout","keys":["workers.visibilityTimeoutSeconds","workers.concurrency"],"expectation":"timeout covers twice concurrency","prerequisites":[],"status":"failed","violations":1,"blockedBy":[]},{"rule":"replica","keys":["workers.replica.index","workers.replica.count"],"expectation":"index is within replica count","prerequisites":[],"status":"passed","violations":0,"blockedBy":[]},{"rule":"replica-pool-share","keys":["workers.jobPoolSize","workers.replica.count"],"expectation":"pool covers replicas","prerequisites":["replica"],"status":"passed","violations":0,"blockedBy":[]},{"rule":"provider-account","keys":["email.accounts","email.credentials"],"expectation":"every account has a credential","prerequisites":[],"status":"failed","violations":2,"blockedBy":[]}]}
+ test/golden/validation.txt view
@@ -0,0 +1,11 @@+invariant pool-capacity [failed (1 violation)]: workers.jobPoolSize, workers.concurrency+ expects pool covers concurrency+invariant visibility-timeout [failed (1 violation)]: workers.visibilityTimeoutSeconds, workers.concurrency+ expects timeout covers twice concurrency+invariant replica [passed]: workers.replica.index, workers.replica.count+ expects index is within replica count+invariant replica-pool-share [passed]: workers.jobPoolSize, workers.replica.count+ expects pool covers replicas+ after replica+invariant provider-account [failed (2 violations)]: email.accounts, email.credentials+ expects every account has a credential