packages feed

settei-env 0.2.0.0 → 0.3.0.0

raw patch · 4 files changed

+399/−39 lines, 4 filesdep ~setteidep ~settei-envPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: settei, settei-env

API changes (from Hackage documentation)

+ Settei.Env: BoundTo :: !Key -> NameAcceptance
+ Settei.Env: ConsumedBy :: !Text -> NameAcceptance
+ Settei.Env: DuplicateSuppliedName :: !EnvName -> SuppliedNameError
+ Settei.Env: UnsupportedSuppliedName :: !EnvName -> SuppliedNameError
+ Settei.Env: acceptedBindings :: AcceptedNames -> Bindings
+ Settei.Env: acceptedNames :: Bindings -> [Allowance] -> Either (NonEmpty EnvError) AcceptedNames
+ Settei.Env: acceptedNamesList :: AcceptedNames -> [(EnvName, NameAcceptance)]
+ Settei.Env: allowance :: Text -> EnvName -> Allowance
+ Settei.Env: allowanceConsumer :: Allowance -> Text
+ Settei.Env: allowanceName :: Allowance -> EnvName
+ Settei.Env: checkSuppliedNames :: AcceptedNames -> [EnvName] -> Either (NonEmpty SuppliedNameError) ()
+ Settei.Env: checkedEnvSource :: Text -> AcceptedNames -> EnvSnapshot -> Either (NonEmpty SuppliedNameError) Source
+ Settei.Env: checkedEnvironmentSource :: AcceptedNames -> EnvSnapshot -> Either (NonEmpty SuppliedNameError) Source
+ Settei.Env: data AcceptedNames
+ Settei.Env: data Allowance
+ Settei.Env: data NameAcceptance
+ Settei.Env: data SuppliedNameError
+ Settei.Env: inputBindings :: Bindings -> [InputBinding]
+ Settei.Env: instance GHC.Classes.Eq Settei.Env.AcceptedNames
+ Settei.Env: instance GHC.Classes.Eq Settei.Env.Allowance
+ Settei.Env: instance GHC.Classes.Eq Settei.Env.NameAcceptance
+ Settei.Env: instance GHC.Classes.Eq Settei.Env.SuppliedNameError
+ Settei.Env: instance GHC.Internal.Generics.Generic Settei.Env.NameAcceptance
+ Settei.Env: instance GHC.Internal.Generics.Generic Settei.Env.SuppliedNameError
+ Settei.Env: instance GHC.Internal.Show.Show Settei.Env.NameAcceptance
+ Settei.Env: instance GHC.Internal.Show.Show Settei.Env.SuppliedNameError
+ Settei.Env: renderSuppliedNameErrorText :: SuppliedNameError -> Text
+ Settei.Env: renderSuppliedNameErrorsJson :: NonEmpty SuppliedNameError -> Text
+ Settei.Env: renderSuppliedNameErrorsText :: NonEmpty SuppliedNameError -> Text
+ Settei.Env: snapshotNames :: EnvSnapshot -> [EnvName]

Files

