settei-env (empty) → 0.1.0.0
raw patch · 6 files changed
+475/−0 lines, 6 filesdep +basedep +containersdep +generic-lens
Dependencies added: base, containers, generic-lens, settei, settei-env, tasty, tasty-hunit, text
Files
- CHANGELOG.md +7/−0
- LICENSE +28/−0
- settei-env.cabal +59/−0
- src/Settei/Env.hs +247/−0
- test/Main.hs +7/−0
- test/Settei/EnvTest.hs +127/−0
+ CHANGELOG.md view
@@ -0,0 +1,7 @@+# Changelog for settei-env++## 0.1.0.0 — 2026-07-18++- Initial experimental release.+- Add explicit environment bindings, injected snapshots, and trusted Kubernetes object+ annotations.
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2026, shinzui+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+ this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ settei-env.cabal view
@@ -0,0 +1,59 @@+cabal-version: 3.8+name: settei-env+version: 0.1.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+extra-doc-files: CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/shinzui/settei.git++common common+ default-language: GHC2024+ default-extensions:+ DeriveAnyClass+ DuplicateRecordFields+ OverloadedLabels+ OverloadedStrings++ ghc-options: -Wall -Wcompat++library+ import: common+ hs-source-dirs: src+ exposed-modules: Settei.Env+ build-depends:+ , base >=4.21 && <5+ , containers >=0.6.8 && <0.8+ , generic-lens >=2.2 && <2.4+ , settei ==0.1.0.0+ , text >=2.1 && <2.2++test-suite settei-env-tests+ import: common+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ 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.1.0.0+ , settei-env ==0.1.0.0+ , tasty >=1.5 && <1.6+ , tasty-hunit >=0.10.2 && <0.11+ , text >=2.1 && <2.2
+ src/Settei/Env.hs view
@@ -0,0 +1,247 @@+-- |+-- Module: Settei.Env+-- Description: Explicit, pure environment-variable sources for Settei.+module Settei.Env+ ( EnvName (..),+ EnvSnapshot (..),+ EnvBinding,+ EnvError (..),+ annotateBinding,+ binding,+ bindingAnnotations,+ bindingKey,+ bindingName,+ envSnapshot,+ envSource,+ fromKubernetesObject,+ prefixedBindings,+ readEnvSource,+ )+where++import Data.Char (isAsciiLower, isAsciiUpper, isDigit)+import Data.Generics.Labels ()+import Data.List.NonEmpty qualified as NonEmpty+import Data.Map.Strict qualified as Map+import Data.Text qualified as Text+import Settei+import Settei.Prelude+import System.Environment qualified as Environment++-- | An environment-variable name. 'envSource' validates its portable spelling.+newtype EnvName = EnvName Text+ deriving stock (Generic, Eq, Ord, Show)++-- | A complete injectable view of the process environment.+newtype EnvSnapshot = EnvSnapshot (Map EnvName Text)+ deriving stock (Generic, Eq)++-- | One explicit mapping from an environment variable to a structural Settei key.+data EnvBinding = EnvBinding+ { name :: !EnvName,+ key :: !Key,+ annotations :: !(Map Text Text)+ }+ deriving stock (Generic, Eq)++-- | Why a set of environment bindings cannot form one hierarchical source.+data EnvError+ = InvalidEnvironmentName !EnvName+ | DuplicateEnvironmentName !EnvName+ | DuplicateTargetKey !Key+ | ConflictingTargetKeys !Key !Key+ | PrefixedNameCollision !EnvName !(NonEmpty Key)+ deriving stock (Generic, Eq, Show)++-- | Construct one explicit binding with no caller annotations.+binding :: EnvName -> Key -> EnvBinding+binding name key = EnvBinding {name, key, annotations = Map.empty}++-- | Add trusted descriptive metadata to a binding.+--+-- Adapter-owned metadata such as @environment.variable@ still takes precedence.+annotateBinding :: Map Text Text -> EnvBinding -> EnvBinding+annotateBinding annotations bindingValue =+ bindingValue & #annotations %~ (annotations <>)++-- | Return the variable name used by a binding.+bindingName :: EnvBinding -> EnvName+bindingName value = value ^. #name++-- | Return the structural key targeted by a binding.+bindingKey :: EnvBinding -> Key+bindingKey value = value ^. #key++-- | Return trusted annotations supplied by the caller.+bindingAnnotations :: EnvBinding -> Map Text Text+bindingAnnotations value = value ^. #annotations++-- | Build an injectable snapshot from textual name/value pairs.+--+-- Repeated names use the final supplied value, matching the behavior of a map snapshot.+envSnapshot :: [(Text, Text)] -> EnvSnapshot+envSnapshot values =+ EnvSnapshot+ (Map.fromList [(EnvName name, value) | (name, value) <- values])++-- | Translate explicitly bound variables from one snapshot into a Settei source.+--+-- 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)+ )+ where+ presentBindings =+ [ (bindingValue, rawValue)+ | bindingValue <- bindings,+ Just value <- [Map.lookup (bindingValue ^. #name) snapshot],+ let rawValue = RawText value+ ]+ root =+ foldl+ (\tree (bindingValue, rawValue) -> insertRawValue (bindingValue ^. #key) rawValue tree)+ (RawObject Map.empty)+ presentBindings+ perKeyAnnotations =+ Map.fromList+ [ ( bindingValue ^. #key,+ Map.singleton "environment.variable" (renderEnvName (bindingValue ^. #name))+ <> bindingValue ^. #annotations+ )+ | (bindingValue, _) <- presentBindings+ ]+ annotationsFor key = Map.findWithDefault Map.empty key perKeyAnnotations++-- | 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+ pure+ ( envSource+ sourceLabel+ bindings+ (envSnapshot [(Text.pack name, Text.pack value) | (name, value) <- values])+ )++-- | 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]+prefixedBindings prefix keys =+ case NonEmpty.nonEmpty errors of+ Just found -> Left found+ Nothing -> Right 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+ (<>)+ [ (bindingValue ^. #name, bindingValue ^. #key :| [])+ | bindingValue <- generated+ ]+ collisionErrors =+ [ PrefixedNameCollision name targetKeys+ | (name, targetKeys) <- Map.toAscList groupedByName,+ NonEmpty.length targetKeys > 1+ ]+ errors = invalidErrors <> duplicateKeyErrors <> collisionErrors <> overlapErrors keys++-- | 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 =+ [ InvalidEnvironmentName name+ | bindingValue <- bindings,+ let name = bindingValue ^. #name,+ not (validEnvName name)+ ]+ <> fmap DuplicateEnvironmentName (duplicates (fmap (^. #name) bindings))+ <> fmap DuplicateTargetKey (duplicates (fmap (^. #key) bindings))+ <> overlapErrors (fmap (^. #key) bindings)++overlapErrors :: [Key] -> [EnvError]+overlapErrors keys =+ [ ConflictingTargetKeys lower higher+ | (positionIndex, lower) <- zip [0 :: Int ..] keys,+ higher <- drop (positionIndex + 1) keys,+ lower /= higher,+ isPrefixKey lower higher || isPrefixKey higher lower+ ]++duplicates :: (Ord a) => [a] -> [a]+duplicates values =+ Map.keys (Map.filter (> (1 :: Int)) (Map.fromListWith (+) [(value, 1) | value <- values]))++validEnvName :: EnvName -> Bool+validEnvName (EnvName value) =+ case Text.uncons value of+ Nothing -> False+ Just (firstCharacter, rest) ->+ validInitial firstCharacter && Text.all validContinuation rest+ where+ validInitial character = asciiLetter character || character == '_'+ validContinuation character = validInitial character || isDigit character++asciiLetter :: Char -> Bool+asciiLetter character = isAsciiLower character || isAsciiUpper character++prefixedName :: Text -> Key -> EnvName+prefixedName prefix key =+ EnvName+ ( Text.intercalate+ "_"+ (normalizeNamePart prefix : fmap normalizeNamePart (NonEmpty.toList (keySegments key)))+ )++normalizeNamePart :: Text -> Text+normalizeNamePart =+ Text.toUpper+ . Text.map+ (\character -> if asciiLetter character || isDigit character || character == '_' then character else '_')++renderEnvName :: EnvName -> Text+renderEnvName (EnvName value) = value++isPrefixKey :: Key -> Key -> Bool+isPrefixKey prefix candidateKey =+ NonEmpty.toList (keySegments prefix)+ `isListPrefixOf` NonEmpty.toList (keySegments candidateKey)++isListPrefixOf :: (Eq a) => [a] -> [a] -> Bool+isListPrefixOf [] _ = True+isListPrefixOf _ [] = False+isListPrefixOf (left : leftRest) (right : rightRest) =+ left == right && isListPrefixOf leftRest rightRest++insertRawValue :: Key -> RawValue -> RawValue -> RawValue+insertRawValue key value = go (NonEmpty.toList (keySegments key))+ where+ go [] _ = value+ go (segment : rest) (RawObject object) =+ RawObject+ ( object+ & at segment+ %~ Just+ . go rest+ . maybe (RawObject Map.empty) id+ )+ go _ _ = error "validated environment keys cannot overlap"
+ test/Main.hs view
@@ -0,0 +1,7 @@+module Main (main) where++import Settei.EnvTest qualified+import Test.Tasty (defaultMain, testGroup)++main :: IO ()+main = defaultMain (testGroup "settei-env" [Settei.EnvTest.tests])
+ test/Settei/EnvTest.hs view
@@ -0,0 +1,127 @@+module Settei.EnvTest (tests) where++import Data.Generics.Labels ()+import Data.List.NonEmpty qualified as NonEmpty+import Data.Text qualified as Text+import Settei+import Settei.Env+import Settei.Prelude+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, testCase, (@?=))++tests :: TestTree+tests =+ testGroup+ "Settei.Env"+ [ 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+ found ^. to candidateOrigin . #kind @?= EnvironmentSource+ found ^. to candidateOrigin . #annotations . at "environment.variable" @?= Just "HASKELL_ENV"+ _ -> fail "expected the environment candidate",+ testCase "missing variables remain absent" $ do+ input <- expectSource [binding (EnvName "OPTIONAL_VALUE") optionalValue] []+ case lookupSource optionalValue input of+ Right Nothing -> pure ()+ _ -> fail "expected the optional variable to remain absent",+ testCase "duplicate bindings are rejected" $ do+ let sameName =+ [ binding (EnvName "VALUE") runtimeEnvironment,+ binding (EnvName "VALUE") optionalValue+ ]+ sameKey =+ [ binding (EnvName "ONE") runtimeEnvironment,+ binding (EnvName "TWO") runtimeEnvironment+ ]+ assertLeftContains isDuplicateName (envSource "environment" sameName (envSnapshot []))+ assertLeftContains isDuplicateKey (envSource "environment" sameKey (envSnapshot [])),+ 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 "overlapping target keys are rejected" $ do+ let bindings =+ [ binding (EnvName "SERVICE") (validKey "service"),+ binding (EnvName "PORT") (validKey "service.port")+ ]+ assertLeftContains isConflict (envSource "environment" bindings (envSnapshot [])),+ 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 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)+ assertBool "secret key metadata was omitted" ("password" `Text.isInfixOf` output),+ testCase "ConfigMap annotation retains public metadata" $ do+ 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 output = renderResolutionText (result ^. #report)+ assertBool "ConfigMap metadata was omitted" ("service-network" `Text.isInfixOf` output)+ assertBool "public value was omitted" ("api.internal" `Text.isInfixOf` output)+ ]++expectSource :: [EnvBinding] -> [(Text, Text)] -> IO Source+expectSource bindings values = expectSourceWith 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++expectResolution :: Either (NonEmpty ConfigError) a -> IO a+expectResolution = \case+ Left _ -> fail "expected successful resolution"+ Right value -> pure value++assertLeftContains :: (EnvError -> Bool) -> Either (NonEmpty EnvError) a -> IO ()+assertLeftContains predicate = \case+ Left errors -> assertBool "expected matching validation error" (any predicate (NonEmpty.toList errors))+ Right _ -> fail "expected binding validation to fail"++isDuplicateName :: EnvError -> Bool+isDuplicateName (DuplicateEnvironmentName _) = True+isDuplicateName _ = False++isDuplicateKey :: EnvError -> Bool+isDuplicateKey (DuplicateTargetKey _) = True+isDuplicateKey _ = False++isPrefixCollision :: EnvError -> Bool+isPrefixCollision (PrefixedNameCollision _ _) = True+isPrefixCollision _ = False++isConflict :: EnvError -> Bool+isConflict (ConflictingTargetKeys _ _) = True+isConflict _ = False++passwordSetting :: Setting Text+passwordSetting = secretSetting databasePassword "Database password" textDecoder++hostSetting :: Setting Text+hostSetting = publicSetting serviceHost "Service host" textDecoder++runtimeEnvironment :: Key+runtimeEnvironment = validKey "runtime.environment"++optionalValue :: Key+optionalValue = validKey "optional.value"++databasePassword :: Key+databasePassword = validKey "database.password"++serviceHost :: Key+serviceHost = validKey "service.host"++validKey :: Text -> Key+validKey value = either (error . show) id (parseKey value)++secretSentinel :: Text+secretSentinel = "never-render-this-secret"