settei-dhall (empty) → 0.1.0.0
raw patch · 20 files changed
+1214/−0 lines, 20 filesdep +aesondep +basedep +containers
Dependencies added: aeson, base, containers, dhall, dhall-json, directory, filepath, generic-lens, microlens, scientific, settei, settei-dhall, tasty, tasty-hunit, temporary, text, transformers
Files
- CHANGELOG.md +8/−0
- LICENSE +28/−0
- settei-dhall.cabal +99/−0
- src/Settei/Dhall.hs +522/−0
- test/Main.hs +7/−0
- test/ProductionMain.hs +16/−0
- test/Settei/DhallPrototypeTest.hs +198/−0
- test/Settei/DhallTest.hs +302/−0
- test/fixtures/characterization/README.md +8/−0
- test/fixtures/characterization/direct.dhall +1/−0
- test/fixtures/characterization/list.dhall +1/−0
- test/fixtures/characterization/local/application.dhall +3/−0
- test/fixtures/characterization/local/database.dhall +1/−0
- test/fixtures/characterization/local/service.dhall +3/−0
- test/fixtures/characterization/nested.dhall +1/−0
- test/fixtures/characterization/optional.dhall +1/−0
- test/fixtures/characterization/parse-error.dhall +1/−0
- test/fixtures/characterization/schema-default.dhall +12/−0
- test/fixtures/characterization/type-error.dhall +1/−0
- test/fixtures/characterization/unsupported-bytes.dhall +1/−0
+ CHANGELOG.md view
@@ -0,0 +1,8 @@+# Changelog for settei-dhall++## 0.1.0.0 — 2026-07-18++- Initial experimental release.+- Add typed Dhall-to-Settei translation with NoImports and LocalImportsWithin policies.+- Retain root and transitive import-closure provenance without claiming unavailable+ leaf-level import attribution.
+ 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-dhall.cabal view
@@ -0,0 +1,99 @@+cabal-version: 3.8+name: settei-dhall+version: 0.1.0.0+synopsis: Dhall sources for Settei+description:+ Evaluate typed Dhall expressions into provenance-aware Settei sources with+ explicit, enforceable import policies.++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+extra-source-files: test/fixtures/characterization/README.md+data-files:+ test/fixtures/characterization/*.dhall+ test/fixtures/characterization/local/*.dhall++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.Dhall+ build-depends:+ , aeson >=2.2 && <2.3+ , base >=4.21 && <5+ , containers >=0.6.8 && <0.8+ , dhall >=1.42.3 && <1.43+ , dhall-json ==1.7.12+ , directory >=1.3.8 && <1.4+ , filepath >=1.5.4 && <1.6+ , generic-lens >=2.2 && <2.4+ , scientific >=0.3.7 && <0.4+ , settei ==0.1.0.0+ , text >=2.1 && <2.2+ , transformers >=0.6.1 && <0.7++test-suite settei-dhall-prototype-tests+ import: common+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ other-modules: Settei.DhallPrototypeTest+ build-depends:+ , base >=4.21 && <5+ , containers >=0.6.8 && <0.8+ , dhall >=1.42.3 && <1.43+ , directory >=1.3.8 && <1.4+ , filepath >=1.5.4 && <1.6+ , microlens >=0.4.14 && <0.6+ , tasty >=1.5 && <1.6+ , tasty-hunit >=0.10.2 && <0.11+ , temporary >=1.3 && <1.4+ , text >=2.1 && <2.2+ , transformers >=0.6.1 && <0.7++test-suite settei-dhall-tests+ import: common+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: ProductionMain.hs+ other-modules:+ Paths_settei_dhall+ Settei.DhallTest++ autogen-modules: Paths_settei_dhall+ build-depends:+ , base >=4.21 && <5+ , containers >=0.6.8 && <0.8+ , dhall >=1.42.3 && <1.43+ , directory >=1.3.8 && <1.4+ , filepath >=1.5.4 && <1.6+ , generic-lens >=2.2 && <2.4+ , microlens >=0.4.14 && <0.6+ , settei ==0.1.0.0+ , settei-dhall ==0.1.0.0+ , tasty >=1.5 && <1.6+ , tasty-hunit >=0.10.2 && <0.11+ , temporary >=1.3 && <1.4+ , text >=2.1 && <2.2+ , transformers >=0.6.1 && <0.7
+ src/Settei/Dhall.hs view
@@ -0,0 +1,522 @@+{-# LANGUAGE ImportQualifiedPost #-}++-- |+-- Module: Settei.Dhall+-- Description: Typed Dhall sources with enforceable import policies.+module Settei.Dhall+ ( DhallErrorCategory (..),+ DhallImport,+ DhallImportMode (..),+ DhallImportPolicy (..),+ DhallLoadedSource,+ DhallRoot (..),+ DhallSourceError,+ DhallSourceOptions,+ annotateDhallSourceOptions,+ dhallErrorCategory,+ dhallErrorMessage,+ dhallErrorName,+ dhallErrorPath,+ dhallExpression,+ dhallImportMode,+ dhallImportPath,+ dhallImportSemanticHash,+ dhallLoadedImports,+ dhallLoadedSource,+ dhallSourceAnnotations,+ dhallSourceImportPolicy,+ dhallSourceName,+ dhallSourceOptions,+ loadDhallSource,+ loadDhallSourceDetailed,+ )+where++import Control.Exception (AsyncException, IOException, SomeException, fromException, throwIO, try)+import Control.Monad (foldM, unless, when)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)+import Control.Monad.Trans.State.Strict qualified as State+import Data.Aeson qualified as Aeson+import Data.Aeson.Key qualified as AesonKey+import Data.Aeson.KeyMap qualified as AesonKeyMap+import Data.Bifunctor (first)+import Data.Foldable qualified as Foldable+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 Data.Text.IO qualified as TextIO+import Data.Void (Void)+import Dhall.Core qualified as Dhall+import Dhall.Import qualified as UpstreamImport+import Dhall.JSON qualified as DhallJSON+import Dhall.Parser qualified as DhallParser+import Dhall.TypeCheck qualified as DhallTypeCheck+import Settei+import Settei.Prelude+import System.Directory qualified as Directory+import System.FilePath qualified as FilePath++-- | Import capabilities available to version-one callers.+--+-- 'NoImports' rejects every embedded import. 'LocalImportsWithin' accepts only+-- canonical local paths contained by the named directory. Environment, remote,+-- missing, and alternative imports are rejected before upstream evaluation.+data DhallImportPolicy+ = NoImports+ | LocalImportsWithin !FilePath+ deriving stock (Generic, Eq, Show)++-- | A Dhall root supplied as labeled expression text or a file path.+--+-- No 'Show' instance is provided because expression text can contain secrets.+data DhallRoot+ = DhallExpression+ { name :: !Text,+ text :: !Text+ }+ | DhallFile !FilePath+ deriving stock (Generic, Eq)++-- | Construct a labeled in-memory expression without exposing its text through 'Show'.+dhallExpression :: Text -> Text -> DhallRoot+dhallExpression name text = DhallExpression {name, text}++-- | Source naming, policy, and trusted secret-safe annotations.+data DhallSourceOptions = DhallSourceOptions+ { name :: !Text,+ importPolicy :: !DhallImportPolicy,+ annotations :: !(Map Text Text)+ }+ deriving stock (Generic, Eq)++-- | How a local import is interpreted by Dhall.+data DhallImportMode+ = DhallCodeImport+ | DhallRawTextImport+ | DhallRawBytesImport+ | DhallLocationImport+ deriving stock (Generic, Eq, Ord, Show)++-- | One substantiated local import in a cache-independent transitive closure.+data DhallImport = DhallImport+ { path :: !FilePath,+ mode :: !DhallImportMode,+ semanticHash :: !(Maybe Text)+ }+ deriving stock (Generic, Eq, Ord, Show)++-- | A translated source together with its structured import closure.+data DhallLoadedSource = DhallLoadedSource+ { value :: !Source,+ imports :: ![DhallImport]+ }+ deriving stock (Generic)++-- | Stable phases of Dhall adapter failure.+data DhallErrorCategory+ = DhallIoError+ | DhallParseError+ | DhallImportPolicyError+ | DhallImportError+ | DhallTypeError+ | DhallConversionError+ | DhallInvalidKey+ | DhallTopLevelType+ deriving stock (Generic, Eq, Ord, Show)++-- | A secret-safe Dhall input failure.+--+-- The error retains only a stable category, source name, optional safe path,+-- and fixed message. It never retains source text or an upstream exception.+data DhallSourceError = DhallSourceError+ { category :: !DhallErrorCategory,+ name :: !Text,+ path :: !(Maybe FilePath),+ message :: !Text+ }+ deriving stock (Generic, Eq, Show)++data PreparedRoot = PreparedRoot+ { label :: !Text,+ baseDirectory :: !FilePath,+ filePath :: !(Maybe FilePath),+ input :: !Text+ }+ deriving stock (Generic)++data PreflightFailure = PreflightFailure+ { category :: !DhallErrorCategory,+ path :: !(Maybe FilePath),+ message :: !Text+ }+ deriving stock (Generic)++-- | Construct source options with no annotations.+dhallSourceOptions :: Text -> DhallImportPolicy -> DhallSourceOptions+dhallSourceOptions name importPolicy =+ DhallSourceOptions {name, importPolicy, annotations = Map.empty}++-- | Add trusted, secret-safe annotations. Dhall's reserved provenance keys win collisions.+annotateDhallSourceOptions :: Map Text Text -> DhallSourceOptions -> DhallSourceOptions+annotateDhallSourceOptions annotations options = options & #annotations %~ (annotations <>)++-- | Return the source's report name.+dhallSourceName :: DhallSourceOptions -> Text+dhallSourceName options = options ^. #name++-- | Return the enforced import policy.+dhallSourceImportPolicy :: DhallSourceOptions -> DhallImportPolicy+dhallSourceImportPolicy options = options ^. #importPolicy++-- | Return caller-supplied annotations.+dhallSourceAnnotations :: DhallSourceOptions -> Map Text Text+dhallSourceAnnotations options = options ^. #annotations++-- | Return a stable error category.+dhallErrorCategory :: DhallSourceError -> DhallErrorCategory+dhallErrorCategory problem = problem ^. #category++-- | Return the source name associated with an error.+dhallErrorName :: DhallSourceError -> Text+dhallErrorName problem = problem ^. #name++-- | Return a safe relevant path when one is known.+dhallErrorPath :: DhallSourceError -> Maybe FilePath+dhallErrorPath problem = problem ^. #path++-- | Return a fixed secret-safe error message.+dhallErrorMessage :: DhallSourceError -> Text+dhallErrorMessage problem = problem ^. #message++-- | Return a local import's canonical path.+dhallImportPath :: DhallImport -> FilePath+dhallImportPath imported = imported ^. #path++-- | Return how a local import was interpreted.+dhallImportMode :: DhallImport -> DhallImportMode+dhallImportMode imported = imported ^. #mode++-- | Return the import's optional semantic integrity hash.+dhallImportSemanticHash :: DhallImport -> Maybe Text+dhallImportSemanticHash imported = imported ^. #semanticHash++-- | Extract the Settei source from a detailed load result.+dhallLoadedSource :: DhallLoadedSource -> Source+dhallLoadedSource loaded = loaded ^. #value++-- | Return the sorted, de-duplicated transitive local import closure.+dhallLoadedImports :: DhallLoadedSource -> [DhallImport]+dhallLoadedImports loaded = loaded ^. #imports++-- | Evaluate one Dhall root into a Settei source.+loadDhallSource ::+ DhallSourceOptions ->+ DhallRoot ->+ IO (Either (NonEmpty DhallSourceError) Source)+loadDhallSource options root =+ fmap (fmap dhallLoadedSource) (loadDhallSourceDetailed options root)++-- | Evaluate one Dhall root and retain its structured local import closure.+--+-- Evaluation follows the registered @dhall-json@ path: parse, resolve imports,+-- type-check, normalize, convert JSON-compatible values, and translate directly+-- to 'RawValue'. Rendered Dhall or JSON text is never used as an intermediate.+loadDhallSourceDetailed ::+ DhallSourceOptions ->+ DhallRoot ->+ IO (Either (NonEmpty DhallSourceError) DhallLoadedSource)+loadDhallSourceDetailed options root = do+ preparedResult <- prepareRoot options root+ case preparedResult of+ Left problem -> pure (Left (NonEmpty.singleton problem))+ Right prepared ->+ case DhallParser.exprFromText (Text.unpack (prepared ^. #label)) (prepared ^. #input) of+ Left _ -> pure (failure options DhallParseError (prepared ^. #filePath) "invalid Dhall syntax")+ Right expression -> do+ resolvedResult <- resolveExpression options prepared expression+ pure $ do+ (resolved, imports) <- resolvedResult+ case DhallTypeCheck.typeOf resolved of+ Left _ -> failure options DhallTypeError (prepared ^. #filePath) "Dhall expression does not type-check"+ Right _ -> pure ()+ jsonValue <- firstOne options (prepared ^. #filePath) (convertExpression resolved)+ rawValue <- firstOne options (prepared ^. #filePath) (translateRoot jsonValue)+ let provenance = provenanceAnnotations options prepared imports+ sourceValue =+ locateSource+ (const (Just (SourceLocation (prepared ^. #label) Nothing Nothing)))+ ( annotateSource+ (provenance <> options ^. #annotations)+ (source (options ^. #name) (FileSource "Dhall") rawValue)+ )+ pure DhallLoadedSource {value = sourceValue, imports}++prepareRoot :: DhallSourceOptions -> DhallRoot -> IO (Either DhallSourceError PreparedRoot)+prepareRoot options = \case+ DhallExpression name text -> do+ baseResult <- policyBaseDirectory options+ pure+ ( fmap+ (\baseDirectory -> PreparedRoot {label = name, baseDirectory, filePath = Nothing, input = text})+ baseResult+ )+ DhallFile requestedPath -> do+ absoluteResult <- try @IOException (Directory.makeAbsolute requestedPath >>= Directory.canonicalizePath)+ case absoluteResult of+ Left _ -> pure (Left (singleError options DhallIoError (Just requestedPath) "cannot resolve Dhall root path"))+ Right canonicalPath -> do+ permitted <- rootPermitted options canonicalPath+ if not permitted+ then pure (Left (singleError options DhallImportPolicyError (Just canonicalPath) "Dhall root is outside the allowed directory"))+ else do+ inputResult <- try @IOException (TextIO.readFile canonicalPath)+ pure $ case inputResult of+ Left _ -> Left (singleError options DhallIoError (Just canonicalPath) "cannot read Dhall root file")+ Right input ->+ Right+ PreparedRoot+ { label = Text.pack canonicalPath,+ baseDirectory = FilePath.takeDirectory canonicalPath,+ filePath = Just canonicalPath,+ input+ }++policyBaseDirectory :: DhallSourceOptions -> IO (Either DhallSourceError FilePath)+policyBaseDirectory options = case options ^. #importPolicy of+ NoImports -> Right <$> Directory.getCurrentDirectory+ LocalImportsWithin requestedRoot -> do+ result <- try @IOException (Directory.makeAbsolute requestedRoot >>= Directory.canonicalizePath)+ pure $ case result of+ Left _ -> Left (singleError options DhallImportPolicyError (Just requestedRoot) "cannot resolve allowed import directory")+ Right canonicalRoot -> Right canonicalRoot++rootPermitted :: DhallSourceOptions -> FilePath -> IO Bool+rootPermitted options canonicalPath = case options ^. #importPolicy of+ NoImports -> pure True+ LocalImportsWithin requestedRoot -> do+ rootResult <- try @IOException (Directory.makeAbsolute requestedRoot >>= Directory.canonicalizePath)+ pure (either (const False) (`isWithin` canonicalPath) rootResult)++resolveExpression ::+ DhallSourceOptions ->+ PreparedRoot ->+ Dhall.Expr DhallParser.Src Dhall.Import ->+ IO (Either (NonEmpty DhallSourceError) (Dhall.Expr DhallParser.Src Void, [DhallImport]))+resolveExpression options prepared expression = case options ^. #importPolicy of+ NoImports -> do+ result <- try @UpstreamImport.ImportResolutionDisabled (UpstreamImport.assertNoImports expression)+ pure $ case result of+ Left _ -> failure options DhallImportPolicyError (prepared ^. #filePath) "imports are disabled"+ Right resolved -> Right (resolved, [])+ LocalImportsWithin requestedRoot -> do+ canonicalRootResult <- try @IOException (Directory.makeAbsolute requestedRoot >>= Directory.canonicalizePath)+ case canonicalRootResult of+ Left _ -> pure (failure options DhallImportPolicyError (Just requestedRoot) "cannot resolve allowed import directory")+ Right canonicalRoot -> do+ preflightResult <- preflightLocal canonicalRoot (prepared ^. #baseDirectory) expression+ case preflightResult of+ Left problem ->+ pure+ ( failure+ options+ (problem ^. #category)+ (problem ^. #path)+ (problem ^. #message)+ )+ Right imports -> do+ let status =+ (UpstreamImport.emptyStatus (prepared ^. #baseDirectory))+ { UpstreamImport._semanticCacheMode = UpstreamImport.IgnoreSemanticCache+ }+ loaded <- try @SomeException (State.runStateT (UpstreamImport.loadWith expression) status)+ case loaded of+ Left exception -> case fromException exception :: Maybe AsyncException of+ Just asynchronous -> throwIO asynchronous+ Nothing -> pure (failure options DhallImportError (prepared ^. #filePath) "Dhall import resolution failed")+ Right (resolved, _) -> pure (Right (resolved, imports))++preflightLocal ::+ FilePath ->+ FilePath ->+ Dhall.Expr DhallParser.Src Dhall.Import ->+ IO (Either PreflightFailure [DhallImport])+preflightLocal canonicalRoot baseDirectory expression =+ fmap+ (fmap (Set.toAscList . snd))+ (runExceptT (visitExpression canonicalRoot Set.empty Set.empty baseDirectory expression))++visitExpression ::+ FilePath ->+ Set FilePath ->+ Set DhallImport ->+ FilePath ->+ Dhall.Expr DhallParser.Src Dhall.Import ->+ ExceptT PreflightFailure IO (Set FilePath, Set DhallImport)+visitExpression allowedRoot visited observed baseDirectory expression = do+ when (hasImportAlternative expression) (throwPreflight DhallImportPolicyError Nothing "import alternatives are not allowed")+ foldM+ (visitImport allowedRoot baseDirectory)+ (visited, observed)+ (Foldable.toList expression)++visitImport ::+ FilePath ->+ FilePath ->+ (Set FilePath, Set DhallImport) ->+ Dhall.Import ->+ ExceptT PreflightFailure IO (Set FilePath, Set DhallImport)+visitImport allowedRoot baseDirectory (visited, observed) importValue =+ case Dhall.importType (Dhall.importHashed importValue) of+ Dhall.Local {} -> do+ requestedResult <- liftIO (try @IOException (resolveLocalPath baseDirectory importValue))+ requestedPath <- case requestedResult of+ Left _ -> throwPreflight DhallImportError Nothing "cannot resolve local import path"+ Right value -> pure value+ exists <- liftIO (Directory.doesFileExist requestedPath)+ unless exists (throwPreflight DhallImportError (Just requestedPath) "local import does not exist")+ canonicalResult <- liftIO (try @IOException (Directory.canonicalizePath requestedPath))+ canonical <- case canonicalResult of+ Left _ -> throwPreflight DhallImportError (Just requestedPath) "cannot canonicalize local import"+ Right value -> pure value+ unless (isWithin allowedRoot canonical) (throwPreflight DhallImportPolicyError (Just canonical) "local import is outside the allowed directory")+ let descriptor =+ DhallImport+ { path = canonical,+ mode = importMode (Dhall.importMode importValue),+ semanticHash = fmap (Text.pack . show) (Dhall.hash (Dhall.importHashed importValue))+ }+ observedWithImport = Set.insert descriptor observed+ if Dhall.importMode importValue /= Dhall.Code || Set.member canonical visited+ then pure (visited, observedWithImport)+ else do+ inputResult <- liftIO (try @IOException (TextIO.readFile canonical))+ input <- case inputResult of+ Left _ -> throwPreflight DhallImportError (Just canonical) "cannot read local import"+ Right value -> pure value+ imported <- case DhallParser.exprFromText canonical input of+ Left _ -> throwPreflight DhallParseError (Just canonical) "invalid syntax in local import"+ Right value -> pure value+ visitExpression+ allowedRoot+ (Set.insert canonical visited)+ observedWithImport+ (FilePath.takeDirectory canonical)+ imported+ Dhall.Env _ -> throwPreflight DhallImportPolicyError Nothing "environment imports are not allowed"+ Dhall.Remote _ -> throwPreflight DhallImportPolicyError Nothing "remote imports are not allowed"+ Dhall.Missing -> throwPreflight DhallImportPolicyError Nothing "missing imports are not allowed"++resolveLocalPath :: FilePath -> Dhall.Import -> IO FilePath+resolveLocalPath baseDirectory importValue = do+ canonicalBase <- Directory.canonicalizePath baseDirectory+ let status = UpstreamImport.emptyStatus canonicalBase+ parent = NonEmpty.head (UpstreamImport._stack status)+ chained <- State.evalStateT (UpstreamImport.chainImport parent importValue) status+ case Dhall.importType (Dhall.importHashed (UpstreamImport.chainedImport chained)) of+ Dhall.Local prefix file -> UpstreamImport.localToPath prefix file+ _ -> error "local import did not remain local after chaining"++hasImportAlternative :: Dhall.Expr s a -> Bool+hasImportAlternative Dhall.ImportAlt {} = True+hasImportAlternative expression = anyOf Dhall.subExpressions hasImportAlternative expression++importMode :: Dhall.ImportMode -> DhallImportMode+importMode = \case+ Dhall.Code -> DhallCodeImport+ Dhall.RawText -> DhallRawTextImport+ Dhall.RawBytes -> DhallRawBytesImport+ Dhall.Location -> DhallLocationImport++convertExpression :: Dhall.Expr s Void -> Either (DhallErrorCategory, Text) Aeson.Value+convertExpression resolved = do+ finite <-+ first+ (const (DhallConversionError, "Dhall value contains a non-finite Double"))+ ( DhallJSON.handleSpecialDoubles+ DhallJSON.ForbidWithinJSON+ (DhallJSON.convertToHomogeneousMaps DhallJSON.NoConversion resolved)+ )+ first+ (const (DhallConversionError, "Dhall value is not JSON-compatible"))+ (DhallJSON.dhallToJSON finite)++translateRoot :: Aeson.Value -> Either (DhallErrorCategory, Text) RawValue+translateRoot value = case value of+ Aeson.Object _ -> translateValue [] value+ _ -> Left (DhallTopLevelType, "top-level Dhall value must be a record")++translateValue :: [Text] -> Aeson.Value -> Either (DhallErrorCategory, Text) RawValue+translateValue path = \case+ Aeson.Null -> Right RawNull+ Aeson.String value -> Right (RawText value)+ Aeson.Bool value -> Right (RawBool value)+ Aeson.Number value -> Right (RawNumber (toRational value))+ Aeson.Array values -> RawArray <$> traverse (translateValue path) (Foldable.toList values)+ Aeson.Object object -> do+ fields <- traverse translateField (AesonKeyMap.toAscList object)+ Right (RawObject (Map.fromAscList fields))+ where+ translateField (rawKey, value) = do+ let key = AesonKey.toText rawKey+ case mkKey (key NonEmpty.:| []) of+ Left _ -> Left (DhallInvalidKey, "Dhall record field is not a valid Settei key segment")+ Right _ -> pure ()+ translated <- translateValue (path <> [key]) value+ pure (key, translated)++provenanceAnnotations :: DhallSourceOptions -> PreparedRoot -> [DhallImport] -> Map Text Text+provenanceAnnotations options prepared imports =+ Map.fromList+ [ ("dhall.root", prepared ^. #label),+ ("dhall.import-policy", policyName (options ^. #importPolicy)),+ ("dhall.import-count", Text.pack (show (length imports))),+ ("dhall.provenance-precision", "root-and-import-closure; leaf-level import attribution unavailable after normalization")+ ]+ <> Map.fromList (concatMap importAnnotations (zip [0 :: Int ..] imports))++importAnnotations :: (Int, DhallImport) -> [(Text, Text)]+importAnnotations (position, imported) =+ let prefix = "dhall.import." <> Text.pack (show position) <> "."+ in [ (prefix <> "kind", "local"),+ (prefix <> "path", Text.pack (imported ^. #path)),+ (prefix <> "mode", importModeName (imported ^. #mode))+ ]+ <> maybe [] (pure . (prefix <> "semantic-hash",)) (imported ^. #semanticHash)++policyName :: DhallImportPolicy -> Text+policyName NoImports = "no-imports"+policyName (LocalImportsWithin _) = "local-imports-within"++importModeName :: DhallImportMode -> Text+importModeName DhallCodeImport = "code"+importModeName DhallRawTextImport = "raw-text"+importModeName DhallRawBytesImport = "raw-bytes"+importModeName DhallLocationImport = "location"++throwPreflight :: DhallErrorCategory -> Maybe FilePath -> Text -> ExceptT PreflightFailure IO a+throwPreflight category path message = throwE PreflightFailure {category, path, message}++isWithin :: FilePath -> FilePath -> Bool+isWithin root pathCandidate =+ let relative = FilePath.makeRelative root pathCandidate+ in not (FilePath.isAbsolute relative)+ && case FilePath.splitDirectories relative of+ ".." : _ -> False+ _ -> True++failure :: DhallSourceOptions -> DhallErrorCategory -> Maybe FilePath -> Text -> Either (NonEmpty DhallSourceError) a+failure options category path message = Left (NonEmpty.singleton (singleError options category path message))++singleError :: DhallSourceOptions -> DhallErrorCategory -> Maybe FilePath -> Text -> DhallSourceError+singleError options category path message =+ DhallSourceError {category, name = options ^. #name, path, message}++firstOne ::+ DhallSourceOptions ->+ Maybe FilePath ->+ Either (DhallErrorCategory, Text) a ->+ Either (NonEmpty DhallSourceError) a+firstOne options path = first (\(category, message) -> NonEmpty.singleton (singleError options category path message))
+ test/Main.hs view
@@ -0,0 +1,7 @@+module Main (main) where++import Settei.DhallPrototypeTest qualified as DhallPrototypeTest+import Test.Tasty (defaultMain)++main :: IO ()+main = defaultMain DhallPrototypeTest.tests
+ test/ProductionMain.hs view
@@ -0,0 +1,16 @@+module Main (main) where++import Control.Exception (bracket_)+import Settei.DhallTest qualified as DhallTest+import System.Environment (lookupEnv, setEnv, unsetEnv)+import System.IO.Temp (withSystemTempDirectory)+import Test.Tasty (defaultMain)++main :: IO ()+main =+ withSystemTempDirectory "settei-dhall-cache" $ \cacheDirectory -> do+ previous <- lookupEnv "XDG_CACHE_HOME"+ bracket_+ (setEnv "XDG_CACHE_HOME" cacheDirectory)+ (maybe (unsetEnv "XDG_CACHE_HOME") (setEnv "XDG_CACHE_HOME") previous)+ (defaultMain DhallTest.tests)
+ test/Settei/DhallPrototypeTest.hs view
@@ -0,0 +1,198 @@+{-# LANGUAGE ImportQualifiedPost #-}++module Settei.DhallPrototypeTest (tests) where++import Control.Exception (SomeException, try)+import Control.Monad (foldM, unless, when)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)+import Control.Monad.Trans.State.Strict qualified as State+import Data.Foldable qualified as Foldable+import Data.List.NonEmpty qualified as NonEmpty+import Data.Set (Set)+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.IO qualified as TextIO+import Dhall.Core qualified as Dhall+import Dhall.Import qualified as DhallImport+import Dhall.Parser qualified as DhallParser+import Lens.Micro qualified as Lens+import System.Directory qualified as Directory+import System.FilePath qualified as FilePath+import System.IO.Temp (withSystemTempDirectory)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++data PrototypeFailure+ = ImportAlternative+ | DisallowedImport+ | OutsideRoot+ | MissingLocalFile+ | InvalidImportedFile+ deriving stock (Eq, Show)++data ObservedLocalImport = ObservedLocalImport+ { path :: !FilePath,+ mode :: !Dhall.ImportMode,+ semanticHash :: !(Maybe Text)+ }+ deriving stock (Eq, Ord, Show)++tests :: TestTree+tests =+ testGroup+ "Dhall import-policy prototype"+ [ testCase "NoImports rejects before loading" $ do+ expression <- parse "no-imports" "./not-created.dhall"+ rejected <- try @SomeException (DhallImport.assertNoImports expression)+ assertBool "assertNoImports unexpectedly accepted an import" (either (const True) (const False) rejected),+ testCase "local-only records a transitive import closure" $+ withSystemTempDirectory "settei-dhall-prototype" $ \root -> do+ let first = root FilePath.</> "first.dhall"+ second = root FilePath.</> "second.dhall"+ TextIO.writeFile first "./second.dhall"+ TextIO.writeFile second "{ service = { port = 8080 } }"+ expression <- parse "root" "./first.dhall"+ result <- preflightLocal root root expression+ case result of+ Left problem -> assertFailure (show problem)+ Right imports -> fmap FilePath.takeFileName imports @?= ["first.dhall", "second.dhall"],+ testCase "local-only rejects a parent escape" $+ withSystemTempDirectory "settei-dhall-prototype" $ \workspace -> do+ let allowed = workspace FilePath.</> "allowed"+ outside = workspace FilePath.</> "outside.dhall"+ Directory.createDirectory allowed+ TextIO.writeFile outside "{ escaped = True }"+ expression <- parse "root" "../outside.dhall"+ result <- preflightLocal allowed allowed expression+ result @?= Left OutsideRoot,+ testCase "local-only rejects a symlink escape" $+ withSystemTempDirectory "settei-dhall-prototype" $ \workspace -> do+ let allowed = workspace FilePath.</> "allowed"+ outside = workspace FilePath.</> "outside.dhall"+ link = allowed FilePath.</> "linked.dhall"+ Directory.createDirectory allowed+ TextIO.writeFile outside "{ escaped = True }"+ Directory.createFileLink outside link+ expression <- parse "root" "./linked.dhall"+ result <- preflightLocal allowed allowed expression+ result @?= Left OutsideRoot,+ testCase "local-only rejects environment and remote capabilities without using them" $ do+ environment <- parse "environment" "env:SETTEI_DHALL_PROTOTYPE_SECRET"+ remote <- parse "remote" "https://example.com/config.dhall"+ withSystemTempDirectory "settei-dhall-prototype" $ \root -> do+ preflightLocal root root environment >>= (@?= Left DisallowedImport)+ preflightLocal root root remote >>= (@?= Left DisallowedImport),+ testCase "local-only rejects missing and alternative imports" $+ withSystemTempDirectory "settei-dhall-prototype" $ \root -> do+ missing <- parse "missing" "missing"+ alternative <- parse "alternative" "./one.dhall ? ./two.dhall"+ preflightLocal root root missing >>= (@?= Left DisallowedImport)+ preflightLocal root root alternative >>= (@?= Left ImportAlternative),+ testCase "local-only retains a semantic integrity hash structurally" $+ withSystemTempDirectory "settei-dhall-prototype" $ \root -> do+ let imported = root FilePath.</> "hashed.dhall"+ TextIO.writeFile imported "{ value = True }"+ expression <-+ parse+ "hashed"+ "./hashed.dhall sha256:0000000000000000000000000000000000000000000000000000000000000000"+ result <- preflightLocalDetailed root root expression+ case result of+ Left problem -> assertFailure (show problem)+ Right [observed] -> assertBool "semantic hash was discarded" (semanticHash observed /= Nothing)+ Right observed -> assertFailure ("unexpected import closure: " <> show observed)+ ]++parse :: FilePath -> Text -> IO (Dhall.Expr DhallParser.Src Dhall.Import)+parse label input = case DhallParser.exprFromText label input of+ Left problem -> assertFailure (show problem) >> error "unreachable"+ Right expression -> pure expression++preflightLocal :: FilePath -> FilePath -> Dhall.Expr DhallParser.Src Dhall.Import -> IO (Either PrototypeFailure [FilePath])+preflightLocal allowedRoot baseDirectory expression =+ fmap (fmap (fmap path)) (preflightLocalDetailed allowedRoot baseDirectory expression)++preflightLocalDetailed ::+ FilePath ->+ FilePath ->+ Dhall.Expr DhallParser.Src Dhall.Import ->+ IO (Either PrototypeFailure [ObservedLocalImport])+preflightLocalDetailed allowedRoot baseDirectory expression = do+ canonicalRoot <- Directory.canonicalizePath allowedRoot+ fmap+ (fmap (Set.toAscList . snd))+ (runExceptT (visitExpression canonicalRoot Set.empty Set.empty baseDirectory expression))++visitExpression ::+ FilePath ->+ Set FilePath ->+ Set ObservedLocalImport ->+ FilePath ->+ Dhall.Expr DhallParser.Src Dhall.Import ->+ ExceptT PrototypeFailure IO (Set FilePath, Set ObservedLocalImport)+visitExpression allowedRoot visited observed baseDirectory expression = do+ when (hasImportAlternative expression) (throwE ImportAlternative)+ foldM+ (visitImport allowedRoot baseDirectory)+ (visited, observed)+ (Foldable.toList expression)++visitImport ::+ FilePath ->+ FilePath ->+ (Set FilePath, Set ObservedLocalImport) ->+ Dhall.Import ->+ ExceptT PrototypeFailure IO (Set FilePath, Set ObservedLocalImport)+visitImport allowedRoot baseDirectory (visited, observed) importValue =+ case Dhall.importType (Dhall.importHashed importValue) of+ Dhall.Local {} -> do+ candidate <- liftIO (resolveLocalPath baseDirectory importValue)+ exists <- liftIO (Directory.doesFileExist candidate)+ unless exists (throwE MissingLocalFile)+ canonical <- liftIO (Directory.canonicalizePath candidate)+ unless (isWithin allowedRoot canonical) (throwE OutsideRoot)+ let descriptor =+ ObservedLocalImport+ { path = canonical,+ mode = Dhall.importMode importValue,+ semanticHash = fmap (Text.pack . show) (Dhall.hash (Dhall.importHashed importValue))+ }+ observedWithImport = Set.insert descriptor observed+ if Dhall.importMode importValue /= Dhall.Code || Set.member canonical visited+ then pure (visited, observedWithImport)+ else do+ input <- liftIO (TextIO.readFile canonical)+ imported <- case DhallParser.exprFromText canonical input of+ Left _ -> throwE InvalidImportedFile+ Right value -> pure value+ visitExpression+ allowedRoot+ (Set.insert canonical visited)+ observedWithImport+ (FilePath.takeDirectory canonical)+ imported+ _ -> throwE DisallowedImport++resolveLocalPath :: FilePath -> Dhall.Import -> IO FilePath+resolveLocalPath baseDirectory importValue = do+ canonicalBase <- Directory.canonicalizePath baseDirectory+ let status = DhallImport.emptyStatus canonicalBase+ parent = NonEmpty.head (DhallImport._stack status)+ chained <- State.evalStateT (DhallImport.chainImport parent importValue) status+ case Dhall.importType (Dhall.importHashed (DhallImport.chainedImport chained)) of+ Dhall.Local prefix file -> DhallImport.localToPath prefix file+ _ -> error "local import did not remain local after chaining"++hasImportAlternative :: Dhall.Expr s a -> Bool+hasImportAlternative Dhall.ImportAlt {} = True+hasImportAlternative expression = Lens.anyOf Dhall.subExpressions hasImportAlternative expression++isWithin :: FilePath -> FilePath -> Bool+isWithin root candidate =+ let relative = FilePath.makeRelative root candidate+ in not (FilePath.isAbsolute relative)+ && case FilePath.splitDirectories relative of+ ".." : _ -> False+ _ -> True
+ test/Settei/DhallTest.hs view
@@ -0,0 +1,302 @@+{-# LANGUAGE ImportQualifiedPost #-}++module Settei.DhallTest (tests) where++import Data.Foldable (traverse_)+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.Text.IO qualified as TextIO+import Dhall.Core qualified as DhallCore+import Dhall.Import qualified as DhallImport+import Dhall.Parser qualified as DhallParser+import Paths_settei_dhall qualified as Paths+import Settei+import Settei.Dhall+import Settei.Prelude+import System.Directory qualified as Directory+import System.FilePath qualified as FilePath+import System.IO.Temp (withSystemTempDirectory)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+ testGroup+ "Settei.Dhall"+ [ testCase "a typed record becomes a nested source" $ do+ loaded <-+ expectDetailed+ noImportOptions+ ( dhallExpression+ "direct record"+ "{ service = { host = \"api.internal\", port = 8080, enabled = True, tags = [ \"api\", \"public\" ] } }"+ )+ dhallLoadedImports loaded @?= []+ host <- expectCandidate serviceHost (dhallLoadedSource loaded)+ assertRaw (RawText "api.internal") (candidateValue host)+ port <- expectCandidate servicePort (dhallLoadedSource loaded)+ assertRaw (RawNumber 8080) (candidateValue port)+ enabled <- expectCandidate serviceEnabled (dhallLoadedSource loaded)+ assertRaw (RawBool True) (candidateValue enabled)+ tags <- expectCandidate serviceTags (dhallLoadedSource loaded)+ assertRaw (RawArray [RawText "api", RawText "public"]) (candidateValue tags),+ testCase "optional values, unions, and association lists retain the official JSON shape" $ do+ input <-+ expectSource+ noImportOptions+ ( dhallExpression+ "conversion shapes"+ ( Text.unlines+ [ "{ present = Some \"yes\"",+ ", absent = None Text",+ ", choice = < Left : Text | Right : Natural >.Left \"selected\"",+ ", entries = [ { mapKey = \"one\", mapValue = 1 }, { mapKey = \"two\", mapValue = 2 } ]",+ "}"+ ]+ )+ )+ candidateValue <$> expectCandidate presentKey input >>= assertRaw (RawText "yes")+ candidateValue <$> expectCandidate absentKey input >>= assertRaw RawNull+ candidateValue <$> expectCandidate choiceKey input >>= assertRaw (RawText "selected")+ entries <- candidateValue <$> expectCandidate entriesKey input+ assertBool "association list was silently collapsed into an object" (isTwoEntryArray entries),+ testCase "a constructor applies schema defaults before conversion" $ do+ input <-+ expectSource+ noImportOptions+ ( dhallExpression+ "schema evolution"+ ( Text.unlines+ [ "let Input = { name : Text }",+ "let Output = { name : Text, description : Optional Text, tags : List Text }",+ "let default : { description : Optional Text, tags : List Text } =",+ " { description = None Text, tags = [] : List Text }",+ "let make = \\(input : Input) -> default // input",+ "let value : Output = make { name = \"my-service\" }",+ "in { service = value }"+ ]+ )+ )+ candidateValue <$> expectCandidate serviceName input >>= assertRaw (RawText "my-service")+ candidateValue <$> expectCandidate serviceDescription input >>= assertRaw RawNull+ candidateValue <$> expectCandidate serviceTags input >>= assertRaw (RawArray []),+ testCase "NoImports rejects before opening a missing import" $ do+ problem <- expectError noImportOptions (dhallExpression "disabled import" "./never-opened.dhall")+ dhallErrorCategory problem @?= DhallImportPolicyError+ dhallErrorMessage problem @?= "imports are disabled",+ testCase "local-only records a transitive closure and honest provenance" $+ withSystemTempDirectory "settei-dhall-local" $ \root -> do+ let application = root FilePath.</> "application.dhall"+ service = root FilePath.</> "service.dhall"+ database = root FilePath.</> "database.dhall"+ TextIO.writeFile application "let Service = ./service.dhall in { service = Service }"+ TextIO.writeFile service "let Database = ./database.dhall in { host = \"api.internal\", port = 8080, database = Database }"+ TextIO.writeFile database "{ host = \"db.internal\" }"+ loaded <- expectDetailed (localOptions root) (DhallFile application)+ fmap (FilePath.takeFileName . dhallImportPath) (dhallLoadedImports loaded)+ @?= ["database.dhall", "service.dhall"]+ let input = dhallLoadedSource loaded+ port <- expectCandidate servicePort input+ port ^? to candidateOrigin . #location . _Just . #path+ @?= Just (Text.pack application)+ let annotations = port ^. to candidateOrigin . #annotations+ annotations ^. at "dhall.import-count" @?= Just "2"+ annotations ^. at "dhall.provenance-precision"+ @?= Just "root-and-import-closure; leaf-level import attribution unavailable after normalization"+ result <- expectResolution (resolve defaultResolveOptions [input] (required portSetting))+ let rendered = renderResolutionText (result ^. #report)+ assertBool "text report omitted Dhall root" (Text.pack application `Text.isInfixOf` rendered)+ assertBool+ "text report fabricated leaf attribution"+ ("leaf-level import attribution unavailable after normalization" `Text.isInfixOf` rendered),+ testCase "the packaged local-import fixture survives source distribution" $ do+ application <- Paths.getDataFileName "test/fixtures/characterization/local/application.dhall"+ loaded <- expectDetailed (localOptions (FilePath.takeDirectory application)) (DhallFile application)+ fmap (FilePath.takeFileName . dhallImportPath) (dhallLoadedImports loaded)+ @?= ["database.dhall", "service.dhall"],+ testCase "local-only rejects parent and symlink escapes" $+ withSystemTempDirectory "settei-dhall-escape" $ \workspace -> do+ let allowed = workspace FilePath.</> "allowed"+ externalFile = workspace FilePath.</> "outside.dhall"+ link = allowed FilePath.</> "linked.dhall"+ Directory.createDirectory allowed+ TextIO.writeFile externalFile "{ escaped = True }"+ parentProblem <- expectError (localOptions allowed) (dhallExpression "parent escape" "../outside.dhall")+ dhallErrorCategory parentProblem @?= DhallImportPolicyError+ Directory.createFileLink externalFile link+ symlinkProblem <- expectError (localOptions allowed) (dhallExpression "symlink escape" "./linked.dhall")+ dhallErrorCategory symlinkProblem @?= DhallImportPolicyError,+ testCase "local-only rejects environment, remote, missing, and alternative imports" $+ withSystemTempDirectory "settei-dhall-capabilities" $ \root -> do+ let options = localOptions root+ environment <- expectError options (dhallExpression "environment" "env:SETTEI_DHALL_TEST_SECRET")+ remote <- expectError options (dhallExpression "remote" "https://example.com/config.dhall")+ missing <- expectError options (dhallExpression "missing" "missing")+ alternative <- expectError options (dhallExpression "alternative" "./one.dhall ? ./two.dhall")+ fmap dhallErrorCategory [environment, remote, missing, alternative]+ @?= replicate 4 DhallImportPolicyError,+ testCase "local-only reports an import cycle without recursing forever" $+ withSystemTempDirectory "settei-dhall-cycle" $ \root -> do+ TextIO.writeFile (root FilePath.</> "a.dhall") "./b.dhall"+ TextIO.writeFile (root FilePath.</> "b.dhall") "./a.dhall"+ problem <- expectError (localOptions root) (dhallExpression "cycle" "./a.dhall")+ dhallErrorCategory problem @?= DhallImportError,+ testCase "semantic hashes and raw-text modes remain structural provenance" $+ withSystemTempDirectory "settei-dhall-hash" $ \root -> do+ let hashed = root FilePath.</> "hashed.dhall"+ message = root FilePath.</> "message.txt"+ hashedExpression = "{ value = True }"+ TextIO.writeFile hashed hashedExpression+ TextIO.writeFile message "hello from raw text"+ semanticHash <- hashExpression hashedExpression+ loaded <-+ expectDetailed+ (localOptions root)+ ( dhallExpression+ "hashed and raw text"+ ( "{ hashed = ./hashed.dhall "+ <> semanticHash+ <> ", message = ./message.txt as Text }"+ )+ )+ let imports = dhallLoadedImports loaded+ length imports @?= 2+ assertBool "semantic hash was discarded" (any ((/= Nothing) . dhallImportSemanticHash) imports)+ assertBool "raw-text mode was discarded" (any ((== DhallRawTextImport) . dhallImportMode) imports)+ candidateValue <$> expectCandidate messageKey (dhallLoadedSource loaded)+ >>= assertRaw (RawText "hello from raw text"),+ testCase "a changed local import is not hidden by upstream cache state" $+ withSystemTempDirectory "settei-dhall-cache" $ \root -> do+ let imported = root FilePath.</> "value.dhall"+ rootExpression = dhallExpression "cache repeat" "{ service = ./value.dhall }"+ options = localOptions root+ TextIO.writeFile imported "{ port = 8000 }"+ firstSource <- expectSource options rootExpression+ candidateValue <$> expectCandidate servicePort firstSource >>= assertRaw (RawNumber 8000)+ TextIO.writeFile imported "{ port = 9000 }"+ secondSource <- expectSource options rootExpression+ candidateValue <$> expectCandidate servicePort secondSource >>= assertRaw (RawNumber 9000),+ testCase "higher Dhall sources override leaves through the core resolver" $ do+ low <- expectSource (dhallSourceOptions "low" NoImports) (dhallExpression "low" "{ service = { host = \"old.internal\", port = 7000 } }")+ high <- expectSource (dhallSourceOptions "high" NoImports) (dhallExpression "high" "{ service = { port = 9000 } }")+ result <-+ expectResolution+ ( resolve+ defaultResolveOptions+ [low, high]+ ((,) <$> required hostSetting <*> required portSetting)+ )+ result ^. #value @?= ("old.internal", 9000),+ testCase "stable error phases and Show output never retain source secrets" $ do+ let cases =+ [ (dhallExpression "parse" ("{ password = \"" <> secretSentinel <> "\", broken ="), DhallParseError),+ (dhallExpression "type" ("{ password = \"" <> secretSentinel <> "\", broken = if True then True else 1 }"), DhallTypeError),+ (dhallExpression "conversion" ("{ password = \"" <> secretSentinel <> "\", bytes = 0x\"00\" }"), DhallConversionError),+ (dhallExpression "key" ("{ `service.port` = 8080, password = \"" <> secretSentinel <> "\" }"), DhallInvalidKey),+ (dhallExpression "top-level" "[ 1, 2 ]", DhallTopLevelType)+ ]+ traverse_+ ( \(root, expectedCategory) -> do+ problem <- expectError noImportOptions root+ dhallErrorCategory problem @?= expectedCategory+ assertBool+ "secret reached structured Dhall error"+ (not (secretSentinel `Text.isInfixOf` Text.pack (show problem)))+ )+ cases,+ testCase "resolved secret values are redacted while Dhall provenance remains" $ do+ input <-+ expectSource+ noImportOptions+ (dhallExpression "secret root" ("{ database = { password = \"" <> secretSentinel <> "\" } }"))+ result <- expectResolution (resolve defaultResolveOptions [input] (required passwordSetting))+ result ^. #value @?= secretSentinel+ let textOutput = renderResolutionText (result ^. #report)+ jsonOutput = renderResolutionJson (result ^. #report)+ assertBool "secret reached text report" (not (secretSentinel `Text.isInfixOf` textOutput))+ assertBool "secret reached JSON report" (not (secretSentinel `Text.isInfixOf` jsonOutput))+ assertBool "Dhall provenance was redacted with the value" ("secret root" `Text.isInfixOf` textOutput)+ ]++noImportOptions :: DhallSourceOptions+noImportOptions = dhallSourceOptions "application Dhall" NoImports++localOptions :: FilePath -> DhallSourceOptions+localOptions root = dhallSourceOptions "application Dhall" (LocalImportsWithin root)++expectDetailed :: DhallSourceOptions -> DhallRoot -> IO DhallLoadedSource+expectDetailed options root = do+ result <- loadDhallSourceDetailed options root+ case result of+ Left problems -> assertFailure (show problems) >> error "unreachable"+ Right value -> pure value++expectSource :: DhallSourceOptions -> DhallRoot -> IO Source+expectSource options root = dhallLoadedSource <$> expectDetailed options root++expectError :: DhallSourceOptions -> DhallRoot -> IO DhallSourceError+expectError options root = do+ result <- loadDhallSource options root+ case result of+ Left problems -> pure (NonEmpty.head problems)+ Right _ -> assertFailure "expected Dhall loading to fail" >> error "unreachable"++expectCandidate :: Key -> Source -> IO Candidate+expectCandidate key input = case lookupSource key input of+ Right (Just found) -> pure found+ _ -> assertFailure "expected Dhall candidate" >> error "unreachable"++expectResolution :: Either (NonEmpty ConfigError) a -> IO a+expectResolution = \case+ Left _ -> assertFailure "expected Dhall resolution to succeed" >> error "unreachable"+ Right value -> pure value++hashExpression :: Text -> IO Text+hashExpression input = case DhallParser.exprFromText "hash fixture" input of+ Left problem -> assertFailure (show problem) >> error "unreachable"+ Right parsed -> do+ resolved <- DhallImport.assertNoImports parsed+ pure (DhallImport.hashExpressionToCode (DhallCore.normalize (DhallCore.denote resolved)))++isTwoEntryArray :: RawValue -> Bool+isTwoEntryArray = \case+ RawArray [RawObject firstEntry, RawObject secondEntry] ->+ Map.lookup "mapKey" firstEntry == Just (RawText "one")+ && Map.lookup "mapValue" firstEntry == Just (RawNumber 1)+ && Map.lookup "mapKey" secondEntry == Just (RawText "two")+ && Map.lookup "mapValue" secondEntry == Just (RawNumber 2)+ _ -> False++assertRaw :: RawValue -> RawValue -> IO ()+assertRaw expected actual = assertBool "raw Dhall value did not match" (actual == expected)++hostSetting :: Setting Text+hostSetting = publicSetting serviceHost "Service host" textDecoder++portSetting :: Setting Int+portSetting = publicSetting servicePort "Service port" boundedIntegralDecoder++passwordSetting :: Setting Text+passwordSetting = secretSetting databasePassword "Database password" textDecoder++serviceHost, servicePort, serviceEnabled, serviceTags, serviceName, serviceDescription, presentKey, absentKey, choiceKey, entriesKey, messageKey, databasePassword :: Key+serviceHost = validKey "service.host"+servicePort = validKey "service.port"+serviceEnabled = validKey "service.enabled"+serviceTags = validKey "service.tags"+serviceName = validKey "service.name"+serviceDescription = validKey "service.description"+presentKey = validKey "present"+absentKey = validKey "absent"+choiceKey = validKey "choice"+entriesKey = validKey "entries"+messageKey = validKey "message"+databasePassword = validKey "database.password"++validKey :: Text -> Key+validKey value = either (error . show) id (parseKey value)++secretSentinel :: Text+secretSentinel = "never-render-this-dhall-secret"
+ test/fixtures/characterization/README.md view
@@ -0,0 +1,8 @@+# Dhall characterization fixtures++These files preserve the input boundaries tested by `Settei.DhallTest` and shipped in the+`settei-dhall` source distribution. `direct.dhall`, `nested.dhall`, `list.dhall`,+`optional.dhall`, and `schema-default.dhall` cover JSON-compatible normalized values.+`parse-error.dhall`, `type-error.dhall`, and `unsupported-bytes.dhall` cover stable error+phases. The `local/` chain proves transitive import collection; path, symlink, cycle, and+cache cases use temporary directories because they require filesystem topology.
+ test/fixtures/characterization/direct.dhall view
@@ -0,0 +1,1 @@+{ host = "api.internal", port = 8080, enabled = True }
+ test/fixtures/characterization/list.dhall view
@@ -0,0 +1,1 @@+{ tags = [ "api", "public" ] }
+ test/fixtures/characterization/local/application.dhall view
@@ -0,0 +1,3 @@+let Service = ./service.dhall++in { service = Service }
+ test/fixtures/characterization/local/database.dhall view
@@ -0,0 +1,1 @@+{ host = "db.internal" }
+ test/fixtures/characterization/local/service.dhall view
@@ -0,0 +1,3 @@+let Database = ./database.dhall++in { host = "api.internal", port = 8080, database = Database }
+ test/fixtures/characterization/nested.dhall view
@@ -0,0 +1,1 @@+{ service = { http = { host = "api.internal", port = 8080 } } }
+ test/fixtures/characterization/optional.dhall view
@@ -0,0 +1,1 @@+{ present = Some "configured", absent = None Text }
+ test/fixtures/characterization/parse-error.dhall view
@@ -0,0 +1,1 @@+{ service = { port =
+ test/fixtures/characterization/schema-default.dhall view
@@ -0,0 +1,12 @@+let Input = { name : Text }++let Output = { name : Text, description : Optional Text, tags : List Text }++let default : { description : Optional Text, tags : List Text } =+ { description = None Text, tags = [] : List Text }++let make = \(input : Input) -> default // input++let value : Output = make { name = "my-service" }++in { service = value }
+ test/fixtures/characterization/type-error.dhall view
@@ -0,0 +1,1 @@+{ service = { port = if True then True else 8080 } }
+ test/fixtures/characterization/unsupported-bytes.dhall view
@@ -0,0 +1,1 @@+{ bytes = 0x"00" }