CHANGELOG.md view
@@ -1,5 +1,21 @@ # Changelog for settei-env +## 0.3.0.0 — 2026-10-21++### New Features++- Add supplied-name validation against bindings and external-consumer allowances+  (`acceptedNames`, `allowance`, `checkSuppliedNames`, `snapshotNames`), opt-in checked+  snapshot source builders (`checkedEnvSource`, `checkedEnvironmentSource`), and safe+  text and version-1 `settei.supplied-names` JSON diagnostics. Existing source builders+  remain permissive.+- Add `inputBindings` to export validated binding metadata without reading environment values.++### Other Changes++- Released in the shared 0.3.0.0 PVP major family release; the `settei` pin moves to+  `==0.3.0.0`. This package's own API changes are additive.+ ## 0.2.0.0 — 2026-07-19  - BREAKING: environment bindings are validated once at construction. `Bindings` is an
settei-env.cabal view
@@ -1,59 +1,61 @@-cabal-version:   3.8-name:            settei-env-version:         0.2.0.0-synopsis:        Environment sources for Settei+cabal-version: 3.8+name: settei-env+version: 0.3.0.0+synopsis: Environment sources for Settei description:   Translate explicit environment-variable bindings into provenance-aware   Settei sources without decoding application values. -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+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  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.Env   build-depends:-    , base          >=4.21    && <5-    , containers    >=0.6.8   && <0.8-    , generic-lens  >=2.2     && <2.4-    , settei        ==0.2.0.0-    , text          >=2.1     && <2.2+    base >=4.21 && <5,+    containers >=0.6.8 && <0.8,+    generic-lens >=2.2 && <2.4,+    settei ==0.3.0.0,+    text >=2.1 && <2.2,  test-suite settei-env-tests-  import:         common-  type:           exitcode-stdio-1.0+  import: common+  type: exitcode-stdio-1.0   hs-source-dirs: test-  main-is:        Main.hs-  other-modules:  Settei.EnvTest+  main-is: Main.hs+  other-modules: Settei.EnvTest   build-depends:-    , base          >=4.21    && <5-    , containers    >=0.6.8   && <0.8-    , generic-lens  >=2.2     && <2.4-    , settei        ==0.2.0.0-    , settei-env    ==0.2.0.0-    , 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,+    settei ==0.3.0.0,+    settei-env ==0.3.0.0,+    tasty >=1.5 && <1.6,+    tasty-hunit >=0.10.2 && <0.11,+    text >=2.1 && <2.2,
src/Settei/Env.hs view
@@ -1,12 +1,22 @@ -- | -- Module: Settei.Env--- Description: Explicit, pure environment-variable sources for Settei.+-- Description: Explicit, pure environment sources and supplied-name validation. module Settei.Env-  ( Bindings,+  ( AcceptedNames,+    Allowance,+    Bindings,     EnvName (..),     EnvSnapshot (..),     EnvBinding,     EnvError (..),+    NameAcceptance (..),+    SuppliedNameError (..),+    acceptedBindings,+    acceptedNames,+    acceptedNamesList,+    allowance,+    allowanceConsumer,+    allowanceName,     annotateBinding,     binding,     bindingAnnotations,@@ -14,24 +24,34 @@     bindingName,     bindings,     bindingsList,+    checkSuppliedNames,+    checkedEnvSource,+    checkedEnvironmentSource,     envSnapshot,     envSource,     environmentSource,     fromKubernetesObject,+    inputBindings,     mergeBindings,     prefixedBindings,     readEnvSource,     readEnvironmentSource,     renderEnvErrorText,     renderEnvErrorsText,+    renderSuppliedNameErrorText,+    renderSuppliedNameErrorsJson,+    renderSuppliedNameErrorsText,+    snapshotNames,   ) where -import Data.Char (isAsciiLower, isAsciiUpper, isDigit)+import Data.Char (isAsciiLower, isAsciiUpper, isDigit, ord) import Data.Generics.Labels () 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 Numeric (showHex) import Settei import Settei.Prelude import System.Environment qualified as Environment@@ -71,6 +91,146 @@ newtype Bindings = Bindings [EnvBinding]   deriving stock (Eq) +-- | One variable consumed outside Settei, with a trusted consumer label.+-- Validated together with bindings by 'acceptedNames'.+data Allowance = Allowance !Text !EnvName+  deriving stock (Eq)++-- | Declare a consumer label and its variable name; no value is retained.+allowance :: Text -> EnvName -> Allowance+allowance = Allowance++-- | Inspect the trusted external-consumer label.+allowanceConsumer :: Allowance -> Text+allowanceConsumer (Allowance consumer _) = consumer++-- | Inspect the variable consumed outside Settei.+allowanceName :: Allowance -> EnvName+allowanceName (Allowance _ name) = name++-- | How a declared name is accepted.+data NameAcceptance = BoundTo !Key | ConsumedBy !Text+  deriving stock (Generic, Eq, Show)++-- | Bindings and external-consumer allowances validated together.+-- The private constructor and absence of Generic preserve the invariant.+data AcceptedNames = AcceptedNames !Bindings ![Allowance]+  deriving stock (Eq)++-- | Validate static allowances, rejecting invalid or repeated names (including+-- names already bound). Invalid names precede ascending duplicate-name errors.+acceptedNames :: Bindings -> [Allowance] -> Either (NonEmpty EnvError) AcceptedNames+acceptedNames validated allowances =+  case NonEmpty.nonEmpty errors of+    Just problems -> Left problems+    Nothing -> Right (AcceptedNames validated allowances)+  where+    names = fmap allowanceName allowances+    errors =+      [InvalidEnvironmentName name | name <- names, not (validEnvName name)]+        <> fmap DuplicateEnvironmentName (duplicates (fmap bindingName (bindingsList validated) <> names))++-- | Recover the original validated bindings for ordinary source translation.+acceptedBindings :: AcceptedNames -> Bindings+acceptedBindings (AcceptedNames validated _) = validated++-- | Bound names in binding order followed by allowances in declaration order.+acceptedNamesList :: AcceptedNames -> [(EnvName, NameAcceptance)]+acceptedNamesList (AcceptedNames validated allowances) =+  [(bindingName value, BoundTo (bindingKey value)) | value <- bindingsList validated]+    <> [(allowanceName value, ConsumedBy (allowanceConsumer value)) | value <- allowances]++-- | Runtime supplied-name failures retain original names only, never values.+data SuppliedNameError+  = UnsupportedSuppliedName !EnvName+  | DuplicateSuppliedName !EnvName+  deriving stock (Generic, Eq, Show)++-- | Check exactly the supplied collection. Absence is never an error.+-- Unsupported names are reported at their first occurrence; duplicates once at+-- their second occurrence. Diagnostic order follows encounter order.+checkSuppliedNames :: AcceptedNames -> [EnvName] -> Either (NonEmpty SuppliedNameError) ()+checkSuppliedNames accepted supplied =+  case NonEmpty.nonEmpty (go Set.empty Set.empty supplied) of+    Just problems -> Left problems+    Nothing -> Right ()+  where+    allowed = Set.fromList (fmap fst (acceptedNamesList accepted))+    go _ _ [] = []+    go seen reportedDuplicates (name : rest)+      | Set.member name reportedDuplicates = go seen reportedDuplicates rest+      | Set.member name seen = DuplicateSuppliedName name : go seen (Set.insert name reportedDuplicates) rest+      | otherwise =+          [UnsupportedSuppliedName name | Set.notMember name allowed]+            <> go (Set.insert name seen) reportedDuplicates rest++-- | Render a single safe physical line. Portable names are verbatim; other names+-- are quoted and escaped without changing the retained name or comparison.+renderSuppliedNameErrorText :: SuppliedNameError -> Text+renderSuppliedNameErrorText = \case+  UnsupportedSuppliedName name ->+    "supplied environment variable " <> displaySuppliedName name <> ": no binding or allowance accepts it"+  DuplicateSuppliedName name ->+    "supplied environment variable " <> displaySuppliedName name <> ": supplied more than once"++-- | One sentence and terminating newline per problem.+renderSuppliedNameErrorsText :: NonEmpty SuppliedNameError -> Text+renderSuppliedNameErrorsText = Text.unlines . fmap renderSuppliedNameErrorText . NonEmpty.toList++-- | One compact @settei.supplied-names@ schema-version-1 document, without a+-- trailing newline. JSON encodes the original names, independently of text display.+renderSuppliedNameErrorsJson :: NonEmpty SuppliedNameError -> Text+renderSuppliedNameErrorsJson errors =+  jsonObject+    [ ("schemaVersion", "1"),+      ("type", jsonString "settei.supplied-names"),+      ("errors", jsonArray (fmap renderError (NonEmpty.toList errors)))+    ]+  where+    renderError problem =+      let (kind, name) = case problem of+            UnsupportedSuppliedName value -> ("unsupported-supplied-name", value)+            DuplicateSuppliedName value -> ("duplicate-supplied-name", value)+       in jsonObject [("kind", jsonString kind), ("name", jsonString (renderEnvName name))]++displaySuppliedName :: EnvName -> Text+displaySuppliedName name+  | validEnvName name = renderEnvName name+  | otherwise = "\"" <> Text.concatMap escapeDisplayChar (renderEnvName name) <> "\""+  where+    escapeDisplayChar character+      | (character >= '\x7f' && character <= '\x9f') || character == '\x2028' || character == '\x2029' =+          "\\u" <> paddedHex (ord character)+      | otherwise = escapeJsonChar character++jsonObject :: [(Text, Text)] -> Text+jsonObject fields =+  "{" <> Text.intercalate "," [jsonString key <> ":" <> value | (key, value) <- fields] <> "}"++jsonArray :: [Text] -> Text+jsonArray values = "[" <> Text.intercalate "," values <> "]"++jsonString :: Text -> Text+jsonString value = "\"" <> Text.concatMap escapeJsonChar value <> "\""++escapeJsonChar :: Char -> Text+escapeJsonChar = \case+  '"' -> "\\\""+  '\\' -> "\\\\"+  '\b' -> "\\b"+  '\f' -> "\\f"+  '\n' -> "\\n"+  '\r' -> "\\r"+  '\t' -> "\\t"+  character+    | ord character < 0x20 -> "\\u" <> paddedHex (ord character)+    | otherwise -> Text.singleton character++paddedHex :: Int -> Text+paddedHex value =+  let rendered = Text.pack (showHex value "")+   in Text.replicate (4 - Text.length rendered) "0" <> rendered+ -- | Construct one explicit binding with no caller annotations. binding :: EnvName -> Key -> EnvBinding binding name key = EnvBinding {name, key, annotations = Map.empty}@@ -148,6 +308,22 @@   EnvSnapshot     (Map.fromList [(EnvName name, value) | (name, value) <- values]) +-- | Snapshot keys in ascending order. A map has already collapsed duplicate+-- entries; check ordered deployment entries as a list before making a snapshot.+snapshotNames :: EnvSnapshot -> [EnvName]+snapshotNames (EnvSnapshot snapshot) = Map.keys snapshot++-- | Opt in to checking every name in an injected snapshot, then translate using+-- the ordinary source builder. This never reads the process environment itself.+checkedEnvSource :: Text -> AcceptedNames -> EnvSnapshot -> Either (NonEmpty SuppliedNameError) Source+checkedEnvSource label accepted snapshot = do+  checkSuppliedNames accepted (snapshotNames snapshot)+  pure (envSource label (acceptedBindings accepted) snapshot)++-- | 'checkedEnvSource' with the conventional @"environment"@ label.+checkedEnvironmentSource :: AcceptedNames -> EnvSnapshot -> Either (NonEmpty SuppliedNameError) Source+checkedEnvironmentSource = checkedEnvSource "environment"+ -- | Translate explicitly bound variables from one snapshot into a Settei source. -- -- Total: a 'Bindings' value is valid by construction, so no error branch exists.@@ -313,3 +489,14 @@     -- fold runs, no path can descend through a previously written leaf. This branch is     -- unreachable by construction and exists only to satisfy exhaustiveness honestly.     go _ _ = error "validated environment keys cannot overlap"++-- | Inspect validated bindings without reading any environment values.+-- Adapter-owned variable identity wins over caller annotations, as in envSource.+inputBindings :: Bindings -> [InputBinding]+inputBindings = fmap convert . bindingsList+  where+    convert bindingValue =+      let variable = renderEnvName (bindingName bindingValue)+       in annotateInputBinding+            (Map.singleton "environment.variable" variable <> bindingAnnotations bindingValue)+            (inputBinding EnvironmentVariable variable (bindingKey bindingValue))
test/Settei/EnvTest.hs view
@@ -4,6 +4,7 @@ import Data.Generics.Labels () import Data.List qualified as List import Data.List.NonEmpty qualified as NonEmpty+import Data.Map.Strict qualified as Map import Data.Text qualified as Text import Settei import Settei.Env@@ -15,8 +16,23 @@ tests =   testGroup     "Settei.Env"-    [ errorRenderingTests,+    [ testCase "contract bindings preserve order and trusted annotations without values" $ do+        let reference = kubernetesRef SecretObject (Just "payments") "database" (Just "password")+            first = annotateBinding (mempty & at "environment.variable" ?~ "spoofed") (binding (EnvName "MODE") runtimeEnvironment)+            second = fromKubernetesObject reference (binding (EnvName "PASSWORD") databasePassword)+        validated <- either (fail . show) pure (bindings [first, second])+        let converted = inputBindings validated+        fmap inputBindingName converted @?= ["MODE", "PASSWORD"]+        fmap inputBindingKey converted @?= [runtimeEnvironment, databasePassword]+        fmap inputBindingChannel converted @?= [EnvironmentVariable, EnvironmentVariable]+        case converted of+          [firstConverted, secondConverted] -> do+            inputBindingAnnotations firstConverted ^. at "environment.variable" @?= Just "MODE"+            inputBindingAnnotations secondConverted ^. at "kubernetes.object-name" @?= Just "database"+          _ -> fail "expected two bindings",+      errorRenderingTests,       bindingMergingTests,+      suppliedNameTests,       testCase "explicit binding records variable origin" $ do         input <- expectSource [binding (EnvName "HASKELL_ENV") runtimeEnvironment] [("HASKELL_ENV", "Production")]         case lookupSource runtimeEnvironment input of@@ -102,6 +118,145 @@         let output = renderResolutionText (result ^. #report)         assertBool "ConfigMap metadata was omitted" ("service-network" `Text.isInfixOf` output)         assertBool "public value was omitted" ("api.internal" `Text.isInfixOf` output)+    ]++suppliedNameTests :: TestTree+suppliedNameTests =+  testGroup+    "supplied name validation"+    [ testCase "accepts bound and allowed names and preserves declarations" $ do+        validated <-+          expectBindings+            [ binding (EnvName "ENVIRONMENT") runtimeEnvironment,+              binding (EnvName "DATABASE_URL") databasePassword,+              binding (EnvName "PORT") optionalValue+            ]+        let external = allowance "opentelemetry-sdk" (EnvName "OTEL_EXPORTER_OTLP_ENDPOINT")+        accepted <- either (fail . show) pure (acceptedNames validated [external])+        assertBool "bindings changed" (acceptedBindings accepted == validated)+        allowanceConsumer external @?= "opentelemetry-sdk"+        allowanceName external @?= EnvName "OTEL_EXPORTER_OTLP_ENDPOINT"+        acceptedNamesList accepted+          @?= [ (EnvName "ENVIRONMENT", BoundTo runtimeEnvironment),+                (EnvName "DATABASE_URL", BoundTo databasePassword),+                (EnvName "PORT", BoundTo optionalValue),+                (EnvName "OTEL_EXPORTER_OTLP_ENDPOINT", ConsumedBy "opentelemetry-sdk")+              ]+        checkSuppliedNames accepted (fmap EnvName ["ENVIRONMENT", "DATABASE_URL", "OTEL_EXPORTER_OTLP_ENDPOINT"]) @?= Right (),+      testCase "reports every unsupported name in supplied order deterministically" $ do+        accepted <- expectAccepted [binding (EnvName "ENVIRONMENT") runtimeEnvironment, binding (EnvName "DATABASE_URL") databasePassword] []+        let supplied = fmap EnvName ["HASKELL_ENV", "DATABASE_URL", "DB_URL"]+            result = checkSuppliedNames accepted supplied+        result @?= Left (UnsupportedSuppliedName (EnvName "HASKELL_ENV") :| [UnsupportedSuppliedName (EnvName "DB_URL")])+        checkSuppliedNames accepted supplied @?= result,+      testCase "empty collection accepts absent bindings" $ do+        accepted <- expectAccepted [binding (EnvName "ENVIRONMENT") runtimeEnvironment] []+        checkSuppliedNames accepted [] @?= Right (),+      testCase "reports duplicates once at their second encounter" $ do+        accepted <- expectAccepted [binding (EnvName "PORT") optionalValue] []+        checkSuppliedNames accepted (fmap EnvName ["PORT", "PORT", "PORT", "HOST", "HOST", "HOST"])+          @?= Left (DuplicateSuppliedName (EnvName "PORT") :| [UnsupportedSuppliedName (EnvName "HOST"), DuplicateSuppliedName (EnvName "HOST")]),+      testCase "allowance scope excludes unrelated inherited variables" $ do+        accepted <-+          expectAccepted+            [binding (EnvName "ENVIRONMENT") runtimeEnvironment]+            [allowance "opentelemetry-sdk" (EnvName "OTEL_EXPORTER_OTLP_ENDPOINT")]+        let snapshot = envSnapshot [("PATH", "bin"), ("HOME", "home"), ("KUBERNETES_SERVICE_HOST", "host"), ("ENVIRONMENT", "production")]+        checkSuppliedNames accepted (fmap EnvName ["ENVIRONMENT", "OTEL_EXPORTER_OTLP_ENDPOINT", "HASKELL_ENV"])+          @?= Left (UnsupportedSuppliedName (EnvName "HASKELL_ENV") :| [])+        snapshotNames snapshot @?= fmap EnvName ["ENVIRONMENT", "HOME", "KUBERNETES_SERVICE_HOST", "PATH"]+        assertBool "snapshot-wide check should be an explicit stricter choice" (isLeft (checkedEnvironmentSource accepted snapshot)),+      testCase "snapshot names are sorted and duplicates are already collapsed" $+        snapshotNames (envSnapshot [("Z", "first"), ("A", "a"), ("Z", "last")]) @?= fmap EnvName ["A", "Z"],+      testCase "validates allowance names and collisions together" $ do+        validated <- expectBindings [binding (EnvName "PORT") optionalValue]+        let declarations = fmap (allowance "external" . EnvName) ["1BAD", "PORT", "Z", "Z", "A", "A", "1BAD"]+        case acceptedNames validated declarations of+          Left errors ->+            NonEmpty.toList errors+              @?= [ InvalidEnvironmentName (EnvName "1BAD"),+                    InvalidEnvironmentName (EnvName "1BAD"),+                    DuplicateEnvironmentName (EnvName "1BAD"),+                    DuplicateEnvironmentName (EnvName "A"),+                    DuplicateEnvironmentName (EnvName "PORT"),+                    DuplicateEnvironmentName (EnvName "Z")+                  ]+          Right _ -> fail "invalid allowances accepted",+      testCase "strict path rejects HASKELL_ENV when ENVIRONMENT is bound" $ do+        accepted <- expectAccepted [binding (EnvName "ENVIRONMENT") runtimeEnvironment] []+        let declaration = required (publicSetting runtimeEnvironment "Runtime environment" (enumDecoder [("development", False), ("production", True)]))+            builtIn = source "built-in defaults" BuiltInSource (RawObject (Map.singleton "runtime" (RawObject (Map.singleton "environment" (RawText "development")))))+            typo = envSnapshot [("HASKELL_ENV", "production")]+            corrected = envSnapshot [("ENVIRONMENT", "production")]+            permissive = environmentSource (acceptedBindings accepted) corrected+        expectResolution (resolve defaultResolveOptions [builtIn, environmentSource (acceptedBindings accepted) typo] declaration) >>= (@?= False)+        case checkedEnvironmentSource accepted typo of+          Left errors -> errors @?= UnsupportedSuppliedName (EnvName "HASKELL_ENV") :| []+          Right _ -> fail "typo hidden by default"+        strictSource <- either (fail . show) pure (checkedEnvironmentSource accepted corrected)+        expectResolution (resolve defaultResolveOptions [builtIn, strictSource] declaration) >>= (@?= True)+        case (lookupSource runtimeEnvironment strictSource, lookupSource runtimeEnvironment permissive) of+          (Right (Just actual), Right (Just expected)) -> do+            candidateOrigin actual @?= candidateOrigin expected+            candidateOrigin actual ^. #annotations . at "environment.variable" @?= Just "ENVIRONMENT"+          _ -> fail "expected strict and permissive candidates"+        labeled <- either (fail . show) pure (checkedEnvSource "deployment" accepted corrected)+        case lookupSource runtimeEnvironment labeled of+          Right (Just found) -> candidateOrigin found ^. #name @?= "deployment"+          _ -> fail "expected custom source label",+      testCase "sentinels never reach supplied-name diagnostics" $ do+        accepted <- expectAccepted [binding (EnvName "ENVIRONMENT") runtimeEnvironment] []+        let unknownSentinel = "unknown-value-sentinel"+        case checkedEnvironmentSource accepted (envSnapshot [("ENVIRONMENT", secretSentinel), ("HASKELL_ENV", unknownSentinel)]) of+          Left errors -> do+            let outputs = [Text.pack (show errors), renderSuppliedNameErrorsText errors, renderSuppliedNameErrorsJson errors]+            sequence_ [assertBool "value leaked" (not (sentinel `Text.isInfixOf` output)) | output <- outputs, sentinel <- [secretSentinel, unknownSentinel]]+          Right _ -> fail "expected strict failure",+      testCase "successful strict source still redacts secrets" $ do+        accepted <- expectAccepted [binding (EnvName "DATABASE_PASSWORD") databasePassword] []+        input <- either (fail . show) pure (checkedEnvironmentSource accepted (envSnapshot [("DATABASE_PASSWORD", secretSentinel)]))+        let result = resolve defaultResolveOptions [input] (required passwordSetting)+        _ <- expectResolution result+        assertBool "secret leaked from strict source" (not (secretSentinel `Text.isInfixOf` renderResolutionText (result ^. #report))),+      suppliedNameRenderingTests+    ]++expectAccepted :: [EnvBinding] -> [Allowance] -> IO AcceptedNames+expectAccepted values allowances = do+  validated <- expectBindings values+  either (fail . show) pure (acceptedNames validated allowances)++suppliedNameRenderingTests :: TestTree+suppliedNameRenderingTests =+  testGroup+    "rendering"+    [ testCase "portable text and exact versioned JSON are stable" $ do+        let errors = UnsupportedSuppliedName (EnvName "HASKELL_ENV") :| [DuplicateSuppliedName (EnvName "PORT")]+            expected = "{\"schemaVersion\":1,\"type\":\"settei.supplied-names\",\"errors\":[{\"kind\":\"unsupported-supplied-name\",\"name\":\"HASKELL_ENV\"},{\"kind\":\"duplicate-supplied-name\",\"name\":\"PORT\"}]}"+        renderSuppliedNameErrorsText errors @?= "supplied environment variable HASKELL_ENV: no binding or allowance accepts it\nsupplied environment variable PORT: supplied more than once\n"+        renderSuppliedNameErrorsJson errors @?= expected+        renderSuppliedNameErrorsJson errors @?= renderSuppliedNameErrorsJson errors,+      testCase "hostile names retain spelling but escape text and JSON independently" $ do+        accepted <- expectAccepted [] []+        let name = EnvName "BAD\"\\\n\SOHNAME"+            problem = UnsupportedSuppliedName name+            duplicate = DuplicateSuppliedName name+        checkSuppliedNames accepted [name] @?= Left (problem :| [])+        renderSuppliedNameErrorText problem @?= "supplied environment variable \"BAD\\\"\\\\\\n\\u0001NAME\": no binding or allowance accepts it"+        renderSuppliedNameErrorText duplicate @?= "supplied environment variable \"BAD\\\"\\\\\\n\\u0001NAME\": supplied more than once"+        renderSuppliedNameErrorsText (problem :| [duplicate]) @?= Text.unlines [renderSuppliedNameErrorText problem, renderSuppliedNameErrorText duplicate]+        renderSuppliedNameErrorsJson (problem :| []) @?= "{\"schemaVersion\":1,\"type\":\"settei.supplied-names\",\"errors\":[{\"kind\":\"unsupported-supplied-name\",\"name\":\"BAD\\\"\\\\\\n\\u0001NAME\"}]}",+      testGroup+        "nonportable display names"+        [ testCase (show original) $ do+            let errors = UnsupportedSuppliedName (EnvName original) :| [DuplicateSuppliedName (EnvName original)]+                sentences = ["supplied environment variable " <> escaped <> ": " <> suffix | suffix <- ["no binding or allowance accepts it", "supplied more than once"]]+            fmap renderSuppliedNameErrorText (NonEmpty.toList errors) @?= sentences+            renderSuppliedNameErrorsText errors @?= Text.unlines sentences+            length (Text.lines (renderSuppliedNameErrorsText errors)) @?= 2+        | (original, escaped) <-+            [("", "\"\""), ("with space", "\"with space\""), ("\r", "\"\\r\""), ("\t", "\"\\t\""), ("\ESC", "\"\\u001b\""), ("\DEL", "\"\\u007f\""), ("\x85", "\"\\u0085\""), ("\x2028", "\"\\u2028\""), ("\x2029", "\"\\u2029\"")]+        ]     ]  bindingMergingTests :: TestTree