settei-env 0.1.0.0 → 0.2.0.0

raw patch · 4 files changed

+230/−51 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)

Files

• CHANGELOG.md +12/−0
• settei-env.cabal +4/−4
• src/Settei/Env.hs +101/−33
• test/Settei/EnvTest.hs +113/−14

@@ -1,5 +1,17 @@ # Changelog for settei-env +## 0.2.0.0 — 2026-07-19++- BREAKING: environment bindings are validated once at construction. `Bindings` is an+  opaque validated collection built by `bindings` or `prefixedBindings`; `envSource`+  and `readEnvSource` take `Bindings` and are total; `environmentSource` and+  `readEnvironmentSource` provide the conventional `"environment"` label;+  `bindingsList` inspects a validated collection.+- Add `renderEnvErrorText` and `renderEnvErrorsText` for stable, operator-readable,+  value-free binding diagnostics.+- Add `mergeBindings`: combine validated `Bindings` collections with re-validation of+  cross-collection conflicts, enabling derived and hand-written bindings to compose.+ ## 0.1.0.0 — 2026-07-18  - Initial experimental release.

@@ -1,6 +1,6 @@ cabal-version:   3.8 name:            settei-env-version:         0.1.0.0+version:         0.2.0.0 synopsis:        Environment sources for Settei description:   Translate explicit environment-variable bindings into provenance-aware@@ -39,7 +39,7 @@     , base          >=4.21    && <5     , containers    >=0.6.8   && <0.8     , generic-lens  >=2.2     && <2.4-    , settei        ==0.1.0.0+    , settei        ==0.2.0.0     , text          >=2.1     && <2.2  test-suite settei-env-tests@@ -52,8 +52,8 @@     , base          >=4.21    && <5     , containers    >=0.6.8   && <0.8     , generic-lens  >=2.2     && <2.4-    , settei        ==0.1.0.0-    , settei-env    ==0.1.0.0+    , 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

