diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,14 @@ +# Changelog for settei-kubernetes + +## 0.2.0.0 — 2026-07-19 + +- Initial experimental release. +- Add a mounted-directory source for projected ConfigMap and Secret volumes with + explicit per-file key bindings, atomic-writer symlink handling, per-file + provenance, and secret-safe categorized errors with text renderers. +- Add `Settei.Kubernetes.Bindings`: derive validated environment bindings from a + ConfigMap or Secret reference in one construction, so each binding's provenance + annotation is generated from the same data key that feeds it. +- Mounted-directory origins now carry freshness identity: `kubernetes.mount-path`, + per-key `kubernetes.file-modified`, and source-wide `kubernetes.read-at` + (ISO-8601 UTC). Descriptive only; precedence is unchanged. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/settei-kubernetes.cabal b/settei-kubernetes.cabal new file mode 100644 --- /dev/null +++ b/settei-kubernetes.cabal @@ -0,0 +1,74 @@ +cabal-version: 3.8 +name: settei-kubernetes +version: 0.2.0.0 +synopsis: Kubernetes mounted-directory sources for Settei +description: + Translate a projected ConfigMap or Secret volume - a directory with one file + per data key - into a provenance-aware Settei source through explicit + per-file key bindings, handling the kubelet's atomic-writer symlink layout. + +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.Kubernetes + Settei.Kubernetes.Bindings + + build-depends: + , base >=4.21 && <5 + , bytestring >=0.12 && <0.13 + , containers >=0.6.8 && <0.8 + , directory >=1.3.8 && <1.4 + , filepath >=1.5.4 && <1.6 + , generic-lens >=2.2 && <2.4 + , settei ==0.2.0.0 + , settei-env ==0.2.0.0 + , text >=2.1 && <2.2 + , time >=1.14 && <1.17 + +test-suite settei-kubernetes-tests + import: common + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + other-modules: Settei.KubernetesTest + build-depends: + , base >=4.21 && <5 + , bytestring >=0.12 && <0.13 + , containers >=0.6.8 && <0.8 + , directory >=1.3.8 && <1.4 + , filepath >=1.5.4 && <1.6 + , generic-lens >=2.2 && <2.4 + , settei ==0.2.0.0 + , settei-env ==0.2.0.0 + , settei-kubernetes ==0.2.0.0 + , tasty >=1.5 && <1.6 + , tasty-hunit >=0.10.2 && <0.11 + , temporary >=1.3 && <1.4 + , text >=2.1 && <2.2 + , time >=1.14 && <1.17 diff --git a/src/Settei/Kubernetes.hs b/src/Settei/Kubernetes.hs new file mode 100644 --- /dev/null +++ b/src/Settei/Kubernetes.hs @@ -0,0 +1,483 @@ +{-# LANGUAGE ImportQualifiedPost #-} + +-- | +-- Module: Settei.Kubernetes +-- Description: Kubernetes mounted-directory sources for Settei. +-- +-- Kubernetes ConfigMap and Secret volumes normally appear as a directory with one +-- visible file per object key. Kubelet's atomic writer implements those files as +-- symlinks through a hidden @..data@ directory; this module reads the visible names and +-- follows those links, while 'unboundMountedFiles' ignores the hidden writer entries. +-- File names are bound explicitly because Kubernetes data keys commonly contain dots, +-- which must not be confused with Settei's structural dotted-key syntax. +-- +-- By default one trailing newline is removed from every decoded UTF-8 value. Use +-- 'keepTrailingNewline' for byte-faithful text. A single-file @subPath@ mount can use a +-- format adapter such as @settei-yaml@, or a one-entry 'FileBindings' value here. +-- +-- A typical Secret mount can be loaded as follows: +-- +-- @ +-- passwordKey <- either fail pure (parseKey "database.password") +-- validated <- either (fail . show) pure (fileBindings [fileBinding "password" passwordKey]) +-- let reference = kubernetesRef SecretObject (Just "prod") "app-credentials" Nothing +-- readMountedDirectorySource +-- (mountedDirectoryOptions "app-secrets" reference) +-- validated +-- "/etc/app-secrets" +-- @ +module Settei.Kubernetes + ( FileBinding, + FileBindings, + KubernetesErrorCategory (..), + KubernetesSourceError, + MountedDirectoryOptions, + annotateFileBinding, + annotateMountedDirectoryOptions, + fileBinding, + fileBindingAnnotations, + fileBindingKey, + fileBindingName, + fileBindings, + fileBindingsList, + keepTrailingNewline, + kubernetesErrorCategory, + kubernetesErrorMessage, + kubernetesErrorName, + kubernetesErrorPath, + mountedDirectoryAnnotations, + mountedDirectoryKeepsTrailingNewline, + mountedDirectoryName, + mountedDirectoryOptions, + mountedDirectoryRef, + readMountedDirectorySource, + renderKubernetesErrorText, + renderKubernetesErrorsText, + unboundMountedFiles, + ) +where + +import Control.Exception (IOException, displayException, try) +import Data.ByteString qualified as ByteString +import Data.Generics.Labels () +import Data.List (sort) +import Data.List.NonEmpty qualified as NonEmpty +import Data.Map.Strict qualified as Map +import Data.Maybe (fromMaybe) +import Data.Text qualified as Text +import Data.Text.Encoding qualified as TextEncoding +import Data.Time.Clock (UTCTime, getCurrentTime) +import Data.Time.Format (defaultTimeLocale, formatTime) +import Settei +import Settei.Prelude +import System.Directory qualified as Directory +import System.FilePath (()) +import System.IO.Error qualified as IOError + +-- | One explicit mapping from a visible mounted file to a structural Settei key. +data FileBinding = FileBinding + { fileName :: !Text, + key :: !Key, + annotations :: !(Map Text Text) + } + deriving stock (Generic, Eq) + +-- | A collection of file bindings proven valid at construction. +-- +-- The constructor is private. 'fileBindings' rejects invalid or reserved names, +-- duplicates, and target keys whose tree positions overlap. +newtype FileBindings = ValidatedFileBindings [FileBinding] + deriving stock (Eq) + +-- | Stable classes of mounted-directory and binding failure. +-- +-- No constructor retains raw file content. +data KubernetesErrorCategory + = KubernetesInvalidFileName + | KubernetesDuplicateFileName + | KubernetesDuplicateTargetKey + | KubernetesConflictingTargetKeys + | KubernetesNotADirectory + | KubernetesIoError + | KubernetesInvalidUtf8 + deriving stock (Generic, Eq, Ord, Show) + +-- | A secret-safe mounted-directory input failure. +data KubernetesSourceError = KubernetesSourceError + { category :: !KubernetesErrorCategory, + name :: !(Maybe Text), + path :: !(Maybe FilePath), + message :: !Text + } + deriving stock (Generic, Eq, Show) + +-- | Naming, provenance, annotations, and text policy for one mounted directory. +-- +-- The optional key already present in the 'KubernetesRef' is ignored: each present +-- mounted file supplies its own @kubernetes.object-key@ annotation. +data MountedDirectoryOptions = MountedDirectoryOptions + { name :: !Text, + ref :: !KubernetesRef, + annotations :: !(Map Text Text), + keepsTrailingNewline :: !Bool + } + deriving stock (Generic, Eq) + +-- | Construct one file binding with no caller annotations. +fileBinding :: Text -> Key -> FileBinding +fileBinding fileName key = FileBinding {fileName, key, annotations = Map.empty} + +-- | Add trusted descriptive metadata to one binding. +-- +-- Adapter-owned @kubernetes.*@ annotations take precedence on name collisions. +annotateFileBinding :: Map Text Text -> FileBinding -> FileBinding +annotateFileBinding annotations bindingValue = + bindingValue & #annotations %~ (annotations <>) + +-- | Return the visible mounted file name. +fileBindingName :: FileBinding -> Text +fileBindingName value = value ^. #fileName + +-- | Return the structural Settei key targeted by a binding. +fileBindingKey :: FileBinding -> Key +fileBindingKey value = value ^. #key + +-- | Return trusted annotations supplied by the caller. +fileBindingAnnotations :: FileBinding -> Map Text Text +fileBindingAnnotations value = value ^. #annotations + +-- | Validate a static binding list, accumulating every independent problem. +-- +-- An empty list is valid and produces a source with no leaves. +fileBindings :: [FileBinding] -> Either (NonEmpty KubernetesSourceError) FileBindings +fileBindings values = + case NonEmpty.nonEmpty (bindingErrors values) of + Just errors -> Left errors + Nothing -> Right (ValidatedFileBindings values) + +-- | Inspect validated bindings without exposing the collection constructor. +fileBindingsList :: FileBindings -> [FileBinding] +fileBindingsList (ValidatedFileBindings values) = values + +-- | Start options for one asserted Kubernetes object and stable source name. +mountedDirectoryOptions :: Text -> KubernetesRef -> MountedDirectoryOptions +mountedDirectoryOptions name ref = + MountedDirectoryOptions + { name, + ref, + annotations = Map.empty, + keepsTrailingNewline = False + } + +-- | Add trusted source-wide annotations. +annotateMountedDirectoryOptions :: Map Text Text -> MountedDirectoryOptions -> MountedDirectoryOptions +annotateMountedDirectoryOptions annotations options = + options & #annotations %~ (annotations <>) + +-- | Preserve file text verbatim instead of removing one trailing newline. +keepTrailingNewline :: MountedDirectoryOptions -> MountedDirectoryOptions +keepTrailingNewline options = options & #keepsTrailingNewline .~ True + +-- | Return the stable source name used in reports. +mountedDirectoryName :: MountedDirectoryOptions -> Text +mountedDirectoryName options = options ^. #name + +-- | Return the asserted Kubernetes object reference. +mountedDirectoryRef :: MountedDirectoryOptions -> KubernetesRef +mountedDirectoryRef options = options ^. #ref + +-- | Return caller-supplied source-wide annotations. +mountedDirectoryAnnotations :: MountedDirectoryOptions -> Map Text Text +mountedDirectoryAnnotations options = options ^. #annotations + +-- | Report whether trailing newlines are preserved. +mountedDirectoryKeepsTrailingNewline :: MountedDirectoryOptions -> Bool +mountedDirectoryKeepsTrailingNewline options = options ^. #keepsTrailingNewline + +-- | Return an error's stable category. +kubernetesErrorCategory :: KubernetesSourceError -> KubernetesErrorCategory +kubernetesErrorCategory problem = problem ^. #category + +-- | Return the source name associated with an error, when construction reached a source. +kubernetesErrorName :: KubernetesSourceError -> Maybe Text +kubernetesErrorName problem = problem ^. #name + +-- | Return the mounted directory or file path associated with an error, when known. +kubernetesErrorPath :: KubernetesSourceError -> Maybe FilePath +kubernetesErrorPath problem = problem ^. #path + +-- | Return the concise secret-safe error message. +kubernetesErrorMessage :: KubernetesSourceError -> Text +kubernetesErrorMessage problem = problem ^. #message + +-- | Read explicitly bound UTF-8 values from a projected-volume directory. +-- +-- Visible file symlinks are followed normally. Bound files that do not exist contribute +-- no leaf. All other I/O and UTF-8 failures are accumulated, and no raw content enters +-- an error. Each present leaf receives its exact file path and Kubernetes object/key +-- annotations. Source-wide annotations retain the requested mount path and read time; +-- each present key also records the modification time of the file that was read. +readMountedDirectorySource :: + MountedDirectoryOptions -> + FileBindings -> + FilePath -> + IO (Either (NonEmpty KubernetesSourceError) Source) +readMountedDirectorySource options (ValidatedFileBindings bindingsValue) directory = do + isDirectory <- Directory.doesDirectoryExist directory + if not isDirectory + then pure (Left (NonEmpty.singleton (notDirectoryError options directory))) + else do + readAt <- getCurrentTime + outcomes <- traverse (readBinding options directory) bindingsValue + let errors = [problem | Left problem <- outcomes] + present = [value | Right (Just value) <- outcomes] + pure $ case NonEmpty.nonEmpty errors of + Just found -> Left found + Nothing -> Right (buildSource options directory readAt present) + +-- | List visible mounted entries that have no explicit binding. +-- +-- Hidden atomic-writer entries beginning with @..@ are omitted without being statted or +-- traversed. Directory-listing 'IOException's propagate. This helper is intended for a +-- deliberate startup diagnostic rather than source construction. +unboundMountedFiles :: FileBindings -> FilePath -> IO [Text] +unboundMountedFiles (ValidatedFileBindings bindingsValue) directory = do + entries <- fmap Text.pack <$> Directory.listDirectory directory + let boundNames = Map.fromList [(bindingValue ^. #fileName, ()) | bindingValue <- bindingsValue] + pure + ( sort + [ entry + | entry <- entries, + not (".." `Text.isPrefixOf` entry), + Map.notMember entry boundNames + ] + ) + +-- | Render one mounted-directory failure as a single operator-readable line. +renderKubernetesErrorText :: KubernetesSourceError -> Text +renderKubernetesErrorText problem = + prefix <> problem ^. #message + where + prefix = case (problem ^. #name, problem ^. #path) of + (Just mountedName, Just sourcePath) -> + mountedName <> " (" <> Text.pack sourcePath <> "): " + (Just mountedName, Nothing) -> mountedName <> ": " + (Nothing, Just sourcePath) -> Text.pack sourcePath <> ": " + (Nothing, Nothing) -> "file bindings: " + +-- | Render every mounted-directory failure, one line per problem and a trailing newline. +renderKubernetesErrorsText :: NonEmpty KubernetesSourceError -> Text +renderKubernetesErrorsText = + Text.unlines . fmap renderKubernetesErrorText . NonEmpty.toList + +type PresentBinding = (FileBinding, Text, FilePath, UTCTime) + +readBinding :: + MountedDirectoryOptions -> + FilePath -> + FileBinding -> + IO (Either KubernetesSourceError (Maybe PresentBinding)) +readBinding options directory bindingValue = do + let filePath = directory Text.unpack (bindingValue ^. #fileName) + result <- + try @IOException $ do + bytes <- ByteString.readFile filePath + modifiedAt <- Directory.getModificationTime filePath + pure (bytes, modifiedAt) + pure $ case result of + Left exception + | IOError.isDoesNotExistError exception -> Right Nothing + | otherwise -> + Left + ( sourceError + options + KubernetesIoError + (Just filePath) + (Text.pack (displayException exception)) + ) + Right (bytes, modifiedAt) -> case TextEncoding.decodeUtf8' bytes of + Left _ -> + Left + ( sourceError + options + KubernetesInvalidUtf8 + (Just filePath) + "file content is not valid UTF-8" + ) + Right decoded -> + Right + ( Just + ( bindingValue, + applyNewlinePolicy options decoded, + filePath, + modifiedAt + ) + ) + +applyNewlinePolicy :: MountedDirectoryOptions -> Text -> Text +applyNewlinePolicy options value + | options ^. #keepsTrailingNewline = value + | otherwise = fromMaybe value (Text.stripSuffix "\n" value) + +buildSource :: MountedDirectoryOptions -> FilePath -> UTCTime -> [PresentBinding] -> Source +buildSource options directory readAt present = + annotateSource freshnessAnnotations + . annotateSource (options ^. #annotations) + . annotateSourceAt freshnessFor + . annotateSourceAt annotationsFor + . locateSource locationFor + $ source + (options ^. #name) + (CustomSource "kubernetes-mounted-directory") + root + where + root = + foldl + (\tree (bindingValue, value, _, _) -> insertRawValue (bindingValue ^. #key) (RawText value) tree) + (RawObject Map.empty) + present + locations = + Map.fromList + [ ( bindingValue ^. #key, + SourceLocation + { path = Text.pack filePath, + line = Nothing, + column = Nothing + } + ) + | (bindingValue, _, filePath, _) <- present + ] + annotationsByKey = + Map.fromList + [ ( bindingValue ^. #key, + kubernetesAnnotations (options ^. #ref & #key .~ Just (bindingValue ^. #fileName)) + <> bindingValue ^. #annotations + ) + | (bindingValue, _, _, _) <- present + ] + modifiedByKey = + Map.fromList + [ (bindingValue ^. #key, modifiedAt) + | (bindingValue, _, _, modifiedAt) <- present + ] + freshnessAnnotations = + Map.fromList + [ ("kubernetes.mount-path", Text.pack directory), + ("kubernetes.read-at", renderUtcTime readAt) + ] + locationFor target = Map.lookup target locations + annotationsFor target = Map.findWithDefault Map.empty target annotationsByKey + freshnessFor target = + maybe + Map.empty + (Map.singleton "kubernetes.file-modified" . renderUtcTime) + (Map.lookup target modifiedByKey) + +renderUtcTime :: UTCTime -> Text +renderUtcTime = Text.pack . formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" + +bindingErrors :: [FileBinding] -> [KubernetesSourceError] +bindingErrors values = + [ bindingError + KubernetesInvalidFileName + ("file name " <> quoted fileName <> " contains a path separator or is reserved") + | bindingValue <- values, + let fileName = bindingValue ^. #fileName, + not (validFileName fileName) + ] + <> fmap duplicateFileNameError (duplicates (fmap (^. #fileName) values)) + <> fmap duplicateTargetKeyError (duplicates (fmap (^. #key) values)) + <> overlapErrors (fmap (^. #key) values) + +validFileName :: Text -> Bool +validFileName value = + not (Text.null value) + && not (Text.any (\character -> character == '/' || character == '\NUL') value) + && value /= "." + && not (".." `Text.isPrefixOf` value) + +duplicates :: (Ord a) => [a] -> [a] +duplicates values = + Map.keys (Map.filter (> (1 :: Int)) (Map.fromListWith (+) [(value, 1) | value <- values])) + +overlapErrors :: [Key] -> [KubernetesSourceError] +overlapErrors keys = + [ bindingError + KubernetesConflictingTargetKeys + ("target keys " <> renderKey lower <> " and " <> renderKey higher <> " overlap") + | (positionIndex, lower) <- zip [0 :: Int ..] keys, + higher <- drop (positionIndex + 1) keys, + lower /= higher, + isPrefixKey lower higher || isPrefixKey higher lower + ] + +duplicateFileNameError :: Text -> KubernetesSourceError +duplicateFileNameError fileName = + bindingError + KubernetesDuplicateFileName + ("file name " <> quoted fileName <> " is bound more than once") + +duplicateTargetKeyError :: Key -> KubernetesSourceError +duplicateTargetKeyError target = + bindingError + KubernetesDuplicateTargetKey + ("target key " <> renderKey target <> " is bound more than once") + +bindingError :: KubernetesErrorCategory -> Text -> KubernetesSourceError +bindingError category message = + KubernetesSourceError + { category, + name = Nothing, + path = Nothing, + message + } + +notDirectoryError :: MountedDirectoryOptions -> FilePath -> KubernetesSourceError +notDirectoryError options directory = + sourceError + options + KubernetesNotADirectory + (Just directory) + "mounted path is not a directory" + +sourceError :: + MountedDirectoryOptions -> + KubernetesErrorCategory -> + Maybe FilePath -> + Text -> + KubernetesSourceError +sourceError options category path message = + KubernetesSourceError + { category, + name = Just (options ^. #name), + path, + message + } + +quoted :: Text -> Text +quoted 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 + . fromMaybe (RawObject Map.empty) + ) + go _ _ = error "validated file-binding keys cannot overlap" diff --git a/src/Settei/Kubernetes/Bindings.hs b/src/Settei/Kubernetes/Bindings.hs new file mode 100644 --- /dev/null +++ b/src/Settei/Kubernetes/Bindings.hs @@ -0,0 +1,58 @@ +-- | +-- Module: Settei.Kubernetes.Bindings +-- Description: Derive validated environment bindings from Kubernetes object references. +module Settei.Kubernetes.Bindings + ( ObjectKeyBinding (..), + bindingsFromConfigMap, + bindingsFromSecret, + objectKeyBinding, + ) +where + +import Data.Generics.Labels () +import Settei +import Settei.Env +import Settei.Prelude + +-- | One row of a derivation: this data key feeds this variable at this target key. +-- +-- Holds only names and keys, never configuration values. +data ObjectKeyBinding = ObjectKeyBinding + { objectKey :: !Text, + envName :: !EnvName, + targetKey :: !Key + } + deriving stock (Generic, Eq, Show) + +-- | Construct one derivation row. +objectKeyBinding :: Text -> EnvName -> Key -> ObjectKeyBinding +objectKeyBinding objectKey envName targetKey = + ObjectKeyBinding {objectKey, envName, targetKey} + +-- | Derive validated bindings from one Secret: namespace, object name, key rows. +-- +-- Every generated binding carries the annotations of a per-key reference whose +-- @kubernetes.object-key@ is the row's data key, so the provenance annotation cannot +-- drift from the binding. Validation is settei-env's: invalid or duplicate variable +-- names and duplicate or overlapping target keys are rejected as 'EnvError's. +bindingsFromSecret :: + Maybe Text -> Text -> [ObjectKeyBinding] -> Either (NonEmpty EnvError) Bindings +bindingsFromSecret = bindingsFromObject SecretObject + +-- | 'bindingsFromSecret' for a ConfigMap reference. +bindingsFromConfigMap :: + Maybe Text -> Text -> [ObjectKeyBinding] -> Either (NonEmpty EnvError) Bindings +bindingsFromConfigMap = bindingsFromObject ConfigMapObject + +bindingsFromObject :: + KubernetesObjectKind -> + Maybe Text -> + Text -> + [ObjectKeyBinding] -> + Either (NonEmpty EnvError) Bindings +bindingsFromObject kind namespace objectName rows = bindings (fmap derive rows) + where + derive row = + fromKubernetesObject + (kubernetesRef kind namespace objectName (Just (row ^. #objectKey))) + (binding (row ^. #envName) (row ^. #targetKey)) diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,7 @@ +module Main (main) where + +import Settei.KubernetesTest qualified as KubernetesTest +import Test.Tasty (defaultMain, testGroup) + +main :: IO () +main = defaultMain (testGroup "settei-kubernetes" [KubernetesTest.tests]) diff --git a/test/Settei/KubernetesTest.hs b/test/Settei/KubernetesTest.hs new file mode 100644 --- /dev/null +++ b/test/Settei/KubernetesTest.hs @@ -0,0 +1,560 @@ +{-# LANGUAGE ImportQualifiedPost #-} + +module Settei.KubernetesTest (tests) where + +import Data.ByteString (ByteString) +import Data.ByteString qualified as ByteString +import Data.ByteString.Char8 qualified as ByteString8 +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 Data.Time.Clock (UTCTime) +import Data.Time.Format (defaultTimeLocale, parseTimeM) +import Settei +import Settei.Env +import Settei.Kubernetes +import Settei.Kubernetes.Bindings +import Settei.Prelude +import System.Directory qualified as Directory +import System.FilePath (()) +import System.IO.Temp (withSystemTempDirectory) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit (assertBool, testCase, (@?=)) + +tests :: TestTree +tests = + testGroup + "Settei.Kubernetes" + [ atomicWriterTests, + bindingsDerivationTests, + bindingValidationTests, + missingAndErrorTests, + newlineTests, + provenanceTests, + rendererTests + ] + +bindingsDerivationTests :: TestTree +bindingsDerivationTests = + testGroup + "bindings derivation" + [ testCase "matches the hand-written Secret binding exactly" $ do + derived <- + expectDerivedBindings + ( bindingsFromSecret + Nothing + "settei-example-service-database" + [objectKeyBinding "password" (EnvName "DATABASE_PASSWORD") passwordKey] + ) + let reference = + kubernetesRef + SecretObject + Nothing + "settei-example-service-database" + (Just "password") + manual = + fromKubernetesObject + reference + (binding (EnvName "DATABASE_PASSWORD") passwordKey) + assertBool + "derived Secret binding differed from the hand-written idiom" + (bindingsList derived == [manual]) + case bindingsList derived of + [derivedBinding] -> + bindingAnnotations derivedBinding @?= kubernetesAnnotations reference + _ -> fail "expected exactly one derived Secret binding", + testCase "derives ConfigMap namespace and object annotations" $ do + derived <- + expectDerivedBindings + ( bindingsFromConfigMap + (Just "payments") + "service-config" + [objectKeyBinding "host" (EnvName "SERVICE_HOST") hostKey] + ) + case bindingsList derived of + [derivedBinding] -> do + bindingAnnotations derivedBinding + ^. at "kubernetes.object-kind" + @?= Just "ConfigMap" + bindingAnnotations derivedBinding + ^. at "kubernetes.namespace" + @?= Just "payments" + bindingAnnotations derivedBinding + ^. at "kubernetes.object-name" + @?= Just "service-config" + bindingAnnotations derivedBinding + ^. at "kubernetes.object-key" + @?= Just "host" + _ -> fail "expected exactly one derived ConfigMap binding", + testCase "allows one object key to feed multiple variables" $ do + derived <- + expectDerivedBindings + ( bindingsFromSecret + Nothing + "shared-secret" + [ objectKeyBinding "shared" (EnvName "DATABASE_PASSWORD") passwordKey, + objectKeyBinding "shared" (EnvName "SERVICE_HOST") hostKey + ] + ) + fmap ((^. at "kubernetes.object-key") . bindingAnnotations) (bindingsList derived) + @?= [Just "shared", Just "shared"], + testCase "rejects duplicate variables and overlapping target keys" $ do + let duplicateName = + bindingsFromSecret + Nothing + "service-secret" + [ objectKeyBinding "first" (EnvName "SERVICE_VALUE") databaseKey, + objectKeyBinding "second" (EnvName "SERVICE_VALUE") hostKey + ] + overlappingTargets = + bindingsFromConfigMap + Nothing + "service-config" + [ objectKeyBinding "database" (EnvName "DATABASE") databaseKey, + objectKeyBinding "password" (EnvName "DATABASE_PASSWORD") passwordKey + ] + assertEnvLeftContains isDuplicateEnvName duplicateName + assertEnvLeftContains isConflictingEnvKey overlappingTargets, + testCase "merges derived and manual binding collections" $ do + derived <- + expectDerivedBindings + ( bindingsFromSecret + Nothing + "service-secret" + [objectKeyBinding "password" (EnvName "DATABASE_PASSWORD") passwordKey] + ) + manual <- expectEnvBindings [binding (EnvName "MANUAL_VALUE") manualKey] + merged <- expectDerivedBindings (mergeBindings [derived, manual]) + assertBool + "derived and manual collections did not compose" + (bindingsList merged == bindingsList derived <> bindingsList manual) + + duplicateManual <- expectEnvBindings [binding (EnvName "DATABASE_PASSWORD") manualKey] + assertEnvLeftContains isDuplicateEnvName (mergeBindings [derived, duplicateManual]) + ] + +atomicWriterTests :: TestTree +atomicWriterTests = + testGroup + "atomic writer layout" + [ testCase "reads bound keys through ..data symlinks" $ + withSystemTempDirectory "settei-kubernetes" $ \root -> do + atomicWriterFixture + root + [ ("password", ByteString8.pack "s3cr3t"), + ("http-host", ByteString8.pack "api.internal") + ] + validated <- expectBindings [fileBinding "password" passwordKey, fileBinding "http-host" hostKey] + input <- expectSource =<< readMountedDirectorySource defaultOptions validated root + value <- expectAnswer (resolve defaultResolveOptions [input] serviceConfig) + value @?= ("s3cr3t", "api.internal"), + testCase "unboundMountedFiles skips atomic-writer entries" $ + withSystemTempDirectory "settei-kubernetes" $ \root -> do + atomicWriterFixture + root + [ ("password", ByteString8.pack "s3cr3t"), + ("http-host", ByteString8.pack "api.internal") + ] + validated <- expectBindings [fileBinding "password" passwordKey] + unbound <- unboundMountedFiles validated root + unbound @?= ["http-host"] + ] + +bindingValidationTests :: TestTree +bindingValidationTests = + testGroup + "binding validation" + [ invalidNameTest "" "rejects empty file names", + invalidNameTest "a/b" "rejects path separators", + invalidNameTest "." "rejects the current-directory name", + invalidNameTest ".." "rejects the parent-directory name", + invalidNameTest "..data" "rejects atomic-writer names", + invalidNameTest (Text.pack ['a', '\NUL']) "rejects NUL in file names", + testCase "rejects duplicate file names" $ do + errors <- + expectBindingErrors + [fileBinding "value" passwordKey, fileBinding "value" hostKey] + categories errors @?= [KubernetesDuplicateFileName], + testCase "rejects duplicate target keys" $ do + errors <- + expectBindingErrors + [fileBinding "first" passwordKey, fileBinding "second" passwordKey] + categories errors @?= [KubernetesDuplicateTargetKey], + testCase "rejects prefix-overlapping target keys" $ do + errors <- + expectBindingErrors + [fileBinding "database" databaseKey, fileBinding "password" passwordKey] + categories errors @?= [KubernetesConflictingTargetKeys], + testCase "accumulates independent binding problems" $ do + errors <- + expectBindingErrors + [ fileBinding "a/b" databaseKey, + fileBinding "same" passwordKey, + fileBinding "same" passwordKey + ] + categories errors + @?= [ KubernetesInvalidFileName, + KubernetesDuplicateFileName, + KubernetesDuplicateTargetKey, + KubernetesConflictingTargetKeys, + KubernetesConflictingTargetKeys + ], + testCase "accepts an empty binding collection" $ do + validated <- expectBindings [] + assertBool "empty bindings were not retained" (null (fileBindingsList validated)) + ] + +missingAndErrorTests :: TestTree +missingAndErrorTests = + testGroup + "missing files and input failures" + [ testCase "an absent bound file stays a resolver concern" $ + withSystemTempDirectory "settei-kubernetes" $ \root -> do + validated <- expectBindings [fileBinding "missing" passwordKey] + input <- expectSource =<< readMountedDirectorySource defaultOptions validated root + case resolve defaultResolveOptions [input] (required passwordSetting) ^. #answer of + Left errors -> case NonEmpty.toList errors of + [MissingRequired problem] -> problem ^. #key @?= passwordKey + _ -> fail "expected one missing-required error" + Right _ -> fail "expected the required setting to be absent" + optionalValue <- expectAnswer (resolve defaultResolveOptions [input] (optional passwordSetting)) + optionalValue @?= Nothing, + testCase "invalid UTF-8 is categorized without retaining bytes" $ + withSystemTempDirectory "settei-kubernetes" $ \root -> do + atomicWriterFixture root [("password", ByteString.pack [255, 254, 1])] + validated <- expectBindings [fileBinding "password" passwordKey] + problem <- expectSingleError =<< readMountedDirectorySource defaultOptions validated root + kubernetesErrorCategory problem @?= KubernetesInvalidUtf8 + kubernetesErrorPath problem @?= Just (root "password") + kubernetesErrorMessage problem @?= "file content is not valid UTF-8" + let safeMessage = Text.toLower (kubernetesErrorMessage problem) + assertBool "error message exposed hexadecimal content" (not ("ff" `Text.isInfixOf` safeMessage)) + assertBool "error message exposed decimal content" (not ("255" `Text.isInfixOf` safeMessage)), + testCase "a regular file cannot be used as the mount directory" $ + withSystemTempDirectory "settei-kubernetes" $ \root -> do + let regularFile = root "mount" + ByteString8.writeFile regularFile "value" + validated <- expectBindings [] + problem <- expectSingleError =<< readMountedDirectorySource defaultOptions validated regularFile + kubernetesErrorCategory problem @?= KubernetesNotADirectory + kubernetesErrorPath problem @?= Just regularFile, + testCase "an unreadable entry is an accumulated IO error" $ + withSystemTempDirectory "settei-kubernetes" $ \root -> do + Directory.createDirectory (root "password") + validated <- expectBindings [fileBinding "password" passwordKey] + problem <- expectSingleError =<< readMountedDirectorySource defaultOptions validated root + kubernetesErrorCategory problem @?= KubernetesIoError + kubernetesErrorPath problem @?= Just (root "password"), + testCase "a dangling visible symlink behaves as an absent file" $ + withSystemTempDirectory "settei-kubernetes" $ \root -> do + Directory.createFileLink ("..data" "missing") (root "broken") + validated <- expectBindings [fileBinding "broken" passwordKey] + input <- expectSource =<< readMountedDirectorySource defaultOptions validated root + case lookupSource passwordKey input of + Right Nothing -> pure () + _ -> fail "expected a dangling symlink to contribute no leaf" + ] + +newlineTests :: TestTree +newlineTests = + testGroup + "trailing newline policy" + [ newlineCase "strips exactly one newline by default" defaultOptions "s3cr3t\n\n" "s3cr3t\n", + newlineCase "preserves a trailing newline when requested" (keepTrailingNewline defaultOptions) "s3cr3t\n" "s3cr3t\n", + newlineCase "leaves text without a newline unchanged" defaultOptions "s3cr3t" "s3cr3t" + ] + +provenanceTests :: TestTree +provenanceTests = + testGroup + "provenance" + [ testCase "retains file location, Kubernetes identity, and caller annotations" $ + withSystemTempDirectory "settei-kubernetes" $ \root -> do + atomicWriterFixture root [("password", ByteString8.pack "s3cr3t")] + validated <- + expectBindings + [ annotateFileBinding + (Map.fromList [("owner", "payments"), ("kubernetes.object-name", "wrong")]) + (fileBinding "password" passwordKey) + ] + input <- expectSource =<< readMountedDirectorySource annotatedOptions validated root + let result = resolve defaultResolveOptions [input] (required passwordSetting) + _ <- expectAnswer result + origin <- case result ^. #report . #nodes . at passwordKey of + Just node -> case node ^. #origin of + Just value -> pure value + Nothing -> fail "expected a chosen origin" + Nothing -> fail "expected the password report node" + origin ^. #kind @?= CustomSource "kubernetes-mounted-directory" + origin ^? #location . _Just . #path @?= Just (Text.pack (root "password")) + origin ^? #location . _Just . #line @?= Just Nothing + origin ^? #location . _Just . #column @?= Just Nothing + origin ^. #annotations . at "kubernetes.object-kind" @?= Just "Secret" + origin ^. #annotations . at "kubernetes.namespace" @?= Just "prod" + origin ^. #annotations . at "kubernetes.object-name" @?= Just "app-credentials" + origin ^. #annotations . at "kubernetes.object-key" @?= Just "password" + origin ^. #annotations . at "owner" @?= Just "payments" + origin ^. #annotations . at "deployment" @?= Just "blue" + assertBool + "rendered report omitted Kubernetes mounted-directory provenance" + ( "kubernetes-mounted-directory source app-secrets from Kubernetes Secret prod/app-credentials key password" + `Text.isInfixOf` renderResolutionText (result ^. #report) + ), + testCase "option and binding accessors expose construction choices" $ do + let bindingValue = annotateFileBinding (Map.singleton "owner" "payments") (fileBinding "password" passwordKey) + options = annotateMountedDirectoryOptions (Map.singleton "deployment" "blue") defaultOptions + fileBindingName bindingValue @?= "password" + fileBindingKey bindingValue @?= passwordKey + fileBindingAnnotations bindingValue @?= Map.singleton "owner" "payments" + mountedDirectoryName options @?= "app-secrets" + mountedDirectoryRef options @?= secretReference + mountedDirectoryAnnotations options @?= Map.singleton "deployment" "blue" + mountedDirectoryKeepsTrailingNewline options @?= False + mountedDirectoryKeepsTrailingNewline (keepTrailingNewline options) @?= True, + testCase "records source-wide identity and per-file modification times" $ + withSystemTempDirectory "settei-kubernetes" $ \root -> do + atomicWriterFixture + root + [ ("password", ByteString8.pack "s3cr3t"), + ("http-host", ByteString8.pack "api.internal") + ] + passwordModified <- expectUtc "2026-07-19T12:00:00Z" + hostModified <- expectUtc "2026-07-19T12:05:00Z" + Directory.setModificationTime (root "password") passwordModified + Directory.setModificationTime (root "http-host") hostModified + let freshnessOptions = + annotateMountedDirectoryOptions + ( Map.fromList + [ ("kubernetes.mount-path", "wrong"), + ("kubernetes.read-at", "wrong") + ] + ) + defaultOptions + validated <- + expectBindings + [ annotateFileBinding + (Map.singleton "kubernetes.file-modified" "wrong") + (fileBinding "password" passwordKey), + fileBinding "http-host" hostKey + ] + input <- expectSource =<< readMountedDirectorySource freshnessOptions validated root + passwordOrigin <- expectOriginAt passwordKey input + hostOrigin <- expectOriginAt hostKey input + + passwordOrigin ^. #annotations . at "kubernetes.mount-path" + @?= Just (Text.pack root) + hostOrigin ^. #annotations . at "kubernetes.mount-path" + @?= Just (Text.pack root) + passwordReadAt <- expectOriginUtc "kubernetes.read-at" passwordOrigin + hostReadAt <- expectOriginUtc "kubernetes.read-at" hostOrigin + passwordReadAt @?= hostReadAt + observedPasswordModified <- + expectOriginUtc "kubernetes.file-modified" passwordOrigin + observedHostModified <- + expectOriginUtc "kubernetes.file-modified" hostOrigin + observedPasswordModified @?= passwordModified + observedHostModified @?= hostModified + assertBool + "per-file modification annotations unexpectedly matched" + (observedPasswordModified /= observedHostModified) + passwordOrigin ^. #annotations . at "kubernetes.object-kind" + @?= Just "Secret" + passwordOrigin ^. #annotations . at "kubernetes.object-name" + @?= Just "app-credentials" + passwordOrigin ^. #annotations . at "kubernetes.object-key" + @?= Just "password" + hostOrigin ^. #annotations . at "kubernetes.object-key" + @?= Just "http-host" + ] + +rendererTests :: TestTree +rendererTests = + testGroup + "error renderers" + [ testCase "renders each binding category exactly" $ do + invalid <- expectOnlyError [fileBinding "a/b" passwordKey] + duplicateName <- expectOnlyError [fileBinding "tls.crt" passwordKey, fileBinding "tls.crt" hostKey] + duplicateTarget <- expectOnlyError [fileBinding "one" passwordKey, fileBinding "two" passwordKey] + overlap <- expectOnlyError [fileBinding "database" databaseKey, fileBinding "password" passwordKey] + renderKubernetesErrorText invalid + @?= "file bindings: file name \"a/b\" contains a path separator or is reserved" + renderKubernetesErrorText duplicateName + @?= "file bindings: file name \"tls.crt\" is bound more than once" + renderKubernetesErrorText duplicateTarget + @?= "file bindings: target key database.password is bound more than once" + renderKubernetesErrorText overlap + @?= "file bindings: target keys database and database.password overlap", + testCase "renders read-time categories with source and path" $ + withSystemTempDirectory "settei-kubernetes" $ \root -> do + let regularFile = root "mount" + ByteString8.writeFile regularFile "value" + validatedEmpty <- expectBindings [] + notDirectory <- expectSingleError =<< readMountedDirectorySource defaultOptions validatedEmpty regularFile + renderKubernetesErrorText notDirectory + @?= Text.pack ("app-secrets (" <> regularFile <> "): mounted path is not a directory") + + Directory.createDirectory (root "unreadable") + validatedIo <- expectBindings [fileBinding "unreadable" passwordKey] + ioProblem <- expectSingleError =<< readMountedDirectorySource defaultOptions validatedIo root + renderKubernetesErrorText ioProblem + @?= Text.pack ("app-secrets (" <> root "unreadable" <> "): ") + <> kubernetesErrorMessage ioProblem + + withSystemTempDirectory "settei-kubernetes-utf8" $ \utf8Root -> do + atomicWriterFixture utf8Root [("password", ByteString.pack [255])] + validatedUtf8 <- expectBindings [fileBinding "password" passwordKey] + invalidUtf8 <- expectSingleError =<< readMountedDirectorySource defaultOptions validatedUtf8 utf8Root + renderKubernetesErrorText invalidUtf8 + @?= Text.pack ("app-secrets (" <> utf8Root "password" <> "): file content is not valid UTF-8"), + testCase "plural renderer emits one line per problem" $ do + errors <- + expectBindingErrors + [fileBinding "same" passwordKey, fileBinding "same" passwordKey] + renderKubernetesErrorsText errors + @?= Text.unlines + [ "file bindings: file name \"same\" is bound more than once", + "file bindings: target key database.password is bound more than once" + ] + ] + +atomicWriterFixture :: FilePath -> [(FilePath, ByteString)] -> IO () +atomicWriterFixture root entries = do + let payloadName = "..2026_07_19_12_00_00.123" + payload = root payloadName + Directory.createDirectory payload + mapM_ (\(name, bytes) -> ByteString.writeFile (payload name) bytes) entries + Directory.createDirectoryLink payloadName (root "..data") + mapM_ (\(name, _) -> Directory.createFileLink ("..data" name) (root name)) entries + +invalidNameTest :: Text -> String -> TestTree +invalidNameTest fileName label = + testCase label $ do + errors <- expectBindingErrors [fileBinding fileName passwordKey] + categories errors @?= [KubernetesInvalidFileName] + +newlineCase :: String -> MountedDirectoryOptions -> ByteString -> Text -> TestTree +newlineCase label options bytes expected = + testCase label $ + withSystemTempDirectory "settei-kubernetes" $ \root -> do + atomicWriterFixture root [("password", bytes)] + validated <- expectBindings [fileBinding "password" passwordKey] + input <- expectSource =<< readMountedDirectorySource options validated root + value <- expectAnswer (resolve defaultResolveOptions [input] (required passwordSetting)) + value @?= expected + +expectBindings :: [FileBinding] -> IO FileBindings +expectBindings values = case fileBindings values of + Left errors -> fail (Text.unpack (renderKubernetesErrorsText errors)) + Right validated -> pure validated + +expectBindingErrors :: [FileBinding] -> IO (NonEmpty KubernetesSourceError) +expectBindingErrors values = case fileBindings values of + Left errors -> pure errors + Right _ -> fail "expected invalid file bindings" + +expectOnlyError :: [FileBinding] -> IO KubernetesSourceError +expectOnlyError values = do + errors <- expectBindingErrors values + case NonEmpty.toList errors of + [problem] -> pure problem + _ -> fail "expected exactly one binding error" + +expectSource :: Either (NonEmpty KubernetesSourceError) Source -> IO Source +expectSource = \case + Left errors -> fail (Text.unpack (renderKubernetesErrorsText errors)) + Right input -> pure input + +expectSingleError :: Either (NonEmpty KubernetesSourceError) Source -> IO KubernetesSourceError +expectSingleError = \case + Left errors -> case NonEmpty.toList errors of + [problem] -> pure problem + _ -> fail "expected exactly one source error" + Right _ -> fail "expected source construction to fail" + +expectAnswer :: ResolveResult a -> IO a +expectAnswer result = case result ^. #answer of + Left _ -> fail "expected configuration resolution to succeed" + Right value -> pure value + +expectOriginAt :: Key -> Source -> IO Origin +expectOriginAt target input = case lookupSource target input of + Right (Just found) -> pure (found ^. to candidateOrigin) + _ -> fail "expected a candidate origin at the bound key" + +expectOriginUtc :: Text -> Origin -> IO UTCTime +expectOriginUtc annotationName origin = case origin ^. #annotations . at annotationName of + Nothing -> fail ("missing annotation " <> Text.unpack annotationName) + Just rendered -> expectUtc rendered + +expectUtc :: Text -> IO UTCTime +expectUtc rendered = + maybe + (fail ("invalid UTC timestamp " <> Text.unpack rendered)) + pure + (parseUtc rendered) + +parseUtc :: Text -> Maybe UTCTime +parseUtc = + parseTimeM True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" . Text.unpack + +expectDerivedBindings :: Either (NonEmpty EnvError) Bindings -> IO Bindings +expectDerivedBindings = either (fail . Text.unpack . renderEnvErrorsText) pure + +expectEnvBindings :: [EnvBinding] -> IO Bindings +expectEnvBindings = expectDerivedBindings . bindings + +assertEnvLeftContains :: (EnvError -> Bool) -> Either (NonEmpty EnvError) a -> IO () +assertEnvLeftContains predicate = \case + Left errors -> + assertBool + "expected matching environment binding validation error" + (any predicate (NonEmpty.toList errors)) + Right _ -> fail "expected environment binding validation to fail" + +isDuplicateEnvName :: EnvError -> Bool +isDuplicateEnvName (DuplicateEnvironmentName _) = True +isDuplicateEnvName _ = False + +isConflictingEnvKey :: EnvError -> Bool +isConflictingEnvKey (ConflictingTargetKeys _ _) = True +isConflictingEnvKey _ = False + +categories :: NonEmpty KubernetesSourceError -> [KubernetesErrorCategory] +categories = fmap kubernetesErrorCategory . NonEmpty.toList + +defaultOptions :: MountedDirectoryOptions +defaultOptions = mountedDirectoryOptions "app-secrets" secretReference + +annotatedOptions :: MountedDirectoryOptions +annotatedOptions = + annotateMountedDirectoryOptions (Map.singleton "deployment" "blue") defaultOptions + +secretReference :: KubernetesRef +secretReference = kubernetesRef SecretObject (Just "prod") "app-credentials" (Just "ignored") + +serviceConfig :: Config (Text, Text) +serviceConfig = (,) <$> required passwordSetting <*> required hostSetting + +passwordSetting :: Setting Text +passwordSetting = secretSetting passwordKey "Database password" textDecoder + +hostSetting :: Setting Text +hostSetting = publicSetting hostKey "HTTP host" textDecoder + +databaseKey :: Key +databaseKey = unsafeKey "database" + +passwordKey :: Key +passwordKey = unsafeKey "database.password" + +hostKey :: Key +hostKey = unsafeKey "service.http.host" + +manualKey :: Key +manualKey = unsafeKey "manual.value" + +unsafeKey :: Text -> Key +unsafeKey value = case parseKey value of + Left problem -> error (show problem) + Right key -> key