diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/settei-env.cabal b/settei-env.cabal --- a/settei-env.cabal +++ b/settei-env.cabal @@ -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, diff --git a/src/Settei/Env.hs b/src/Settei/Env.hs --- a/src/Settei/Env.hs +++ b/src/Settei/Env.hs @@ -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)) diff --git a/test/Settei/EnvTest.hs b/test/Settei/EnvTest.hs --- a/test/Settei/EnvTest.hs +++ b/test/Settei/EnvTest.hs @@ -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