@@ -2,7 +2,8 @@ -- Module: Settei.Env -- Description: Explicit, pure environment-variable sources for Settei. module Settei.Env-  ( EnvName (..),+  ( Bindings,+    EnvName (..),     EnvSnapshot (..),     EnvBinding,     EnvError (..),@@ -11,11 +12,18 @@     bindingAnnotations,     bindingKey,     bindingName,+    bindings,+    bindingsList,     envSnapshot,     envSource,+    environmentSource,     fromKubernetesObject,+    mergeBindings,     prefixedBindings,     readEnvSource,+    readEnvironmentSource,+    renderEnvErrorText,+    renderEnvErrorsText,   ) where @@ -28,7 +36,7 @@ import Settei.Prelude import System.Environment qualified as Environment --- | An environment-variable name. 'envSource' validates its portable spelling.+-- | An environment-variable name. 'bindings' validates its portable spelling. newtype EnvName = EnvName Text   deriving stock (Generic, Eq, Ord, Show) @@ -53,6 +61,16 @@   | PrefixedNameCollision !EnvName !(NonEmpty Key)   deriving stock (Generic, Eq, Show) +-- | A collection of bindings proven valid at construction.+--+-- The constructor is private: 'bindings' and 'prefixedBindings' are the only ways to+-- obtain a value, so every 'Bindings' is free of invalid names, duplicate names,+-- duplicate target keys, and prefix-overlapping target keys. Binding lists are static+-- program data; resolve 'bindings' once at startup (or force it in a unit test) so an+-- invalid list is a fail-fast programming-error report, not a runtime branch.+newtype Bindings = Bindings [EnvBinding]+  deriving stock (Eq)+ -- | Construct one explicit binding with no caller annotations. binding :: EnvName -> Key -> EnvBinding binding name key = EnvBinding {name, key, annotations = Map.empty}@@ -76,6 +94,52 @@ bindingAnnotations :: EnvBinding -> Map Text Text bindingAnnotations value = value ^. #annotations +-- | Validate a static binding list once, yielding a collection usable with the total+-- source builders.+bindings :: [EnvBinding] -> Either (NonEmpty EnvError) Bindings+bindings values =+  case NonEmpty.nonEmpty (bindingErrors values) of+    Just errors -> Left errors+    Nothing -> Right (Bindings values)++-- | Inspect the validated bindings, for example to count or display them.+bindingsList :: Bindings -> [EnvBinding]+bindingsList (Bindings values) = values++-- | Merge validated collections into one, re-validating cross-collection conflicts.+--+-- Two individually valid collections can still collide with each other (a variable+-- name bound in both, or target keys that overlap across them), so merging returns+-- the same 'EnvError' vocabulary as 'bindings'. The empty list yields the valid empty+-- collection. Order is preserved: earlier collections contribute earlier bindings.+mergeBindings :: [Bindings] -> Either (NonEmpty EnvError) Bindings+mergeBindings = bindings . concatMap bindingsList++-- | Render one binding-validation failure as a single operator-readable sentence.+--+-- Only variable names and structural keys appear; environment values are never+-- retained by 'EnvError' and therefore cannot leak.+renderEnvErrorText :: EnvError -> Text+renderEnvErrorText = \case+  InvalidEnvironmentName name ->+    "environment binding " <> renderEnvName name <> ": invalid variable name"+  DuplicateEnvironmentName name ->+    "environment binding " <> renderEnvName name <> ": variable bound more than once"+  DuplicateTargetKey key ->+    "bindings target the same key " <> renderKey key <> " twice"+  ConflictingTargetKeys lower higher ->+    "bindings target overlapping keys " <> renderKey lower <> " and " <> renderKey higher+  PrefixedNameCollision name keys ->+    "environment binding "+      <> renderEnvName name+      <> ": normalized name collides for keys "+      <> Text.intercalate ", " (fmap renderKey (NonEmpty.toList keys))++-- | Render every binding-validation failure, one line per problem, matching+-- 'Settei.Render.renderErrorsText' in shape and trailing newline.+renderEnvErrorsText :: NonEmpty EnvError -> Text+renderEnvErrorsText = Text.unlines . fmap renderEnvErrorText . NonEmpty.toList+ -- | Build an injectable snapshot from textual name/value pairs. -- -- Repeated names use the final supplied value, matching the behavior of a map snapshot.@@ -86,22 +150,16 @@  -- | Translate explicitly bound variables from one snapshot into a Settei source. --+-- Total: a 'Bindings' value is valid by construction, so no error branch exists. -- Missing variables are absent leaves. Values remain 'RawText'; target decoding and -- sensitivity handling stay in the core declaration and resolver.-envSource :: Text -> [EnvBinding] -> EnvSnapshot -> Either (NonEmpty EnvError) Source-envSource sourceLabel bindings (EnvSnapshot snapshot) =-  case NonEmpty.nonEmpty (bindingErrors bindings) of-    Just errors -> Left errors-    Nothing ->-      Right-        ( annotateSourceAt-            annotationsFor-            (source sourceLabel EnvironmentSource root)-        )+envSource :: Text -> Bindings -> EnvSnapshot -> Source+envSource sourceLabel (Bindings values) (EnvSnapshot snapshot) =+  annotateSourceAt annotationsFor (source sourceLabel EnvironmentSource root)   where     presentBindings =       [ (bindingValue, rawValue)-      | bindingValue <- bindings,+      | bindingValue <- values,         Just value <- [Map.lookup (bindingValue ^. #name) snapshot],         let rawValue = RawText value       ]@@ -120,35 +178,37 @@         ]     annotationsFor key = Map.findWithDefault Map.empty key perKeyAnnotations +-- | 'envSource' with the conventional source label @"environment"@.+environmentSource :: Bindings -> EnvSnapshot -> Source+environmentSource = envSource "environment"+ -- | Snapshot the process environment once and pass it through the pure translator.-readEnvSource :: Text -> [EnvBinding] -> IO (Either (NonEmpty EnvError) Source)-readEnvSource sourceLabel bindings = do-  values <- Environment.getEnvironment+readEnvSource :: Text -> Bindings -> IO Source+readEnvSource sourceLabel validated = do+  boundValues <- Environment.getEnvironment   pure     ( envSource         sourceLabel-        bindings-        (envSnapshot [(Text.pack name, Text.pack value) | (name, value) <- values])+        validated+        (envSnapshot [(Text.pack name, Text.pack value) | (name, value) <- boundValues])     ) +-- | 'readEnvSource' with the conventional source label @"environment"@.+readEnvironmentSource :: Bindings -> IO Source+readEnvironmentSource = readEnvSource "environment"+ -- | Derive explicit bindings using @PREFIX_KEY_SEGMENTS@ names. -- -- Non-alphanumeric characters become underscores and letters become uppercase. Any -- collision introduced by that normalization is returned instead of being guessed away.-prefixedBindings :: Text -> [Key] -> Either (NonEmpty EnvError) [EnvBinding]+-- The successful result is already validated: pass it straight to 'envSource'.+prefixedBindings :: Text -> [Key] -> Either (NonEmpty EnvError) Bindings prefixedBindings prefix keys =   case NonEmpty.nonEmpty errors of     Just found -> Left found-    Nothing -> Right generated+    Nothing -> Right (Bindings generated)   where     generated = fmap (\key -> binding (prefixedName prefix key) key) keys-    invalidErrors =-      [ InvalidEnvironmentName name-      | bindingValue <- generated,-        let name = bindingValue ^. #name,-        not (validEnvName name)-      ]-    duplicateKeyErrors = fmap DuplicateTargetKey (duplicates keys)     groupedByName =       Map.fromListWith         (<>)@@ -160,23 +220,28 @@       | (name, targetKeys) <- Map.toAscList groupedByName,         NonEmpty.length targetKeys > 1       ]-    errors = invalidErrors <> duplicateKeyErrors <> collisionErrors <> overlapErrors keys+    sharedErrors = filter (not . isDuplicateNameError) (bindingErrors generated)+    errors = sharedErrors <> collisionErrors +isDuplicateNameError :: EnvError -> Bool+isDuplicateNameError (DuplicateEnvironmentName _) = True+isDuplicateNameError _ = False+ -- | Attach a trusted Kubernetes object reference without querying a cluster. fromKubernetesObject :: KubernetesRef -> EnvBinding -> EnvBinding fromKubernetesObject reference bindingValue =   annotateBinding (kubernetesAnnotations reference) bindingValue  bindingErrors :: [EnvBinding] -> [EnvError]-bindingErrors bindings =+bindingErrors values =   [ InvalidEnvironmentName name-  | bindingValue <- bindings,+  | bindingValue <- values,     let name = bindingValue ^. #name,     not (validEnvName name)   ]-    <> fmap DuplicateEnvironmentName (duplicates (fmap (^. #name) bindings))-    <> fmap DuplicateTargetKey (duplicates (fmap (^. #key) bindings))-    <> overlapErrors (fmap (^. #key) bindings)+    <> fmap DuplicateEnvironmentName (duplicates (fmap (^. #name) values))+    <> fmap DuplicateTargetKey (duplicates (fmap (^. #key) values))+    <> overlapErrors (fmap (^. #key) values)  overlapErrors :: [Key] -> [EnvError] overlapErrors keys =@@ -244,4 +309,7 @@             . go rest             . maybe (RawObject Map.empty) id         )+    -- 'Bindings' construction rejects prefix-overlapping target keys, so by the time this+    -- 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"

@@ -1,6 +1,8 @@ module Settei.EnvTest (tests) where +import Data.Either (isLeft, isRight) import Data.Generics.Labels ()+import Data.List qualified as List import Data.List.NonEmpty qualified as NonEmpty import Data.Text qualified as Text import Settei@@ -13,7 +15,9 @@ tests =   testGroup     "Settei.Env"-    [ testCase "explicit binding records variable origin" $ do+    [ errorRenderingTests,+      bindingMergingTests,+      testCase "explicit binding records variable origin" $ do         input <- expectSource [binding (EnvName "HASKELL_ENV") runtimeEnvironment] [("HASKELL_ENV", "Production")]         case lookupSource runtimeEnvironment input of           Right (Just found) -> do@@ -25,6 +29,8 @@         case lookupSource optionalValue input of           Right Nothing -> pure ()           _ -> fail "expected the optional variable to remain absent",+      testCase "invalid names are rejected at construction" $+        assertLeftContains isInvalidName (bindings [binding (EnvName "1BAD") runtimeEnvironment]),       testCase "duplicate bindings are rejected" $ do         let sameName =               [ binding (EnvName "VALUE") runtimeEnvironment,@@ -34,25 +40,55 @@               [ binding (EnvName "ONE") runtimeEnvironment,                 binding (EnvName "TWO") runtimeEnvironment               ]-        assertLeftContains isDuplicateName (envSource "environment" sameName (envSnapshot []))-        assertLeftContains isDuplicateKey (envSource "environment" sameKey (envSnapshot [])),+        assertLeftContains isDuplicateName (bindings sameName)+        assertLeftContains isDuplicateKey (bindings sameKey),       testCase "prefix collisions are rejected" $ do         let keys = [validKey "service.http-port", validKey "service.http_port"]         case prefixedBindings "MYAPP" keys of           Left errors ->             assertBool "expected a normalized-name collision" (any isPrefixCollision (NonEmpty.toList errors))           Right _ -> fail "expected the prefix helper to reject a collision",+      testCase "prefixed bindings preserve their derived names" $ do+        let keys = [validKey "service.host", validKey "service.port"]+        validated <- either (fail . show) pure (prefixedBindings "MYAPP" keys)+        fmap bindingName (bindingsList validated)+          @?= [EnvName "MYAPP_SERVICE_HOST", EnvName "MYAPP_SERVICE_PORT"],       testCase "overlapping target keys are rejected" $ do-        let bindings =+        let overlapping =               [ binding (EnvName "SERVICE") (validKey "service"),                 binding (EnvName "PORT") (validKey "service.port")               ]-        assertLeftContains isConflict (envSource "environment" bindings (envSnapshot [])),+        assertLeftContains isConflict (bindings overlapping),+      testCase "constructed bindings never fail during source building" $ do+        let pool =+              [ binding (EnvName "POOL_A") (validKey "a"),+                binding (EnvName "POOL_AB") (validKey "a.b"),+                binding (EnvName "POOL_AC") (validKey "a.c"),+                binding (EnvName "POOL_B") (validKey "b"),+                binding (EnvName "POOL_BCD") (validKey "b.c.d"),+                binding (EnvName "POOL_C") (validKey "c")+              ]+            snapshot =+              envSnapshot [(name, "value") | EnvName name <- fmap bindingName pool]+            outcomes =+              [ (subset, bindings subset)+              | subset <- List.subsequences pool+              ]+        assertBool "expected some subsets to fail construction" (any (isLeft . snd) outcomes)+        assertBool "expected some subsets to construct" (any (isRight . snd) outcomes)+        sequence_+          [ case lookupSource (bindingKey bound) (envSource "environment" validated snapshot) of+              Right (Just _) -> pure ()+              _ -> fail "expected every bound key to be served by the total source"+          | (subset, Right validated) <- outcomes,+            bound <- subset+          ],       testCase "Secret annotation remains redacted" $ do         let reference = kubernetesRef SecretObject (Just "payments") "payments-database" (Just "password")             passwordBinding = fromKubernetesObject reference (binding (EnvName "DATABASE_PASSWORD") databasePassword)         input <- expectSourceWith [passwordBinding] [("DATABASE_PASSWORD", secretSentinel)]-        result <- expectResolution (resolve defaultResolveOptions [input] (required passwordSetting))+        let result = resolve defaultResolveOptions [input] (required passwordSetting)+        _ <- expectResolution result         let output = renderResolutionText (result ^. #report)         assertBool "secret value reached the report" (not (secretSentinel `Text.isInfixOf` output))         assertBool "secret object metadata was omitted" ("payments-database" `Text.isInfixOf` output)@@ -61,23 +97,82 @@         let reference = kubernetesRef ConfigMapObject Nothing "service-network" (Just "host")             hostBinding = fromKubernetesObject reference (binding (EnvName "SERVICE_HOST") serviceHost)         input <- expectSourceWith [hostBinding] [("SERVICE_HOST", "api.internal")]-        result <- expectResolution (resolve defaultResolveOptions [input] (required hostSetting))+        let result = resolve defaultResolveOptions [input] (required hostSetting)+        _ <- expectResolution result         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)     ] +bindingMergingTests :: TestTree+bindingMergingTests =+  testGroup+    "merging validated bindings"+    [ testCase "preserves disjoint collections in order" $ do+        let firstValues = [binding (EnvName "SERVICE_HOST") serviceHost]+            secondValues = [binding (EnvName "DATABASE_PASSWORD") databasePassword]+        first <- expectBindings firstValues+        second <- expectBindings secondValues+        merged <- either (fail . show) pure (mergeBindings [first, second])+        assertBool+          "merged bindings did not preserve collection order"+          (bindingsList merged == firstValues <> secondValues),+      testCase "rejects a cross-collection duplicate variable name" $ do+        first <- expectBindings [binding (EnvName "SERVICE_VALUE") serviceHost]+        second <- expectBindings [binding (EnvName "SERVICE_VALUE") databasePassword]+        assertLeftContains isDuplicateName (mergeBindings [first, second]),+      testCase "rejects cross-collection overlapping target keys" $ do+        first <- expectBindings [binding (EnvName "SERVICE") (validKey "service")]+        second <- expectBindings [binding (EnvName "SERVICE_PORT") (validKey "service.port")]+        assertLeftContains isConflict (mergeBindings [first, second]),+      testCase "accepts an empty collection list" $ do+        merged <- either (fail . show) pure (mergeBindings [])+        assertBool "empty merge produced bindings" (null (bindingsList merged))+    ]++errorRenderingTests :: TestTree+errorRenderingTests =+  testGroup+    "error rendering"+    [ testCase "invalid environment name" $+        renderEnvErrorText (InvalidEnvironmentName (EnvName "http port"))+          @?= "environment binding http port: invalid variable name",+      testCase "duplicate environment name" $+        renderEnvErrorText (DuplicateEnvironmentName (EnvName "HTTP_PORT"))+          @?= "environment binding HTTP_PORT: variable bound more than once",+      testCase "duplicate target key" $+        renderEnvErrorText (DuplicateTargetKey (validKey "http.port"))+          @?= "bindings target the same key http.port twice",+      testCase "conflicting target keys" $+        renderEnvErrorText+          (ConflictingTargetKeys (validKey "http") (validKey "http.port"))+          @?= "bindings target overlapping keys http and http.port",+      testCase "prefixed name collision" $+        renderEnvErrorText+          ( PrefixedNameCollision+              (EnvName "MYAPP_SERVICE_HTTP_PORT")+              (validKey "service.http-port" :| [validKey "service.http_port"])+          )+          @?= "environment binding MYAPP_SERVICE_HTTP_PORT: normalized name collides for keys service.http-port, service.http_port",+      testCase "plural rendering is singular rendering plus a newline" $ do+        let problem = InvalidEnvironmentName (EnvName "http port")+        renderEnvErrorsText (NonEmpty.singleton problem)+          @?= renderEnvErrorText problem <> "\n"+    ]+ expectSource :: [EnvBinding] -> [(Text, Text)] -> IO Source-expectSource bindings values = expectSourceWith bindings values+expectSource values snapshot = expectSourceWith values snapshot +expectBindings :: [EnvBinding] -> IO Bindings+expectBindings values = either (fail . show) pure (bindings values)+ expectSourceWith :: [EnvBinding] -> [(Text, Text)] -> IO Source-expectSourceWith bindings values =-  case envSource "environment" bindings (envSnapshot values) of-    Left _ -> fail "expected a valid environment source"-    Right value -> pure value+expectSourceWith values snapshot = do+  validated <- expectBindings values+  pure (envSource "environment" validated (envSnapshot snapshot)) -expectResolution :: Either (NonEmpty ConfigError) a -> IO a-expectResolution = \case+expectResolution :: ResolveResult a -> IO a+expectResolution result = case result ^. #answer of   Left _ -> fail "expected successful resolution"   Right value -> pure value @@ -89,6 +184,10 @@ isDuplicateName :: EnvError -> Bool isDuplicateName (DuplicateEnvironmentName _) = True isDuplicateName _ = False++isInvalidName :: EnvError -> Bool+isInvalidName (InvalidEnvironmentName _) = True+isInvalidName _ = False  isDuplicateKey :: EnvError -> Bool isDuplicateKey (DuplicateTargetKey _) = True