nova-nix-0.9.0.0: test/Main.hs
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
-- | The nova-nix test suite. One executable runs every group, prints each
-- failing case, and exits non-zero unless every case passes.
module Main (main) where
import qualified Codec.Archive.Tar as Tar
import qualified Codec.Archive.Tar.Entry as TarEntry
import qualified Codec.Compression.Zstd.Lazy as ZstdL
import Control.Concurrent (forkIO, newEmptyMVar, putMVar, takeMVar, threadDelay)
import Control.Concurrent.Async (asyncThreadId, cancel, waitCatch, withAsync)
import Control.Exception (AsyncException (..), ErrorCall (..), IOException, SomeAsyncException (..), SomeException, asyncExceptionToException, bracket, bracket_, catches, displayException, evaluate, finally, fromException, throw, throwIO, throwTo, toException, try)
import Control.Monad (filterM, unless, void, when)
import Data.Bits (shiftR, xor, (.&.))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Unsafe as BSU
import Data.Char (isDigit)
import Data.Functor.Identity (Identity (..))
import Data.IORef (atomicModifyIORef', newIORef, readIORef)
import Data.Int (Int64)
import Data.List (intercalate, isPrefixOf, sort)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Text.Encoding.Error (lenientDecode)
import qualified Data.Text.IO as TIO
import Data.Word (Word32, Word64, Word8)
import qualified Database.SQLite.Simple as SQL
import Foreign.C.Error (Errno (..), eACCES, eISDIR, eNOENT, eNOTDIR)
import Foreign.C.Types (CChar)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr (Ptr, castPtr, nullPtr)
import Foreign.StablePtr (StablePtr, castPtrToStablePtr, castStablePtrToPtr, deRefStablePtr, freeStablePtr, newStablePtr)
import Foreign.Storable (poke, sizeOf)
import qualified GHC.Foreign as GHCForeign
import GHC.IO.Encoding (getFileSystemEncoding, mkTextEncoding, setFileSystemEncoding)
import GHC.IO.Exception (IOErrorType (..), IOException (..))
import HttpFixture (Reply (..), httpResponse, withFetchurlServer, withHttpServer)
import qualified Network.HTTP.Client as HTTP
import qualified Network.HTTP.Types.Status as HTTP
import Nix.Builder (BuildConfig (..), BuildResult (..), BuilderSpawn (..), buildDerivation, buildPath, buildWithDeps, defaultBuildConfig, execWrapperConfig, execWrapperFor, fetchUrlsFromEnv, rewriteEnv, rewritePlaceholders, scrubAmbient, spawnFor, tryFetchUrlsWith, unionEnvs, verifyFetchHash)
import Nix.Builder.Unpack (UnpackLimits (..), builtinUnpackBuilder, defaultUnpackLimits, entryComponents, envSrcs, resolveLinkTarget, runBuiltinUnpack)
import Nix.Builtins (builtinEnv, isNixPathPseudoUrl, parseNixPath, rootScopeNames, splitNixPath)
import Nix.Config (NixConfig (..))
import qualified Nix.Config as Config
import qualified Nix.DependencyGraph as DepGraph
import Nix.Derivation (Derivation (..), DerivationOutput (..), Platform (..), currentPlatform, extraPlatforms, fromATerm, platformToText, textToPlatform, toATerm, toATermForHash)
import Nix.Derivation.StructuredAttrs (StructuredAttrs (..), decodeStructuredAttrs, encodeStructuredAttrs, renderAttrsShell, stringsAttr, withOutputPlaceholders)
import Nix.Eval (EvalPolicy (..), FetchCache (..), FetchGitArgs (..), MonadEval (..), NixValue (..), StringContext (..), StringContextElement (..), Thunk (..), attrSetFromMap, attrSetLookup, attrSetNull, attrSetSize, builtinNames, checkGitRef, checkGitRev, checkGitUrl, decodeFetchCache, emptyContext, emptyEnv, encodeFetchCache, eval, evaluated, fetchCacheKey, force, gitInputUrl, mkStr, readThunkValue, runPureEval, typeName, unrestrictedPolicy)
import Nix.Eval.Arena (CStatusError (..), arenaDestroy, arenaInit, arenaLive)
import Nix.Eval.AttrPath (parseAttrPath, selectAttrPath)
import Nix.Eval.CAttrSet (cattrsetFreeze, cattrsetIndex, cattrsetInsert, cattrsetKeys, cattrsetLookup, cattrsetNew, cattrsetSize, cattrsetUnion)
import Nix.Eval.CBytecode (appDeferred, attrkeyStatic, binaryAdd, captureSlots, captureWithScopes, cbcArg1, cbcArg2, cbcArg3, cbcData, cbcDataCount, cbcFlags, cbcOpCount, cbcOpcode, cbcShortArg, formalName, formalNamedSet, formalSet, reservedApply1, reservedApply2, strpartInterp, strpartLit, unaryNegate, pattern OpApp, pattern OpAssert, pattern OpAttrs, pattern OpBinary, pattern OpHasAttr, pattern OpIf, pattern OpIndStr, pattern OpLambda, pattern OpLet, pattern OpList, pattern OpLitBool, pattern OpLitFloat, pattern OpLitInt, pattern OpLitNull, pattern OpLitPath, pattern OpLitUri, pattern OpResolvedVar, pattern OpSelect, pattern OpStr, pattern OpUnary, pattern OpVar, pattern OpWith, pattern OpWithVar)
import Nix.Eval.CEnv (cenvLazyScope)
import Nix.Eval.CList (clistDrop, clistFromThunks, clistIndex, clistLen, clistNew, clistThunks)
import Nix.Eval.CThunk (CThunkPtr, cthunkBool, cthunkCount, cthunkGet, cthunkGetBcIdx, cthunkGetBool, cthunkMarkBlackhole, cthunkNewBc, cthunkNewComputed, cthunkNewComputedInt, cthunkNull, cthunkPayload, cthunkSetComputed, cthunkSetPayload, cthunkState, cthunkValueTag)
import Nix.Eval.CallDepth (topLevelCallDepth)
import Nix.Eval.CanonPath (canonPath, canonPathValue)
import Nix.Eval.Compile (BcBinding (..), BcInheritedName (..), compileExpr, decodeBcBindings)
import qualified Nix.Eval.Context as Context
import Nix.Eval.IO (EvalFailure (..), EvalState (..), allowEvalPath, newEvalState, renderEvalFailure, runEvalIO, runEvalIOTraced)
import Nix.Eval.Policy (allowPathIn, forbiddenPathMessage, isAllowedPath, isAllowedUri, joinComponents, noAllowedPaths, pathComponents, uriAccess)
import Nix.Eval.Print (PrintOptions (..), printAmbiguous, printValue)
import Nix.Eval.SourceError (SourceAccess (..), sourceErrorMessage)
import Nix.Eval.StringInterp (joinCoercedList)
import Nix.Eval.Symbol (Symbol (..), symbolCount, symbolIntern, symbolInternBytes, symbolLen, symbolText)
import Nix.Eval.Types (AttrSet (..), Env (..), allocCSlots, attrSetKeys, buildCSlots, emptyCList, pattern ThunkComputed, pattern ValueBool, pattern ValueNull)
import Nix.Expr.Resolve (impureOnlyGlobalNames, staticGlobalNames, undefinedVariableMessage)
import Nix.Expr.Types
import Nix.Hash (compressHash, hashPlaceholder, makeFixedOutputPath, makeTextPath, sha256Digest)
import qualified Nix.Hash as Hash
import Nix.HostPath (hostPathFromBytes)
import Nix.Http (FetchRetryPolicy (..), RetryEffects (..), TransferError (..), defaultFetchRetryPolicy, fetchExceptionFailure, fetchStatusFailure, retryDelayMs, retryTransient, statusError, transferBodyReader, transferFailureHandlers, userAgent, withUserAgent)
import Nix.Json (Json (..), parseJson, renderJson)
import Nix.Parser (ParseError (..), SourceError (..), parseNix, parseNixWithScope)
import Nix.Parser.Lexer (Located (..), Token (..), tokenize)
import Nix.Push (PushArtifact (..), PushCompression (..), PushConfig (..), checkRecordedNarHash, computeClosure, isDerivationPath, loadApiKeyFile, mkNarInfo, mkPushArtifact, narFileName, narHashMatches, outputPathsOnly, parsePushCompression, planMissing, pushPaths, storePathBasename, stripHashPrefix)
import Nix.Store (DeleteOutcome (..), GcResults (..), GcRoot (..), Store (..), SweepPlan (..), acquirePathLock, addOutLinkRoot, addToStore, autoRootsDir, caseHackDiskNames, closeStore, collectGarbage, copyPathInto, deleteStorePathRaw, findRoots, gcLockFilePath, gcRootsDir, gcSummaryLine, indirectRootRecordName, isValid, materializeEvalSources, materializeEvalStoreWrites, onDiskNameKey, openStore, orderLinks, pathExists, reachableFrom, referencesMap, registrationFor, releasePathLock, resolveDeleteTarget, scanReferences, scanTempReferences, setReadOnly, showFreedBytes, sweepPlan, tryAcquirePathLock, unpackNarEntry, withCollectorLock, writeDrv, writeDrvClosure)
import Nix.Store.CaseSensitive (CaseSensitivity (..), probeCaseSensitivity, processCaseHack, trySetCaseSensitiveDir, volumeCaseHack)
import Nix.Store.DB (PathInfo (..), PathRegistration (..), closeStoreDB, dbFileName, isValidPath, metaDirName, openStoreDB, queryAllValidPaths, queryDeriver, queryPathInfo, queryReferences, registerPath, registerPaths)
import Nix.Store.EntryName (NameRules (..), checkEntryName, checkLinkTarget)
import qualified Nix.Store.ExecBit as ExecBit
import Nix.Store.Path (StoreDir (..), StorePath, StoreWriteMode (..), defaultStoreDir, defaultStoreDirText, isCanonicalStoreText, parseStorePath, parseStorePathPrefix, platformStoreDir, storePathToFilePath, storePathToText, storeTextToFilePath, windowsStoreDir)
import Nix.Store.Path.Internal (StorePath (..))
import qualified Nix.Substituter as Subst
import qualified NovaCache.Base64 as B64
import qualified NovaCache.Hash as CHash
import qualified NovaCache.NAR as NAR
import qualified NovaCache.NarInfo as NarInfo
import qualified NovaCache.Signing as Signing
import qualified NovaCache.Zstd as CZstd
import System.Directory (createDirectoryIfMissing, doesDirectoryExist, getPermissions, getTemporaryDirectory, removeDirectoryRecursive, writable)
import qualified System.Directory as Dir
import System.Environment (getArgs, getEnvironment, getExecutablePath, lookupEnv, setEnv, unsetEnv)
import qualified System.Environment.Blank as Blank
import System.Exit (ExitCode (..), exitFailure, exitSuccess, exitWith)
import System.FilePath (dropDrive, joinPath, makeRelative, pathSeparator, searchPathSeparator, splitDirectories, takeDirectory, takeDrive, takeFileName, (</>))
import System.IO (BufferMode (..), IOMode (..), hPutStrLn, hSetBuffering, stderr, stdout, withBinaryFile)
import System.IO.Error (ioeGetErrorString, mkIOError, resourceVanishedErrorType)
import System.IO.Unsafe (unsafePerformIO)
import qualified System.Info as SI
import System.OsPath (OsPath)
import qualified System.OsPath as OP
import qualified System.Process as Proc
import System.Timeout (timeout)
import qualified Test.QuickCheck as QC
-- ---------------------------------------------------------------------------
-- Test harness
-- ---------------------------------------------------------------------------
data TestResult = Pass | Fail !Text
runTest :: Text -> TestResult -> IO Bool
runTest name result = case result of
Pass -> do
putStrLn $ " PASS " ++ T.unpack name
pure True
Fail msg -> do
putStrLn $ " FAIL " ++ T.unpack name ++ ": " ++ T.unpack msg
pure False
-- | Like 'runTest' but for tests that need IO to produce their result.
-- An exception escaping the action becomes one FAIL line instead of
-- aborting the whole suite (which would skip every later group and its
-- cleanup).
runTestM :: Text -> IO TestResult -> IO Bool
runTestM name action = do
outcome <- try action
runTest name $ case outcome of
Left (e :: SomeException) -> Fail ("uncaught exception: " <> T.pack (show e))
Right result -> result
assertEqual :: (Eq a, Show a) => Text -> a -> a -> TestResult
assertEqual label expected actual
| expected == actual = Pass
| otherwise =
Fail $
label
<> ": expected "
<> T.pack (show expected)
<> " but got "
<> T.pack (show actual)
-- | The first failure of two results, or 'Pass' when both pass.
andThen :: TestResult -> TestResult -> TestResult
andThen first second = case first of
Pass -> second
failed -> failed
-- | Render string-value bytes in a failure message (display-only decode).
bytesText :: BS.ByteString -> Text
bytesText = TE.decodeUtf8With lenientDecode
assertRight :: (Show e) => Text -> Either e a -> (a -> TestResult) -> TestResult
assertRight label result check = case result of
Left err -> Fail (label <> ": got error: " <> T.pack (show err))
Right val -> check val
assertLeft :: (Show a) => Text -> Either e a -> TestResult
assertLeft _ (Left _) = Pass
assertLeft label (Right val) = Fail (label <> ": expected error but got: " <> T.pack (show val))
-- | What a test expression's relative path literals resolve against.
-- Absolute, because that is the invariant the parser now establishes: no
-- relative path literal survives parsing, so nothing downstream has to know
-- what one would have meant.
testBaseDir :: FilePath
testBaseDir = "/nova-nix-test"
-- | Helper: parse and check result.
assertParse :: Text -> Text -> Expr -> TestResult
assertParse = assertParseIn []
-- | 'assertParse' for source whose free variables are bound around it, the
-- way @scopedImport@ binds its scope: each stays a name-based 'EVar'.
assertParseIn :: [Text] -> Text -> Text -> Expr -> TestResult
assertParseIn names label source expected =
assertRight label (parseNixWithScope (withGlobals names) testBaseDir "<test>" source) $ \actual ->
assertEqual label expected actual
-- | The root environment's names with more bound around them.
withGlobals :: [Text] -> Set.Set Text
withGlobals names = Set.union (Set.fromList names) staticGlobalNames
-- | Helper: extract just token types from Located list (drop positions and EOF).
tokenTypes :: [Located] -> [Token]
tokenTypes = filter (/= TokEOF) . map locToken
-- | Helper: parse Nix source and evaluate with builtinEnv. Parse errors
-- are tagged so failure assertions can tell them apart from eval errors.
evalNix :: Text -> Either Text NixValue
evalNix source = case parseNix testBaseDir "<test>" source of
Left err -> Left (sourceFailure err)
Right expr -> runPureEval (eval (builtinEnv unrestrictedPolicy 0 []) expr)
-- | Prefix marking a parse (not eval) failure in 'evalNix' results.
parseErrorTag :: Text
parseErrorTag = "parse error: "
-- | A source failure as an 'evalNix' result: a syntax error carries
-- 'parseErrorTag'; an unbound variable reads as the evaluation error
-- upstream raises for it, before evaluating anything.
sourceFailure :: SourceError -> Text
sourceFailure (SyntaxError err) = parseErrorTag <> T.pack (show err)
sourceFailure (UndefinedVariable name) = undefinedVariableMessage name
-- | The syntax error a source fails to parse with.
syntaxErrorOf :: Text -> Either Text ParseError
syntaxErrorOf source = case parseNix testBaseDir "<test>" source of
Left (SyntaxError err) -> Right err
Left other -> Left ("expected a syntax error, got " <> T.pack (show other))
Right _ -> Left "parsed unexpectedly"
-- | Assert that a Nix expression evaluates to the expected value.
assertEval :: Text -> Text -> NixValue -> TestResult
assertEval label source expected =
assertRight label (evalNix source) $ \actual ->
assertEqual label expected actual
-- | Assert that a Nix expression parses but fails to EVALUATE. A parse
-- failure fails the assertion: a test documenting a runtime error must
-- not keep passing after a regression stops the construct from parsing.
-- | The bytes of a string value, and nothing for any other value.
stringBytes :: NixValue -> BS.ByteString
stringBytes (VStr bytes _) = bytes
stringBytes _ = BS.empty
assertEvalFail :: Text -> Text -> TestResult
assertEvalFail label source = case evalNix source of
Left err
| parseErrorTag `T.isPrefixOf` err ->
Fail (label <> ": expected an eval error but the source did not parse: " <> err)
| otherwise -> Pass
Right val -> Fail (label <> ": expected eval failure but got: " <> T.pack (show val))
-- | Assert that a Nix expression parses and fails to evaluate with exactly
-- the given message, for errors whose wording is upstream's.
assertEvalError :: Text -> Text -> Text -> TestResult
assertEvalError label source expected = case evalNix source of
Left err
| parseErrorTag `T.isPrefixOf` err ->
Fail (label <> ": expected an eval error but the source did not parse: " <> err)
| otherwise -> assertEqual label expected err
Right val -> Fail (label <> ": expected eval failure but got: " <> T.pack (show val))
-- | 'assertEvalError' under the IO evaluator, which keeps a forced
-- thunk's value and marks one while it is being forced, as upstream's
-- evaluator does; the pure one does neither.
assertEvalErrorIO :: FilePath -> Text -> Text -> Text -> IO TestResult
assertEvalErrorIO baseDir label source expected = do
result <- evalNixIO baseDir source
pure $ case result of
Left err -> assertEqual label expected err
Right val -> Fail (label <> ": expected eval failure but got: " <> T.pack (show val))
-- | Assert that a Nix expression fails at PARSE time.
assertParseFail :: Text -> Text -> TestResult
assertParseFail label source = case evalNix source of
Left err
| parseErrorTag `T.isPrefixOf` err -> Pass
| otherwise ->
Fail (label <> ": expected a parse error but evaluation failed instead: " <> err)
Right val -> Fail (label <> ": expected parse failure but got: " <> T.pack (show val))
-- ---------------------------------------------------------------------------
-- Shell discovery for builder tests
-- ---------------------------------------------------------------------------
-- | Find a POSIX-compatible shell for builder tests.
-- On Unix, always @\/bin\/sh@. On Windows, searches for @bash.exe@
-- at known Git for Windows locations first, then PATH. Checks known
-- paths first to avoid picking up the WSL launcher at
-- @C:\\Windows\\System32\\bash.exe@ which exits 1 when WSL is not
-- configured. Real Nix builders always use bash from the store -
-- this bridges the gap until nova-nix bootstraps its own bash
-- derivation.
findTestShell :: IO Text
findTestShell = case SI.os of
"mingw32" -> do
let known =
[ "C:\\Program Files\\Git\\bin\\bash.exe",
"C:\\Program Files (x86)\\Git\\bin\\bash.exe"
]
found <- filterM Dir.doesFileExist known
case found of
(p : _) -> pure (T.pack p)
[] -> do
inPath <- Dir.findExecutable "bash"
case inPath of
Just p -> pure (T.pack p)
Nothing ->
error
"bash not found: install Git for Windows or add bash to PATH"
_ -> pure "/bin/sh"
-- ---------------------------------------------------------------------------
-- Tests: Expr types (existing)
-- ---------------------------------------------------------------------------
testExprTypes :: IO [Bool]
testExprTypes = do
putStrLn "expr/types"
sequence
[ runTest "int literal" $
assertEqual "ELit NixInt" (ELit (NixInt 42)) (ELit (NixInt 42)),
runTest "bool literal" $
assertEqual "ELit NixBool" (ELit (NixBool True)) (ELit (NixBool True)),
runTest "null literal" $
assertEqual "ELit NixNull" (ELit NixNull) (ELit NixNull),
runTest "var" $
assertEqual "EVar" (EVar "x") (EVar "x"),
runTest "string parts" $
let parts = [StrLit "hello ", StrInterp (EVar "name")]
in assertEqual "EStr" (EStr parts) (EStr parts),
runTest "binary op" $
let expr = EBinary OpAdd (ELit (NixInt 1)) (ELit (NixInt 2))
in assertEqual "EBinary" expr expr,
runTest "lambda" $
let expr = ELambda (FormalName "x") (EVar "x") NoCaptureInfo
in assertEqual "ELambda" expr expr,
runTest "let binding" $
let expr = ELet [NamedBinding (StaticKey "x") (ELit (NixInt 1))] (EVar "x") NoCaptureInfo
in assertEqual "ELet" expr expr,
runTest "attrs" $
let expr = EAttrs False [NamedBinding (StaticKey "a") (ELit (NixInt 1))] NoCaptureInfo
in assertEqual "EAttrs" expr expr,
runTest "if-then-else" $
let expr = EIf (ELit (NixBool True)) (ELit (NixInt 1)) (ELit (NixInt 2))
in assertEqual "EIf" expr expr
]
-- ---------------------------------------------------------------------------
-- Tests: Store paths (existing)
-- ---------------------------------------------------------------------------
testStorePaths :: IO [Bool]
testStorePaths = do
putStrLn "store/path"
let sp = StorePath {spHash = "s66mzxpvicwk07gjbjfw9izjfa797vsw", spName = "hello-2.12.1"}
sequence
[ runTest "default store dir" $
assertEqual "defaultStoreDir" "/nix/store" (unStoreDir defaultStoreDir),
runTest "windows store dir" $
assertEqual "windowsStoreDir" "C:\\nix\\store" (unStoreDir windowsStoreDir),
runTest "store path to text" $
assertEqual
"storePathToText"
"/nix/store/s66mzxpvicwk07gjbjfw9izjfa797vsw-hello-2.12.1"
(T.unpack (storePathToText defaultStoreDir sp)),
runTest "store path ordering" $
let sp2 = StorePath {spHash = "zzz", spName = "later"}
in assertEqual "Ord" True (sp < sp2),
-- The reader-side mapping: canonical store text resolves into the
-- store dir it is given; everything else is the path as written.
runTest "store text maps into the platform store dir" $
assertEqual
"mapped"
(unStoreDir platformStoreDir <> "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-x/sub/f")
(storeTextToFilePath platformStoreDir "/nix/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-x/sub/f"),
runTest "bare store dir text maps to the platform store root" $
assertEqual "mapped-root" (unStoreDir platformStoreDir) (storeTextToFilePath platformStoreDir "/nix/store"),
runTest "store text with a backslash subpath maps" $
assertEqual
"mapped-backslash"
(unStoreDir platformStoreDir <> "\\bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb-y")
(storeTextToFilePath platformStoreDir "/nix/store\\bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb-y"),
runTest "non-store text is the path as written" $
assertEqual "unmapped" "/etc/hosts" (storeTextToFilePath platformStoreDir "/etc/hosts"),
runTest "a store-prefix-like name does not map" $
assertEqual "unmapped-like" "/nix/storefoo" (storeTextToFilePath platformStoreDir "/nix/storefoo"),
-- The reason this takes a store dir at all: a caller given one must
-- read from it, not from the platform default.
runTest "store text maps into a redirected store dir" $
assertEqual
"redirected"
"/tmp/scratch-store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-x"
(storeTextToFilePath (StoreDir "/tmp/scratch-store") "/nix/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-x"),
-- Both sides must land in the SAME store dir. Not the same string:
-- storePathToFilePath joins with the native separator while
-- storeTextToFilePath passes the canonical text's tail through, so
-- the two spellings differ on Windows and open the same file.
runTest "a redirected read lands in the same store as the write" $
let redirected = StoreDir "/tmp/scratch-store"
redirectedPath = StorePath {spHash = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", spName = "x"}
readSide = storeTextToFilePath redirected (storePathToText defaultStoreDir redirectedPath)
writeSide = storePathToFilePath redirected redirectedPath
underRedirected p = unStoreDir redirected `isPrefixOf` p
in assertEqual
"both under the redirected store"
(True, True, False)
(underRedirected readSide, underRedirected writeSide, unStoreDir platformStoreDir `isPrefixOf` readSide),
runTest "isCanonicalStoreText accepts both separators and rejects lookalikes" $
assertEqual
"predicate"
[True, True, True, False, False]
( map
isCanonicalStoreText
["/nix/store", "/nix/store/x", "/nix/store\\x", "/nix/storefoo", "C:\\nix\\store\\x"]
),
runTestM "compressHash XORs byte i into position i mod the length" $ do
result <-
QC.quickCheckWithResult QC.stdArgs {QC.chatty = False} $
QC.forAll genCompressCase $ \(len, bytes) ->
BS.unpack (compressHash len (BS.pack bytes)) QC.=== compressHashModel len bytes
pure (if QC.isSuccess result then Pass else Fail (T.pack (QC.output result)))
]
where
-- Lengths on both sides of the input's, so the last chunk is short,
-- whole or absent, and below one, where there is nothing to fold into.
genCompressCase = (,) <$> QC.choose (-1, 40) <*> QC.resize 70 (QC.listOf QC.arbitrary)
-- | Upstream's @compressHash@ loop (hash.cc), one byte at a time.
compressHashModel :: Int -> [Word8] -> [Word8]
compressHashModel len bytes =
[foldl' xor 0 [b | (i, b) <- zip [0 :: Int ..] bytes, i `mod` len == j] | j <- [0 .. len - 1]]
-- ---------------------------------------------------------------------------
-- Tests: Derivation (existing)
-- ---------------------------------------------------------------------------
testDerivation :: IO [Bool]
testDerivation = do
putStrLn "derivation"
sequence
[ runTest "current platform is known" $
case currentPlatform of
OtherPlatform _ -> Fail "currentPlatform returned OtherPlatform"
_ -> Pass
]
-- ---------------------------------------------------------------------------
-- Tests: Eval - Literals
-- ---------------------------------------------------------------------------
testEvalLiterals :: IO [Bool]
testEvalLiterals = do
putStrLn "eval/literals"
sequence
[ runTest "empty env" $
assertEqual "emptyEnv" emptyEnv emptyEnv,
runTest "int" $
assertEval "int" "42" (VInt 42),
runTest "float" $
assertEval "float" "3.14" (VFloat 3.14),
runTest "bool true" $
assertEval "true" "true" (VBool True),
runTest "null" $
assertEval "null" "null" VNull,
runTest "string" $
assertEval "string" "\"hello\"" (mkStr "hello")
]
-- ---------------------------------------------------------------------------
-- Tests: Eval - Variables
-- ---------------------------------------------------------------------------
testEvalVariables :: IO [Bool]
testEvalVariables = do
putStrLn "eval/variables"
sequence
[ runTest "let variable" $
assertEval "let-var" "let x = 1; in x" (VInt 1),
runTest "undefined variable" $
assertEvalFail "undef" "x",
runTest "builtin true" $
assertEval "builtin-true" "true" (VBool True)
]
-- ---------------------------------------------------------------------------
-- Tests: Eval - Arithmetic
-- ---------------------------------------------------------------------------
testEvalArithmetic :: IO [Bool]
testEvalArithmetic = do
putStrLn "eval/arithmetic"
sequence
[ runTest "int add" $
assertEval "add" "1 + 2" (VInt 3),
runTest "int sub" $
assertEval "sub" "10 - 3" (VInt 7),
runTest "int mul" $
assertEval "mul" "4 * 5" (VInt 20),
runTest "int div" $
assertEval "div" "10 / 3" (VInt 3),
runTest "float add" $
assertEval "float-add" "1.5 + 2.5" (VFloat 4.0),
-- Integer overflow is an eval error, never a two's-complement wrap;
-- the boundary itself still computes. The messages are upstream's
-- from 2.25 on, as nix-instantiate 2.33.2 prints them (2.24.9 leaves
-- overflow to undefined C++ signed arithmetic), except division's,
-- which 2.24.9 checks itself and 2.25 rewords.
runTest "add overflow fails" $
assertEvalError "add-overflow" "9223372036854775807 + 1" "integer overflow in adding 9223372036854775807 + 1",
runTest "sub overflow fails" $
assertEvalError "sub-overflow" "(-9223372036854775807) - 2" "integer overflow in subtracting -9223372036854775807 - 2",
runTest "mul overflow fails" $
assertEvalError "mul-overflow" "builtins.mul 9223372036854775807 2" "integer overflow in multiplying 9223372036854775807 * 2",
runTest "div minBound by -1 overflows" $
assertEvalError "div-overflow" "((-9223372036854775807) - 1) / (-1)" "overflow in integer division",
runTest "builtins.div minBound by -1 overflows" $
assertEvalError "builtin-div-overflow" "builtins.div ((-9223372036854775807) - 1) (-1)" "overflow in integer division",
runTest "negate minBound overflows as 0 - n" $
assertEvalError "neg-overflow" "-((-9223372036854775807) - 1)" "integer overflow in subtracting 0 - -9223372036854775808",
-- Unary minus is __sub 0 e upstream (parser.y at 2.24.9).
runTest "negating a float zero gives positive zero" $
assertEval "neg-zero" "builtins.toJSON [ (-(0.0)) (-(-0.0)) ]" (mkStr "[0.0,0.0]"),
runTest "negating a non-number fails as builtins.sub does" $
assertEvalError "neg-set" "-{ }" "expected an integer but found a set: { }",
-- -, *, / and the arithmetic builtins are upstream's prim_sub,
-- prim_mul, prim_div and prim_add (primops.cc at 2.24.9): forceInt
-- on both operands, or forceFloat on both once either is a float.
runTest "subtracting a set from an integer fails its forceInt" $
assertEvalError "sub-set" "1 - {}" "expected an integer but found a set: { }",
runTest "subtracting from a set fails on the left operand" $
assertEvalError "set-sub" "{} - 1" "expected an integer but found a set: { }",
runTest "subtracting a set from a float fails its forceFloat" $
assertEvalError "float-sub-set" "1.0 - {}" "expected a float but found a set: { }",
runTest "two non-numbers fail on the left one" $
assertEvalError "set-sub-str" "{} - \"a\"" "expected an integer but found a set: { }",
runTest "multiplying a float by a string fails its forceFloat" $
assertEvalError "float-mul-str" "2.5 * \"a\"" "expected a float but found a string: \"a\"",
runTest "dividing by a set fails the divisor's forceFloat" $
assertEvalError "div-set" "1 / {}" "expected a float but found a set: { }",
runTest "dividing a set by an integer fails its forceInt" $
assertEvalError "set-div" "{} / 1" "expected an integer but found a set: { }",
runTest "a zero divisor is refused before the dividend is checked" $
assertEvalError "set-div-zero" "{} / 0" "division by zero",
runTest "a non-number divisor is refused before the dividend" $
assertEvalError "set-div-str" "{} / \"a\"" "expected a float but found a string: \"a\"",
runTest "dividing by negative zero is a division by zero" $
assertEvalError "div-neg-zero" "1 / (-0.0)" "division by zero",
runTest "builtins.div by zero says only division by zero" $
assertEvalError "builtin-div-zero" "builtins.div 1 0" "division by zero",
runTest "builtins.add refuses a string through forceInt" $
assertEvalError "builtin-add-str" "builtins.add \"a\" 1" "expected an integer but found a string: \"a\"",
runTest "builtins.add with a float refuses a string through forceFloat" $
assertEvalError "builtin-add-float-str" "builtins.add 1.5 \"a\"" "expected a float but found a string: \"a\"",
runTest "builtins.sub refuses a set" $
assertEvalError "builtin-sub-set" "builtins.sub 1 {}" "expected an integer but found a set: { }",
runTest "builtins.bitXor refuses a float" $
assertEvalError "bitxor-float" "builtins.bitXor 1 1.0" "expected an integer but found a float: 1",
runTest "builtins.bitAnd fails on its left operand first" $
assertEvalError "bitand-set-str" "builtins.bitAnd {} \"a\"" "expected an integer but found a set: { }",
runTest "builtins.bitOr refuses a set" $
assertEvalError "bitor-set" "builtins.bitOr {} 1" "expected an integer but found a set: { }",
runTest "float division still divides" $
assertEval "float-div" "1 / 4.0" (VFloat 0.25),
runTest "add at the boundary still works" $
assertEval "add-boundary" "9223372036854775806 + 1 == 9223372036854775807" (VBool True),
runTest "int-float promotion" $
assertEval "promote" "1 + 2.0" (VFloat 3.0),
runTest "trailing-dot float" $
assertEval "trailing-dot" "12. == 12.0" (VBool True),
runTest "trailing-dot float with exponent" $
assertEval "trailing-dot-exp" "12.e2 == 1200.0" (VBool True),
runTest "trailing-dot float typeOf" $
assertEval "trailing-dot-type" "builtins.typeOf 12." (mkStr "float"),
runTest "negate int" $
assertEval "negate" "- 5" (VInt (-5)),
runTest "division by zero" $
assertEvalFail "div0" "1 / 0",
runTest "absolute path lexes as path, not division" $
assertEval "path-abs" "builtins.typeOf /abs/path" (mkStr "path"),
runTest "bareword relative path lexes as path" $
assertEval "path-rel" "builtins.typeOf foo/bar" (mkStr "path"),
runTest "function applied to an absolute path argument" $
assertEval "app-abs-path" "(p: builtins.typeOf p) /abs/path" (mkStr "path")
]
-- ---------------------------------------------------------------------------
-- Tests: Eval - Comparison
-- ---------------------------------------------------------------------------
testEvalComparison :: IO [Bool]
testEvalComparison = do
putStrLn "eval/comparison"
sequence
[ runTest "int eq" $
assertEval "eq" "1 == 1" (VBool True),
runTest "int neq" $
assertEval "neq" "1 != 2" (VBool True),
runTest "int lt" $
assertEval "lt" "1 < 2" (VBool True),
runTest "int gte" $
assertEval "gte" "3 >= 3" (VBool True),
runTest "string compare" $
assertEval "str-lt" "\"abc\" < \"def\"" (VBool True),
-- <= and >= are negated swapped <, so NaN compares as upstream:
-- nan <= x and nan >= x are true while nan < x and nan == nan are
-- false ((1.0e308 * 10) * 0.0 is inf * 0.0, i.e. nan).
runTest "nan lte is true" $
assertEval "nan-lte" "let nan = (1.0e308 * 10) * 0.0; in nan <= 1.0" (VBool True),
runTest "nan gte is true" $
assertEval "nan-gte" "let nan = (1.0e308 * 10) * 0.0; in nan >= 1.0" (VBool True),
runTest "nan lt is false" $
assertEval "nan-lt" "let nan = (1.0e308 * 10) * 0.0; in nan < 1.0" (VBool False),
runTest "nan self-equality is false" $
assertEval "nan-eq" "let nan = (1.0e308 * 10) * 0.0; in nan == nan" (VBool False),
runTest "lte on equal lists" $
assertEval "list-lte-eq" "[ 1 2 ] <= [ 1 2 ]" (VBool True),
runTest "lte incomparable types fails" $
assertEvalFail "lte-err" "1 <= \"a\"",
-- Upstream's CompareValues (primops.cc at 2.24.9); > and <= swap
-- the operands as the parser's desugaring to __lessThan does.
runTest "comparing different types names both" $
assertEvalError "lt-int-set" "1 < {}" "cannot compare an integer with a set",
runTest "gt compares the swapped operands" $
assertEvalError "gt-int-set" "1 > {}" "cannot compare a set with an integer",
runTest "lte compares the swapped operands" $
assertEvalError "lte-int-set" "1 <= {}" "cannot compare a set with an integer",
runTest "gte compares the operands in order" $
assertEvalError "gte-int-set" "1 >= {}" "cannot compare an integer with a set",
runTest "Booleans are incomparable" $
assertEvalError "lt-bool" "true < false" "cannot compare a Boolean with a Boolean; values of that type are incomparable",
runTest "a lambda and a primop are both functions, so incomparable" $
assertEvalError "lt-fn" "(x: x) < builtins.map" "cannot compare a function with the built-in function 'map'; values of that type are incomparable",
runTest "builtins.lessThan on nulls is incomparable" $
assertEvalError "lessthan-null" "builtins.lessThan null null" "cannot compare null with null; values of that type are incomparable",
runTest "list comparison reports the first unequal pair" $
assertEvalError "lt-list" "[ 1 ] < [ \"a\" ]" "cannot compare an integer with a string",
runTest "equal incomparable elements do not stop a list comparison" $
assertEval "lt-list-sets" "[ {} ] < [ {} ]" (VBool False)
]
-- ---------------------------------------------------------------------------
-- Tests: Eval - Logic
-- ---------------------------------------------------------------------------
testEvalLogic :: IO [Bool]
testEvalLogic = do
putStrLn "eval/logic"
sequence
[ runTest "and true" $
assertEval "and-true" "true && true" (VBool True),
runTest "and short-circuit" $
assertEval "and-short" "false && true" (VBool False),
runTest "or true" $
assertEval "or-true" "true || false" (VBool True),
runTest "or short-circuit" $
assertEval "or-short" "false || true" (VBool True),
runTest "not" $
assertEval "not" "!false" (VBool True),
runTest "implication false->x" $
assertEval "impl-false" "false -> false" (VBool True),
runTest "implication true->true" $
assertEval "impl-true" "true -> true" (VBool True)
]
-- ---------------------------------------------------------------------------
-- Tests: Eval - Strings
-- ---------------------------------------------------------------------------
testEvalStrings :: IO [Bool]
testEvalStrings = do
putStrLn "eval/strings"
sequence
[ runTest "string concat" $
assertEval "concat" "\"hello\" + \" world\"" (mkStr "hello world"),
runTest "string interpolation" $
assertEval "interp" "let x = \"world\"; in \"hello ${x}\"" (mkStr "hello world"),
runTest "interpolation coerce int" $
assertEval "coerce-int" "\"val=${builtins.toString 42}\"" (mkStr "val=42"),
runTest "empty string" $
assertEval "empty" "\"\"" (mkStr "")
]
-- ---------------------------------------------------------------------------
-- Tests: Eval - If/Assert
-- ---------------------------------------------------------------------------
testEvalIfAssert :: IO [Bool]
testEvalIfAssert = do
putStrLn "eval/if-assert"
sequence
[ runTest "if true" $
assertEval "if-true" "if true then 1 else 2" (VInt 1),
runTest "if false" $
assertEval "if-false" "if false then 1 else 2" (VInt 2),
runTest "assert pass" $
assertEval "assert-pass" "assert true; 42" (VInt 42),
runTest "assert fail" $
assertEvalFail "assert-fail" "assert false; 42"
]
-- ---------------------------------------------------------------------------
-- Tests: Eval - Let
-- ---------------------------------------------------------------------------
testEvalLet :: IO [Bool]
testEvalLet = do
putStrLn "eval/let"
sequence
[ runTest "simple let" $
assertEval "let" "let x = 1; in x" (VInt 1),
runTest "multi let" $
assertEval "multi" "let x = 1; y = 2; in x + y" (VInt 3),
runTest "recursive let" $
assertEval "rec-let" "let x = 1; y = x + 1; in y" (VInt 2)
]
-- ---------------------------------------------------------------------------
-- Tests: Eval - Attribute sets
-- ---------------------------------------------------------------------------
testEvalAttrs :: IO [Bool]
testEvalAttrs = do
putStrLn "eval/attrs"
sequence
[ runTest "simple select" $
assertEval "select" "{ a = 1; }.a" (VInt 1),
runTest "nested select" $
assertEval "nested" "{ a = { b = 2; }; }.a.b" (VInt 2),
runTest "select or default" $
assertEval "default" "{ a = 1; }.b or 42" (VInt 42),
runTest "has-attr true" $
assertEval "has-true" "{ a = 1; } ? a" (VBool True),
runTest "has-attr false" $
assertEval "has-false" "{ a = 1; } ? b" (VBool False),
runTest "nested attr path" $
assertEval "dot-path" "{ a.b.c = 1; }.a.b.c" (VInt 1),
-- A non-set operand of // fails with upstream's evalAttrs message
-- (eval.cc at 2.24.9), checked against nix-instantiate 2.33.2's
-- final error line. tryEval does not catch it.
runTest "update with a null left operand" $
assertEvalError "update-null-left" "null // {}" "expected a set but found null: null",
runTest "update with a null right operand" $
assertEvalError "update-null-right" "{} // null" "expected a set but found null: null",
runTest "update with an integer left operand" $
assertEvalError "update-int-left" "1 // {}" "expected a set but found an integer: 1",
runTest "update with a string right operand" $
assertEvalError "update-string-right" "{} // \"x\"" "expected a set but found a string: \"x\"",
-- 2.24.9's ExprOpUpdate::eval evaluates and checks the left operand
-- before it evaluates the right; 2.33.2 does the right first.
runTest "update with two non-set operands reports the left" $
assertEvalError "update-both" "1 // \"x\"" "expected a set but found an integer: 1",
runTest "update refuses a non-set left before evaluating the right" $
assertEvalError "update-left-first" "builtins.tryEval (null // throw \"b\")" "expected a set but found null: null",
runTest "update with a set left evaluates a throwing right" $
assertEval "update-right-throws" "(builtins.tryEval ({} // throw \"b\")).success" (VBool False),
runTest "update evaluates a throwing left first" $
assertEvalError "update-left-throws" "throw \"a\" // null" "a",
-- builtins.warn forces its message with forceString (prim_warn,
-- primops.cc at 2.24.9); final lines as nix-instantiate 2.33.2
-- prints them, and tryEval does not catch the refusal.
runTest "warn refuses an integer message" $
assertEvalError "warn-int" "builtins.warn 1 2" "expected a string but found an integer: 1",
runTest "warn refuses a Boolean message" $
assertEvalError "warn-bool" "builtins.warn true 2" "expected a string but found a Boolean: true",
runTest "warn refuses a null message" $
assertEvalError "warn-null" "builtins.warn null 2" "expected a string but found null: null",
runTest "warn refuses a float message" $
assertEvalError "warn-float" "builtins.warn 1.5 2" "expected a string but found a float: 1.5",
runTest "warn's refusal is not caught by tryEval" $
assertEvalError "warn-tryeval" "builtins.tryEval (builtins.warn 1 2)" "expected a string but found an integer: 1",
runTest "warn with a string message returns its value" $
assertEval "warn-string" "builtins.warn \"m\" 2" (VInt 2),
runTest "tryEval does not catch the update error" $
assertEvalError "update-tryEval" "builtins.tryEval (null // {})" "expected a set but found null: null"
]
-- ---------------------------------------------------------------------------
-- Tests: Eval - Value printer
-- ---------------------------------------------------------------------------
testValuePrinter :: IO [Bool]
testValuePrinter = do
putStrLn "eval/print"
tmpBase <- getTemporaryDirectory
let stringFound body = "expected a set but found a string: " <> body
setFound body = "cannot coerce a set to a string: " <> body
listFound body = "cannot coerce a list to a string: " <> body
runOfA n = "builtins.concatStringsSep \"\" (builtins.genList (x: \"a\") " <> T.pack (show (n :: Int)) <> ")"
elided what = " \x00AB" <> what <> " elided\x00BB"
marker inner = "\x00AB" <> inner <> "\x00BB"
interpolated source = "\"${" <> source <> "}\""
deeplyForced source = "let x = " <> source <> "; in builtins.seq (builtins.deepSeq x null) \"${x}\""
ints n = map (T.pack . show) [1 .. n :: Int]
listOfInts n = "[ " <> T.concat (map (<> " ") (ints n)) <> "]"
attrsOfInts n = "{ " <> T.concat [name <> " = " <> value <> "; " | (name, value) <- zip letters (ints n)] <> "}"
letters = map T.singleton ['a' ..]
shownInts = T.unwords [name <> " = " <> value <> ";" | (name, value) <- zip letters (ints 10)]
paddedName i = T.pack ('a' : if i < 10 then '0' : show i else show i)
paddedAttrs n = "{ " <> T.concat [paddedName i <> " = " <> T.pack (show i) <> "; " | i <- [1 .. n]] <> "}"
boundedList n = bounded "[" "]" (ints (min n 10)) (n - 10) "item" "items"
boundedAttrs n =
bounded "{" "}" [paddedName i <> " = " <> T.pack (show i) <> ";" | i <- [1 .. min n 10]] (n - 10) "attribute" "attributes"
bounded open close shown left single plural =
open <> " " <> T.concat (map (<> " ") shown) <> leftOut left single plural <> close
leftOut left single plural
| left <= 0 = ""
| left == 1 = marker ("1 " <> single <> " elided") <> " "
| otherwise = marker (T.pack (show left) <> " " <> plural <> " elided") <> " "
quickCheckPasses property = do
result <- QC.quickCheckWithResult QC.stdArgs {QC.chatty = False} property
pure (if QC.isSuccess result then Pass else Fail (T.pack (QC.output result)))
sequence
[ -- Values print as upstream's printValue prints them under
-- errorPrintOptions (print.cc and print-options.hh at 2.24.9), each
-- checked against nix-instantiate 2.33.2's final error line.
runTest "a path prints bare" $
assertEvalError "print-path" "{} // /foo/bar" "expected a set but found a path: /foo/bar",
runTest "a float prints with six significant digits" $
assertEvalError "print-float" "{} // 1234567.0" "expected a set but found a float: 1.23457e+06",
runTest "a string prints quoted with the lexer's escapes" $
assertEvalError
"print-escapes"
"{} // \"a\\nb\\\"c$d\\${e}\\t\\r\""
(stringFound "\"a\\nb\\\"c$d\\${e}\\t\\r\""),
runTest "a string of 1024 bytes prints whole" $
assertEvalError
"print-1024"
("{} // " <> runOfA 1024)
(stringFound ("\"" <> T.replicate 1024 "a" <> "\"")),
runTest "a longer string is cut after 1024 bytes" $
assertEvalError
"print-1025"
("{} // " <> runOfA 1025)
(stringFound ("\"" <> T.replicate 1024 "a" <> "\"" <> elided "1 byte")),
runTest "the bytes cut are counted" $
assertEvalError
"print-1100"
("{} // " <> runOfA 1100)
(stringFound ("\"" <> T.replicate 1024 "a" <> "\"" <> elided "76 bytes")),
runTest "a dollar shown last is escaped when the brace after it was cut" $
assertEvalError
"print-cut-dollar"
("{} // (" <> runOfA 1023 <> " + \"\\${\")")
(stringFound ("\"" <> T.replicate 1023 "a" <> "\\$\"" <> elided "1 byte")),
-- A set or list prints its entries, nothing forced, and is cut
-- once the print has shown ten attributes or ten items in all.
runTest "a set prints its attributes by name" $
assertEvalError "print-set" "\"${{ b = \"s\"; a = 1; }}\"" (setFound "{ a = 1; b = \"s\"; }"),
runTest "an empty set prints as a pair of braces" $
assertEvalError "print-empty-set" "\"${{}}\"" (setFound "{ }"),
runTest "_type and type print ahead of the other attributes" $
assertEvalError
"print-important-first"
"\"${{ z = 1; type = 2; _type = 3; a = 4; }}\""
(setFound "{ _type = 3; type = 2; a = 4; z = 1; }"),
runTest "an attribute name the lexer cannot read bare prints quoted" $
assertEvalError
"print-quoted-names"
"\"${{ \"a b\" = 1; \"if\" = 2; \"\" = 3; }}\""
(setFound "{ \"\" = 3; \"a b\" = 1; \"if\" = 2; }"),
runTest "an attribute never forced prints as upstream's thunk marker" $
assertEvalError "print-thunk" "\"${{ a = 1 + 1; }}\"" (setFound ("{ a = " <> marker "thunk" <> "; }")),
runTest "an eleventh attribute is counted, not shown" $
assertEvalError
"print-11-attrs"
(interpolated (attrsOfInts 11))
(setFound ("{ " <> shownInts <> " " <> marker "1 attribute elided" <> " }")),
runTest "attributes past the tenth are counted together" $
assertEvalError
"print-12-attrs"
(interpolated (attrsOfInts 12))
(setFound ("{ " <> shownInts <> " " <> marker "2 attributes elided" <> " }")),
runTest "an empty list prints as a pair of brackets" $
assertEvalError "print-empty-list" "\"${[ ]}\"" (listFound "[ ]"),
runTest "an eleventh item is counted, not shown" $
assertEvalError
"print-11-items"
(interpolated (listOfInts 11))
(listFound ("[ 1 2 3 4 5 6 7 8 9 10 " <> marker "1 item elided" <> " ]")),
runTest "items past the tenth are counted together" $
assertEvalError
"print-12-items"
(interpolated (listOfInts 12))
(listFound ("[ 1 2 3 4 5 6 7 8 9 10 " <> marker "2 items elided" <> " ]")),
runTestM "a list shows ten items and counts the rest" $
quickCheckPasses $
QC.forAll (QC.chooseInt (0, 25)) $ \n ->
evalNix (interpolated (listOfInts n)) QC.=== Left (listFound (boundedList n)),
runTestM "a set shows ten attributes and counts the rest" $
quickCheckPasses $
QC.forAll (QC.chooseInt (0, 25)) $ \n ->
evalNix (interpolated (paddedAttrs n)) QC.=== Left (setFound (boundedAttrs n)),
-- Forced values need the IO evaluator, which keeps them.
runTestM "a nested set's attributes count before the attribute holding it" $
assertEvalErrorIO
tmpBase
"print-nested-count"
(deeplyForced "{ a = { b = 1; c = 2; d = 3; e = 4; f = 5; g = 6; }; h = 7; i = 8; j = 9; k = 10; l = 11; }")
(setFound ("{ a = { b = 1; c = 2; d = 3; e = 4; f = 5; g = 6; }; h = 7; i = 8; j = 9; " <> marker "2 attributes elided" <> " }")),
runTestM "list items count over the whole print" $
assertEvalErrorIO
tmpBase
"print-items-across-lists"
(deeplyForced "{ a = [ 1 2 3 4 5 6 7 8 9 ]; b = [ 10 11 12 ]; }")
(setFound ("{ a = [ 1 2 3 4 5 6 7 8 9 ]; b = [ 10 " <> marker "2 items elided" <> " ]; }")),
runTestM "a set nested ten deep prints as an ellipsis" $
assertEvalErrorIO
tmpBase
"print-deep-set"
(deeplyForced (T.replicate 12 "{ a = " <> "1" <> T.replicate 12 "; }"))
(setFound (T.replicate 10 "{ a = " <> "{ ... }" <> T.replicate 10 "; }")),
runTestM "a list nested ten deep prints as an ellipsis" $
assertEvalErrorIO
tmpBase
"print-deep-list"
(deeplyForced (T.replicate 12 "[ " <> "1" <> T.replicate 12 " ]"))
(listFound (T.replicate 10 "[ " <> "[ ... ]" <> T.replicate 10 " ]")),
runTestM "an attribute being forced prints as upstream's recursion marker" $
assertEvalErrorIO
tmpBase
"print-blackhole"
"let x = { a = \"${x}\"; }; in x.a"
(setFound ("{ a = " <> marker "potential infinite recursion" <> "; }")),
runTest "a primop prints as upstream's primop marker" $
assertEvalError
"print-primop"
"{} // builtins.map"
("expected a set but found the built-in function 'map': " <> marker "primop map"),
runTest "a partially applied primop prints as upstream's marker" $
assertEvalError
"print-primop-app"
"{} // builtins.map (x: x)"
("expected a set but found the partially applied built-in function 'map': " <> marker "partially applied primop map"),
-- builtins.trace's defaults bound nothing and sort only by name.
runTest "a set prints in full by name as trace prints it"
$ assertRight "print-full-set" (evalNix "{ type = 1; a = 2; }")
$ assertEqual "print-full-set" "{ a = 2; type = 1; }" . printValue PrintInFull,
runTest "a long list prints in full as trace prints it"
$ assertRight "print-full-list" (evalNix (listOfInts 12))
$ assertEqual "print-full-list" "[ 1 2 3 4 5 6 7 8 9 10 11 12 ]" . printValue PrintInFull,
-- builtins.trace prints a non-string through the same printer with
-- upstream's default options.
runTest "a float prints in full as trace prints it" $
assertEqual "print-full-float" "1.23457e+06" (printValue PrintInFull (VFloat 1234567.0)),
runTestM "a string printed in full reads back as itself" $ do
result <-
QC.quickCheckWithResult QC.stdArgs {QC.chatty = False} $
QC.forAll genEscapable $ \text ->
evalNix (printValue PrintInFull (mkStr text)) QC.=== Right (mkStr text)
pure (if QC.isSuccess result then Pass else Fail (T.pack (QC.output result)))
]
-- | Text built from what the string printer escapes (quotes, backslashes,
-- the escaped control characters, a dollar before a brace) among plain and
-- multi-byte characters. @${@ is a piece of its own so the escape that
-- needs lookahead comes up often.
genEscapable :: QC.Gen Text
genEscapable =
T.concat <$> QC.listOf (QC.elements ["\"", "\\", "\n", "\r", "\t", "$", "{", "}", "${", "a", " ", "\233", "\128512"])
-- ---------------------------------------------------------------------------
-- Tests: Eval - + and string coercion errors
-- ---------------------------------------------------------------------------
-- | @+@ and string coercion fail with upstream's messages, those of
-- @ExprConcatStrings::eval@ and @coerceToString@ (eval.cc at 2.24.9): the
-- type as @showType@ names it, and after a failed coercion the value as
-- @errorPrintOptions@ prints it. Each expected message is nix-instantiate
-- 2.33.2's final error line for the same expression.
testCoercionErrors :: IO [Bool]
testCoercionErrors = do
putStrLn "eval/coercion"
tmpBase <- getTemporaryDirectory
let testDir = tmpBase </> "nova-nix-test-coercion"
setup = createDirectoryIfMissing True (testDir </> "d")
cleanup = do
exists <- doesDirectoryExist testDir
when exists (removeDirectoryRecursive testDir)
withContext = "\"${builtins.toFile \"a\" \"b\"}\""
primopMarker = "\x00ABprimop map\x00BB"
failsIO label source expected = runTestM label (assertEvalErrorIO testDir label source expected)
bracket_ setup cleanup . sequence $
[ -- An integer or float on the left makes + arithmetic, and a right
-- operand that is no number is named.
runTest "an integer plus a string cannot be added" $
assertEvalError "add-int-string" "1 + \"a\"" "cannot add a string to an integer",
runTest "a float plus a string cannot be added" $
assertEvalError "add-float-string" "1.0 + \"a\"" "cannot add a string to a float",
runTest "an integer plus null cannot be added" $
assertEvalError "add-int-null" "1 + null" "cannot add null to an integer",
failsIO "an integer plus a string with context names the context" ("1 + " <> withContext) "cannot add a string with context to an integer",
runTest "an integer plus a primop names the primop" $
assertEvalError "add-int-primop" "1 + builtins.map" "cannot add the built-in function 'map' to an integer",
runTest "an integer plus a partial application names its primop" $
assertEvalError
"add-int-primop-app"
"1 + builtins.map (x: x)"
"cannot add the partially applied built-in function 'map' to an integer",
-- Anything else on the left makes + concatenation, each operand
-- coerced as interpolation coerces it.
runTest "a primop on the left does not coerce" $
assertEvalError "add-primop-int" "builtins.map + 1" ("cannot coerce the built-in function 'map' to a string: " <> primopMarker),
failsIO "a string with context plus an integer refuses the integer" (withContext <> " + 1") "cannot coerce an integer to a string: 1",
runTest "a Boolean on the left fails to coerce rather than to add" $
assertEvalError "add-bool-int" "true + 1" "cannot coerce a Boolean to a string: true",
runTest "a string plus a float refuses the float" $
assertEvalError "add-string-float" "\"a\" + 1.5" "cannot coerce a float to a string: 1.5",
runTest "a string plus a list refuses the list" $
assertEvalError "add-string-list" "\"a\" + [ ]" "cannot coerce a list to a string: [ ]",
runTest "a path plus an integer refuses the integer" $
assertEvalError "add-path-int" "./d + 1" "cannot coerce an integer to a string: 1",
failsIO
"a path plus a string with context is refused"
("./d + " <> withContext)
"a string that refers to a store path cannot be appended to a path",
-- The left operand is dealt with before the right is evaluated.
runTest "a set on the left fails before the right is evaluated" $
assertEvalError "add-left-first" "{} + throw \"b\"" "cannot coerce a set to a string: { }",
runTest "tryEval does not catch a failed coercion" $
assertEvalError "add-tryEval" "builtins.tryEval ({} + throw \"b\")" "cannot coerce a set to a string: { }",
-- Upstream copies a path into the store only when the left operand
-- is a string, so a set's outPath on the left is its own text.
runTestM "a set on the left contributes its path without a store copy" $ do
result <- evalNixIO testDir "let s = { outPath = ./d; } + \"x\"; in builtins.getContext s == {} && s == toString ./d + \"x\""
pure (assertRight "add-set-path" result (assertEqual "add-set-path" (VBool True))),
-- Interpolation, toString and concatStringsSep coerce the same way.
runTest "an interpolated set without outPath prints the set" $
assertEvalError "interp-set" "\"${{ a = 1; b = \"s\"; }}\"" "cannot coerce a set to a string: { a = 1; b = \"s\"; }",
runTest "an interpolated integer is refused" $
assertEvalError "interp-int" "\"v${1}\"" "cannot coerce an integer to a string: 1",
runTest "toString of a primop is refused" $
assertEvalError "tostring-primop" "builtins.toString builtins.map" ("cannot coerce the built-in function 'map' to a string: " <> primopMarker),
runTest "toString of a partial application is refused" $
assertEvalError
"tostring-primop-app"
"builtins.toString (builtins.map (x: x))"
"cannot coerce the partially applied built-in function 'map' to a string: \x00ABpartially applied primop map\x00BB",
-- Upstream prints a lambda's source position after the word, which
-- a nova-nix function value does not carry.
runTest "toString of a lambda is refused" $
assertEvalError "tostring-lambda" "builtins.toString (x: x)" "cannot coerce a function to a string: \x00ABlambda\x00BB",
runTest "toString of a set without outPath is refused" $
assertEvalError "tostring-set" "builtins.toString { }" "cannot coerce a set to a string: { }",
runTest "concatStringsSep refuses an integer element" $
assertEvalError "concatsep-int" "builtins.concatStringsSep \",\" [ 1 ]" "cannot coerce an integer to a string: 1",
-- An interpolated path literal concatenates as + does with a path
-- first, and refuses a context only after every piece coerced.
runTest "a path segment refuses a set" $
assertEvalError "path-segment-set" "./a${{}}" "cannot coerce a set to a string: { }",
failsIO
"a later path segment that fails to coerce is reported over an earlier one's context"
("./a${" <> withContext <> "}${1}")
"cannot coerce an integer to a string: 1",
-- A selection path names the type it cannot index as showType does
-- (attr-path.cc at 2.24.9).
runTest "a selection path through a function names it" $
assertRight "attrpath-functions" (evalNix "{ a = builtins.map; b = builtins.map (x: x); c = x: x; }") $ \root ->
assertEqual
"attrpath-functions"
( Right
[ Left "the expression selected by the selection path 'a.x' should be a set but is the built-in function 'map'",
Left "the expression selected by the selection path 'b.x' should be a set but is the partially applied built-in function 'map'",
Left "the expression selected by the selection path 'c.x' should be a set but is a function"
]
)
(runPureEval (mapM (`selectAttrPath` root) ["a.x", "b.x", "c.x"]))
]
-- ---------------------------------------------------------------------------
-- Tests: Eval - Result printer
-- ---------------------------------------------------------------------------
-- | What @nova-nix eval@ prints for a value. Each expected value is the
-- output of @nix-instantiate --eval --readonly-mode -E@ (Nix 2.33.2) for
-- the same expression, less the newline the command writes after it.
testResultPrinter :: IO [Bool]
testResultPrinter = do
putStrLn "eval/print-result"
tmpBase <- getTemporaryDirectory
let testDir = tmpBase </> "nova-nix-test-print-result"
notUtf8 = "a" <> BS.singleton 0xfc <> "b"
setup = do
createDirectoryIfMissing True testDir
BS.writeFile (testDir </> "latin1") notUtf8
cleanup = do
exists <- doesDirectoryExist testDir
when exists (removeDirectoryRecursive testDir)
printsIO label source expected = runTestM label $ do
result <- evalNixIO testDir source
pure (assertRight label result (assertEqual label expected . renderResult))
prints label source expected =
runTest label (assertRight label (evalNix source) (assertEqual label expected . renderResult))
floatPrints (source, expected) =
prints ("a float prints in ostream form: " <> source) source expected
bracket_ setup cleanup . sequence $
[ printsIO
"a string prints its bytes, not U+FFFD for one that is not UTF-8"
"builtins.readFile ./latin1"
("\"" <> notUtf8 <> "\""),
prints
"a string escapes each of upstream's characters and a dollar before a brace"
"\"\\\" \\\\ \\n \\r \\t \\${ $\""
"\"\\\" \\\\ \\n \\r \\t \\${ $\"",
prints "a lone dollar prints as it is" "\"$\"" "\"$\"",
prints
"an attribute name past ASCII prints quoted, as its bytes"
"{ \"\233\" = 1; }"
("{ \"" <> BS.pack [0xc3, 0xa9] <> "\" = 1; }"),
prints
"an attribute name the lexer cannot read bare prints quoted"
"{ \"a b\" = 1; \"if\" = 2; \"\" = 3; \"1x\" = 4; or = 5; \"a-b'\" = 6; _x = 7; \"-a\" = 8; \"'a\" = 9; \"x\\\"y\" = 10; }"
"{ \"\" = 3; \"'a\" = 9; \"-a\" = 8; \"1x\" = 4; _x = 7; \"a b\" = 1; a-b' = 6; \"if\" = 2; or = 5; \"x\\\"y\" = 10; }",
printsIO
"nested lists and sets print their strings and names the same way"
"let v = [ (builtins.readFile ./latin1) { \"b c\" = [ \"$\" \"\\${\" ]; } ]; in builtins.deepSeq v v"
("[ \"" <> notUtf8 <> "\" { \"b c\" = [ \"$\" \"\\${\" ]; } ]"),
prints "an element never forced prints as upstream's thunk marker" "[ (1 + 1) ]" "[ <CODE> ]",
prints "a lambda prints as upstream's marker" "x: x" "<LAMBDA>",
prints "a primop prints as upstream's marker" "builtins.map" "<PRIMOP>",
prints "a partially applied primop prints as upstream's marker" "builtins.map (x: x)" "<PRIMOP-APP>",
prints "a regex builtin given its pattern is a partial application" "builtins.match \"a\"" "<PRIMOP-APP>",
runTestM "a printed string reads back as itself" $
quickCheckPasses $
QC.forAll genEscapable $ \text ->
readsBack (renderResult (mkStr text)) (mkStr text),
runTestM "a printed attribute name reads back as itself" $
quickCheckPasses $
QC.forAll genAttrName $ \name ->
let attrs = VAttrs (attrSetFromMap (Map.singleton name (evaluated (VInt 1))))
in readsBack ("builtins.head (builtins.attrNames " <> renderResult attrs <> ")") (mkStr name)
]
<> map floatPrints floatCases
where
renderResult = BL.toStrict . BB.toLazyByteString . printAmbiguous
readsBack printed expected = case TE.decodeUtf8' printed of
Left _ -> QC.counterexample "the printed bytes are not UTF-8" False
Right source -> evalNix source QC.=== Right expected
quickCheckPasses property = do
result <- QC.quickCheckWithResult QC.stdArgs {QC.chatty = False} property
pure (if QC.isSuccess result then Pass else Fail (T.pack (QC.output result)))
-- Upstream unary minus is 0 - x, so -0.0 written as a literal is
-- positive zero there; fromJSON yields a negative one.
floatCases =
[ ("1.0", "1"),
("1.5", "1.5"),
("0.1", "0.1"),
("1.0e20", "1e+20"),
("1.23456789", "1.23457"),
("builtins.fromJSON \"-0.0\"", "-0"),
("1234567.0", "1.23457e+06")
]
-- | Attribute names built from what decides whether one prints bare: the
-- identifier characters in and out of first place, the reserved keywords
-- and @or@, which is not one, and characters only a quoted name holds.
genAttrName :: QC.Gen Text
genAttrName =
T.concat <$> QC.listOf (QC.elements ["a", "Z", "_", "0", "'", "-", " ", "\"", "\\", "${", ".", "\233", "if", "in", "inherit", "rec", "or"])
-- ---------------------------------------------------------------------------
-- Tests: Eval - Recursive attribute sets
-- ---------------------------------------------------------------------------
testEvalRecAttrs :: IO [Bool]
testEvalRecAttrs = do
putStrLn "eval/rec-attrs"
sequence
[ runTest "rec self-reference" $
assertEval "rec-self" "rec { a = 1; b = a + 1; }.b" (VInt 2),
runTest "rec mutual reference" $
assertEval "rec-mutual" "rec { a = 1; b = a; }.b" (VInt 1),
-- A plain inherit inside a fallback (nested-path) rec/let must reference
-- the OUTER binding, not self-reference into infinite recursion.
runTest "inherit in fallback rec set references outer" $
assertEval "inherit-fallback-rec" "let n = 7; in (rec { inherit n; a.b = 1; }).n" (VInt 7),
runTest "inherit in fallback let references outer" $
assertEval "inherit-fallback-let" "let x = 5; in let a.b = 1; inherit x; in x" (VInt 5),
-- Guard the fix: a genuine sibling reference in a fallback rec still resolves.
runTest "sibling reference survives in fallback rec" $
assertEval "sibling-fallback-rec" "(rec { a = 1; b = a + 10; c.d = 2; }).b" (VInt 11),
-- Dynamic rec-set keys evaluate in the rec env (C++ Nix env2): a key may
-- reference an enclosing var or a static sibling, and must not abort.
runTest "dynamic key references enclosing var" $
assertEval "dyn-key-enclosing" "let k = \"x\"; in (rec { p.q = 1; ${k} = 2; }).x" (VInt 2),
runTest "dynamic key resolves the correct enclosing slot" $
assertEval "dyn-key-slot" "let a = \"A\"; b = \"B\"; in let c = \"C\"; in (rec { p.q = 1; ${b} = 2; }).B" (VInt 2),
runTest "dynamic key references a static rec sibling" $
assertEval "dyn-key-sibling" "(rec { a = \"b\"; ${a} = 1; }).b" (VInt 1)
]
-- ---------------------------------------------------------------------------
-- Tests: Eval - Lists
-- ---------------------------------------------------------------------------
testEvalLists :: IO [Bool]
testEvalLists = do
putStrLn "eval/lists"
sequence
[ runTest "list head" $
assertEval "head" "builtins.head [ 1 2 3 ]" (VInt 1),
runTest "list length" $
assertEval "length" "builtins.length [ 1 2 3 ]" (VInt 3),
runTest "list concat" $
assertEval "concat" "builtins.length ([ 1 ] ++ [ 2 3 ])" (VInt 3),
runTest "head forces only the first element" $
assertEval "head-lazy" "builtins.head [ 1 (throw \"x\") ]" (VInt 1),
runTest "tail keeps every element after the first" $
assertEval "tail" "builtins.tail [ 1 2 3 ] == [ 2 3 ]" (VBool True),
runTest "tail of a tail" $
assertEval "tail-tail" "builtins.tail (builtins.tail [ 1 2 3 ]) == [ 3 ]" (VBool True),
runTest "tail of a one-element list is empty" $
assertEval "tail-one" "builtins.tail [ 1 ] == [ ]" (VBool True),
runTest "tail forces none of the elements" $
assertEval "tail-lazy" "builtins.length (builtins.tail [ (throw \"a\") (throw \"b\") ])" (VInt 1),
runTest "head of a tail" $
assertEval "head-tail" "builtins.head (builtins.tail [ 1 2 3 ])" (VInt 2),
-- The messages 2.24.9 raises: head is its elemAt at index 0 and
-- tail has its own (primops.cc), a non-list fails in forceList
-- (eval-inline.hh), and tryEval catches neither. 2.26.0 reworded
-- both empty-list messages, so nix-instantiate 2.33.2 prints
-- "'builtins.head' called on an empty list" and the same for tail.
runTest "head of an empty list" $
assertEvalError "head-empty" "builtins.head [ ]" "list index 0 is out of bounds",
runTest "tail of an empty list" $
assertEvalError "tail-empty" "builtins.tail [ ]" "'tail' called on an empty list",
runTest "head of the empty list tail returns" $
assertEvalError "head-tail-empty" "builtins.head (builtins.tail [ 1 ])" "list index 0 is out of bounds",
runTest "tail of the empty list tail returns" $
assertEvalError "tail-tail-empty" "builtins.tail (builtins.tail [ 1 ])" "'tail' called on an empty list",
runTest "head of an integer" $
assertEvalError "head-int" "builtins.head 1" "expected a list but found an integer: 1",
runTest "head of a string" $
assertEvalError "head-string" "builtins.head \"x\"" "expected a list but found a string: \"x\"",
runTest "tail of null" $
assertEvalError "tail-null" "builtins.tail null" "expected a list but found null: null",
runTest "tail of a Boolean" $
assertEvalError "tail-bool" "builtins.tail true" "expected a list but found a Boolean: true",
runTest "tryEval does not catch head of an empty list" $
assertEvalError "head-empty-tryeval" "builtins.tryEval (builtins.head [ ])" "list index 0 is out of bounds",
runTest "tryEval does not catch tail of a non-list" $
assertEvalError "tail-int-tryeval" "builtins.tryEval (builtins.tail 1)" "expected a list but found an integer: 1",
runTest "length of an integer" $
assertEvalError "length-int" "builtins.length 1" "expected a list but found an integer: 1",
runTest "length of null" $
assertEvalError "length-null" "builtins.length null" "expected a list but found null: null",
runTestM "drop and index on a C list agree with the materialized list" $ do
result <-
QC.quickCheckWithResult QC.stdArgs {QC.chatty = False} $
QC.forAll genCase $ \(values, drops, index) ->
QC.ioProperty $ do
ptrs <- mapM cthunkNewComputedInt values
let dropped = foldl' (flip clistDrop) (clistFromThunks ptrs) drops
model = foldl' (flip drop) ptrs drops
modelAt i
| i < 0 = Nothing
| otherwise = listToMaybe (drop i model)
pure $
(clistThunks dropped, clistLen dropped, clistIndex dropped index)
QC.=== (model, length model, modelAt index)
pure (if QC.isSuccess result then Pass else Fail (T.pack (QC.output result)))
]
where
-- Short lists and a few drops, so the drops and the index land on
-- both sides of the bounds, negatives included.
genCount = QC.choose (-2, 12)
genCase = (,,) <$> QC.resize 10 (QC.listOf QC.arbitrary) <*> QC.resize 4 (QC.listOf genCount) <*> genCount
-- ---------------------------------------------------------------------------
-- Tests: Eval - Lambda
-- ---------------------------------------------------------------------------
testEvalLambda :: IO [Bool]
testEvalLambda = do
putStrLn "eval/lambda"
sequence
[ runTest "identity" $
assertEval "id" "(x: x) 42" (VInt 42),
runTest "closure" $
assertEval "closure" "let f = x: x + 1; in f 5" (VInt 6),
runTest "set pattern" $
assertEval "set-pat" "({ a, b }: a + b) { a = 1; b = 2; }" (VInt 3),
runTest "default param" $
assertEval "default" "({ a ? 10 }: a) { }" (VInt 10),
-- Zero-formal set patterns marshal count 0 / entries NULL; the
-- second force of the same lambda thunk re-reads the entries and
-- must not underflow the unsigned count.
runTest "empty formals forced twice" $
assertEval "empty-formals" "let f = {}: 1; in f {} + f {}" (VInt 2),
runTest "ellipsis-only formals forced twice" $
assertEval "ellipsis-only" "let f = { ... }: 1; in f {} + f {}" (VInt 2),
runTest "named empty formals forced twice" $
assertEval "named-empty" "let f = args@{ ... }: 1; in f {} + f {}" (VInt 2)
]
-- ---------------------------------------------------------------------------
-- Tests: Eval - With
-- ---------------------------------------------------------------------------
testEvalWith :: IO [Bool]
testEvalWith = do
putStrLn "eval/with"
sequence
[ runTest "with basic" $
assertEval "with" "with { a = 1; }; a" (VInt 1),
runTest "with lexical wins" $
assertEval "lexical" "let a = 1; in with { a = 2; }; a" (VInt 1),
-- EWithVar: with-scoped variable inside lambda (closure trimming must preserve with-scopes)
runTest "with inside lambda" $
assertEval
"with-lambda"
"with { a = 1; }; let f = x: a + x; in f 2"
(VInt 3),
-- Nested with: inner with wins
runTest "nested with inner wins" $
assertEval
"nested-with"
"with { a = 1; }; with { a = 2; }; a"
(VInt 2),
-- Let shadows with
runTest "let shadows with" $
assertEval
"let-shadows-with"
"with { a = 1; }; let a = 2; in a"
(VInt 2),
-- A fallback (nested-path) let/rec binding shadows with too: the
-- NameBarrier must not be upgraded to a with-variable.
runTest "barrier let shadows with" $
assertEval
"barrier-shadows-with"
"let a.b = 1; x = 42; in with { x = 99; }; x"
(VInt 42),
runTest "barrier rec binding shadows with" $
assertEval
"barrier-rec-shadows-with"
"with { q = 99; }; (rec { c.d = 1; q = 5; b = q; }).b"
(VInt 5),
-- Static globals bind at parse time; with never shadows them.
runTest "with cannot shadow global map" $
assertEval
"with-global-map"
"builtins.typeOf (with { map = 42; }; map)"
(mkStr "lambda"),
-- fetchurl is NOT an upstream global: the with-scope must win, or
-- nixpkgs-style 'with pkgs; fetchurl' would bind the builtin.
runTest "with shadows non-global fetchurl" $
assertEval
"with-fetchurl"
"with { fetchurl = 42; }; fetchurl"
(VInt 42),
-- Builtin fallback: builtins still accessible inside with
runTest "with builtin fallback" $
assertEval
"with-builtin"
"with { a = 1; }; true"
(VBool True),
-- Builtin attr fallback: builtins.length still works inside with
runTest "with builtin attr fallback" $
assertEval
"with-builtin-attr"
"with { a = 1; }; builtins.length [1 2 3]"
(VInt 3),
-- With in rec attrs
runTest "with in rec attrs" $
assertEval
"with-rec"
"with { a = 1; }; rec { b = a + 1; c = b + 1; }.c"
(VInt 3),
-- AST test: parse "with a; b" produces EWithVar
runTest "parse with produces EWithVar" $
assertRight "with-ast" (parseNixWithScope (withGlobals ["a"]) testBaseDir "<test>" "with a; b") $ \case
EWith (EVar "a") (EWithVar "b") -> Pass
other -> Fail ("expected EWith (EVar a) (EWithVar b), got: " <> T.pack (show other)),
-- AST test: formal wins over with
runTest "parse lambda formal wins over with" $
assertRight "formal-wins" (parseNixWithScope (withGlobals ["a"]) testBaseDir "<test>" "x: with a; x") $ \case
ELambda _ (EWith _ (EResolvedVar 0 0)) _ -> Pass
other -> Fail ("expected formal to win, got: " <> T.pack (show other)),
-- Trimming test: lambda inside with gets CapturesWithScopes
runTest "with lambda trimmed with CapturesWithScopes" $
assertRight "with-trim" (parseNixWithScope (withGlobals ["a"]) testBaseDir "<test>" "with a; x: b + x") $ \case
EWith _ (ELambda _ _ (CapturesWithScopes _)) -> Pass
other -> Fail ("expected CapturesWithScopes, got: " <> T.pack (show other))
]
-- ---------------------------------------------------------------------------
-- Tests: Eval - Builtins
-- ---------------------------------------------------------------------------
testEvalBuiltins :: IO [Bool]
testEvalBuiltins = do
putStrLn "eval/builtins"
sequence
[ runTest "typeOf int" $
assertEval "typeOf-int" "builtins.typeOf 42" (mkStr "int"),
runTest "typeOf string" $
assertEval "typeOf-str" "builtins.typeOf \"hi\"" (mkStr "string"),
runTest "isNull true" $
assertEval "isNull-t" "builtins.isNull null" (VBool True),
runTest "isNull false" $
assertEval "isNull-f" "builtins.isNull 1" (VBool False),
runTest "stringLength" $
assertEval "strlen" "builtins.stringLength \"hello\"" (VInt 5),
runTest "a builtin taking a string coerces a set as upstream's coerceToString" $
assertEval "strlen-outpath" "builtins.stringLength { outPath = \"abc\"; }" (VInt 3)
`andThen` assertEval "strlen-tostring" "builtins.stringLength { __toString = s: \"ab\"; }" (VInt 2)
`andThen` assertEval "substring-outpath" "builtins.substring 1 1 { outPath = \"abc\"; }" (mkStr "b")
`andThen` assertEval "discard-outpath" "builtins.unsafeDiscardStringContext { outPath = \"abc\"; }" (mkStr "abc")
`andThen` assertEval "discard-output-outpath" "builtins.unsafeDiscardOutputDependency { outPath = \"abc\"; }" (mkStr "abc"),
runTest "a builtin taking a string refuses what coerceToString refuses" $
assertEvalError "strlen-int" "builtins.stringLength 1" "cannot coerce an integer to a string: 1"
`andThen` assertEvalError "substring-int" "builtins.substring 0 1 1" "cannot coerce an integer to a string: 1"
`andThen` assertEvalError "discard-int" "builtins.unsafeDiscardStringContext 1" "cannot coerce an integer to a string: 1"
`andThen` assertEvalError "discard-output-int" "builtins.unsafeDiscardOutputDependency 1" "cannot coerce an integer to a string: 1"
`andThen` assertEvalError "add-output-int" "builtins.addDrvOutputDependencies 1" "cannot coerce an integer to a string: 1",
-- Lexer edge cases pinned to upstream: $${ is literal, ''' escapes to '', \q -> q.
runTest "$${ does not interpolate (double dollar is literal)" $
assertEval "dollar-dollar-str" "builtins.stringLength \"a$${b}c\"" (VInt 7),
runTest "$${ literal in indented string" $
assertEval "dollar-dollar-ind" "builtins.stringLength ''a$${b}c''" (VInt 7),
runTest "''' escapes two quotes in indented string" $
assertEval "triple-quote" "''a'''b'' == \"a''b\"" (VBool True),
runTest "unknown escape drops backslash (regular string)" $
assertEval "esc-drop-str" "\"a\\qb\" == \"aqb\"" (VBool True),
runTest "unknown escape drops backslash (indented string)" $
assertEval "esc-drop-ind" "''a''\\qb'' == \"aqb\"" (VBool True),
-- Indentation stripping is upstream's stripIndentation rule for
-- rule (parser-state.hh at 2.24.9), every case checked against
-- nix-instantiate 2.33.2. The scan skips an escape, so the spaces
-- after an escaped newline are never measured; the strip runs over
-- escapes like any literal, so those spaces are stripped by the
-- minimum measured elsewhere. An interpolation is opaque to both.
runTest "escaped newline: following spaces are stripped, not measured" $
assertEval "ind-esc-nl-strip" "'' a''\\n b''" (mkStr "a\nb"),
runTest "escaped newline: a shallower line after it is not the minimum" $
assertEval "ind-esc-nl-indent" "''\n x''\\n y\n z''" (mkStr "x\ny\nz"),
runTest "escaped newline at line start keeps the next line stripped" $
assertEval "ind-esc-nl-start" "''\n ''\\n b''" (mkStr "\nb"),
runTest "interpolated newline leaves the next chunk mid-line" $
assertEval "ind-interp-nl" "''\n ${\"\\n\"} b''" (mkStr "\n b"),
-- The minimum starts at a sentinel, so a string with no measured
-- line loses every leading space (#220).
runTest "blank line then a spaces-only line strips to the newline" $
assertEval "ind-blank-spaces" "''\n\n ''" (mkStr "\n"),
runTest "spaces-only line strips to nothing" $
assertEval "ind-spaces-only" "''\n ''" (mkStr ""),
runTest "spaces between opener and closer strip to nothing" $
assertEval "ind-spaces-same-line" "'' ''" (mkStr ""),
-- Only a space is indentation: a tab fixes the minimum at its
-- column and survives.
runTest "tabs are content, not indentation" $
assertEval "ind-tabs" "''\n\t\ta\n\t\tb\n''" (mkStr "\t\ta\n\t\tb\n"),
runTest "a tab after the opener is content" $
assertEval "ind-opener-tab" "''\t\n a\n''" (mkStr "\t\n a\n"),
-- The last part sheds a final line of spaces after stripping; the
-- rule runs on that part alone.
runTest "closing indentation after a blank line is dropped" $
assertEval "ind-closer-spaces" "''\n a\n\n ''" (mkStr "a\n\n"),
runTest "closing indentation after an interpolation is dropped" $
assertEval "ind-closer-after-interp" "''\n ${\"v\"}\n ''" (mkStr "v\n"),
runTest "spaces after an interpolation on the last line survive" $
assertEval "ind-interp-last-line" "''\n ${\"v\"} ''" (mkStr "v "),
-- The opener consumes its own line's trailing spaces and newline.
runTest "spaces before the opener's newline are not a line" $
assertEval "ind-opener-spaces" "'' \n a\n''" (mkStr "a\n"),
runTest "an opener line of spaces then the closer is empty" $
assertEval "ind-opener-only" "'' \n''" (mkStr ""),
runTest "toString int" $
assertEval "toStr" "builtins.toString 42" (mkStr "42")
]
-- | A list coerced to a string, as upstream's @coerceToString@ joins one
-- under @coerceMore@ (eval.cc at 2.24.9). Each expected string is
-- nix-instantiate 2.24.9's.
testListCoercion :: IO [Bool]
testListCoercion = do
putStrLn "eval/list-coercion"
let joins label source expected = runTest label (assertEval label ("builtins.toString " <> source) (mkStr expected))
bytes = BS.pack <$> QC.listOf QC.arbitrary
quickCheckPasses property = do
result <- QC.quickCheckWithResult QC.stdArgs {QC.chatty = False} property
pure (if QC.isSuccess result then Pass else Fail (T.pack (QC.output result)))
sequence
[ joins "elements are joined with spaces" "[ 1 \"a\" 2 ]" "1 a 2",
joins "an empty list element takes no space after it" "[ [ ] 1 ]" "1",
joins "an empty list between two elements leaves one space" "[ 1 [ ] 2 ]" "1 2",
joins "an element before an empty list keeps its space" "[ 1 [ ] ]" "1 ",
joins "a list holding an empty list is not empty" "[ [ [ ] ] 1 ]" " 1",
joins "an empty string element keeps its space" "[ \"\" 1 ]" " 1",
joins "nested lists flatten through the same join" "[ [ 1 [ 2 3 ] ] 4 ]" "1 2 3 4",
joins "a __toString may return a list" "{ __toString = s: [ 1 2 ]; }" "1 2",
joins "an outPath may be a list" "{ outPath = [ 1 2 ]; }" "1 2",
joins "an element whose __toString is an empty list keeps its space" "[ { __toString = s: [ ]; } 1 ]" " 1",
runTest "interpolation still refuses a list" $
assertEvalError "interp-list" "\"${[ 1 2 ]}\"" "cannot coerce a list to a string: [ 1 2 ]",
runTestM "without empty lists the join is intercalate" $
quickCheckPasses $
QC.forAll (QC.listOf bytes) $ \parts ->
joinCoercedList [(part, False) | part <- parts] QC.=== BS.intercalate " " parts,
runTestM "an empty list before any element changes nothing" $
quickCheckPasses $
QC.forAll (QC.listOf bytes) $ \before ->
QC.forAll (QC.listOf1 bytes) $ \after ->
let marked = map (,False)
in joinCoercedList (marked before <> [("", True)] <> marked after) QC.=== joinCoercedList (marked (before <> after))
]
-- ---------------------------------------------------------------------------
-- Tests: Eval - Errors
-- ---------------------------------------------------------------------------
testEvalErrors :: IO [Bool]
testEvalErrors = do
putStrLn "eval/errors"
sequence
[ runTest "type error in add (set + list)" $
assertEvalFail "type-add" "{} + []",
runTest "call non-function" $
assertEvalFail "call-non" "42 1",
runTest "builtins.throw" $
assertEvalFail "throw" "builtins.throw \"boom\""
]
-- ---------------------------------------------------------------------------
-- Tests: Eval - Higher-order builtins
-- ---------------------------------------------------------------------------
testEvalHigherOrder :: IO [Bool]
testEvalHigherOrder = do
putStrLn "eval/higher-order"
sequence
[ -- map
runTest "map basic" $
assertEval "map" "builtins.map (x: x + 1) [ 1 2 3 ] == [ 2 3 4 ]" (VBool True),
runTest "map identity" $
assertEval "map-id" "builtins.map (x: x) [ 1 2 ] == [ 1 2 ]" (VBool True),
runTest "map empty" $
assertEval "map-empty" "builtins.map (x: x) [ ]" (VList emptyCList),
runTest "map lazy" $
assertEval "map-lazy" "let xs = builtins.map (x: x * 2) [ 1 (throw \"boom\") 3 ]; in builtins.elemAt xs 0" (VInt 2),
-- filter
runTest "filter match" $
assertEval "filter" "builtins.filter (x: x == 2) [ 1 2 3 ] == [ 2 ]" (VBool True),
runTest "filter none" $
assertEval "filter-none" "builtins.filter (x: false) [ 1 2 ] == [ ]" (VBool True),
-- foldl'
runTest "foldl' sum" $
assertEval "foldl-sum" "builtins.foldl' (a: b: a + b) 0 [ 1 2 3 ]" (VInt 6),
runTest "foldl' string concat" $
assertEval "foldl-str" "builtins.foldl' (a: b: a + b) \"\" [ \"x\" \"y\" \"z\" ]" (mkStr "xyz"),
runTest "foldl' empty" $
assertEval "foldl-empty" "builtins.foldl' (a: b: a + b) 0 [ ]" (VInt 0),
-- genList
runTest "genList basic" $
assertEval "genList" "builtins.genList (i: i * 2) 4 == [ 0 2 4 6 ]" (VBool True),
runTest "genList zero" $
assertEval "genList-0" "builtins.genList (i: i) 0" (VList emptyCList),
runTest "genList lazy" $
assertEval "genList-lazy" "let xs = builtins.genList (i: if i == 0 then 42 else throw \"boom\") 5; in builtins.elemAt xs 0" (VInt 42),
-- sort
runTest "sort ints" $
assertEval "sort" "builtins.sort (a: b: a < b) [ 3 1 2 ] == [ 1 2 3 ]" (VBool True),
runTest "sort already sorted" $
assertEval "sort-sorted" "builtins.sort (a: b: a < b) [ 1 2 3 ] == [ 1 2 3 ]" (VBool True),
-- Stable: comparator-equal elements keep their input order (std::stable_sort).
runTest "sort is stable across ties" $
assertEval
"sort-stable"
"builtins.sort (a: b: a.k < b.k) [ { k = 1; v = 1; } { k = 0; v = 2; } { k = 1; v = 3; } { k = 0; v = 4; } ] == [ { k = 0; v = 2; } { k = 0; v = 4; } { k = 1; v = 1; } { k = 1; v = 3; } ]"
(VBool True),
runTest "sort preserves order of all-equal elements" $
assertEval
"sort-stable-all"
"builtins.sort (a: b: a.k < b.k) [ { k = 0; v = 1; } { k = 0; v = 2; } { k = 0; v = 3; } ] == [ { k = 0; v = 1; } { k = 0; v = 2; } { k = 0; v = 3; } ]"
(VBool True),
-- concatMap
runTest "concatMap" $
assertEval "concatMap" "builtins.concatMap (x: [ x (x * 2) ]) [ 1 2 ] == [ 1 2 2 4 ]" (VBool True),
-- any
runTest "any true" $
assertEval "any-t" "builtins.any (x: x == 2) [ 1 2 3 ]" (VBool True),
runTest "any false" $
assertEval "any-f" "builtins.any (x: x == 5) [ 1 2 3 ]" (VBool False),
-- all
runTest "all true" $
assertEval "all-t" "builtins.all (x: x > 0) [ 1 2 3 ]" (VBool True),
runTest "all false" $
assertEval "all-f" "builtins.all (x: x > 1) [ 1 2 3 ]" (VBool False),
-- elem
runTest "elem found" $
assertEval "elem-t" "builtins.elem 2 [ 1 2 3 ]" (VBool True),
runTest "elem not found" $
assertEval "elem-f" "builtins.elem 5 [ 1 2 3 ]" (VBool False),
-- elemAt
runTest "elemAt valid" $
assertEval "elemAt" "builtins.elemAt [ 10 20 30 ] 1" (VInt 20),
-- The messages 2.24.9 raises (elemAt in primops.cc, forceInt in
-- eval.cc, forceList in eval-inline.hh). The index is forced and
-- checked before the list. 2.26.0 reworded the bounds message;
-- 2.33.2 prints "'builtins.elemAt' called with index 5 on a list of
-- size 2".
runTest "elemAt past the end" $
assertEvalError "elemAt-oob" "builtins.elemAt [ 1 2 ] 5" "list index 5 is out of bounds",
runTest "elemAt at the length" $
assertEvalError "elemAt-length" "builtins.elemAt [ 1 2 ] 2" "list index 2 is out of bounds",
runTest "elemAt negative index" $
assertEvalError "elemAt-negative" "builtins.elemAt [ 1 2 ] (-1)" "list index -1 is out of bounds",
runTest "elemAt on an empty list" $
assertEvalError "elemAt-empty" "builtins.elemAt [ ] 0" "list index 0 is out of bounds",
runTest "elemAt of a non-list" $
assertEvalError "elemAt-int" "builtins.elemAt 1 0" "expected a list but found an integer: 1",
runTest "elemAt with a string index" $
assertEvalError "elemAt-string-index" "builtins.elemAt [ 1 2 ] \"x\"" "expected an integer but found a string: \"x\"",
runTest "elemAt checks the index before the list" $
assertEvalError "elemAt-index-first" "builtins.elemAt 1 \"x\"" "expected an integer but found a string: \"x\"",
-- partition
runTest "partition right" $
assertEval "partition-right" "(builtins.partition (x: x > 2) [ 1 2 3 4 ]).right == [ 3 4 ]" (VBool True),
runTest "partition wrong" $
assertEval "partition-wrong" "(builtins.partition (x: x > 2) [ 1 2 3 4 ]).wrong == [ 1 2 ]" (VBool True),
-- groupBy
runTest "groupBy pos" $
assertEval "groupBy-pos" "(builtins.groupBy (x: if x > 0 then \"pos\" else \"neg\") [ 1 (- 2) 3 ]).pos == [ 1 3 ]" (VBool True),
runTest "groupBy neg" $
assertEval "groupBy-neg" "(builtins.groupBy (x: if x > 0 then \"pos\" else \"neg\") [ 1 (- 2) 3 ]).neg == [ (- 2) ]" (VBool True),
-- attrNames
runTest "attrNames sorted" $
assertEval "attrNames" "builtins.attrNames { b = 2; a = 1; c = 3; } == [ \"a\" \"b\" \"c\" ]" (VBool True),
-- attrValues
runTest "attrValues count" $
assertEval "attrValues" "builtins.length (builtins.attrValues { a = 1; b = 2; })" (VInt 2),
-- hasAttr
runTest "hasAttr true" $
assertEval "hasAttr-t" "builtins.hasAttr \"a\" { a = 1; }" (VBool True),
runTest "hasAttr false" $
assertEval "hasAttr-f" "builtins.hasAttr \"z\" { a = 1; }" (VBool False),
-- getAttr
runTest "getAttr" $
assertEval "getAttr" "builtins.getAttr \"a\" { a = 42; }" (VInt 42),
runTest "getAttr missing" $
assertEvalFail "getAttr-miss" "builtins.getAttr \"z\" { a = 1; }",
-- removeAttrs
runTest "removeAttrs" $
assertEval "removeAttrs" "builtins.attrNames (builtins.removeAttrs { a = 1; b = 2; c = 3; } [ \"b\" ]) == [ \"a\" \"c\" ]" (VBool True),
-- intersectAttrs
runTest "intersectAttrs" $
assertEval "intersectAttrs" "(builtins.intersectAttrs { a = 1; b = 2; } { b = 20; c = 30; }).b" (VInt 20),
runTest "intersectAttrs keys" $
assertEval "intersectAttrs-keys" "builtins.attrNames (builtins.intersectAttrs { a = 1; b = 2; } { b = 20; c = 30; }) == [ \"b\" ]" (VBool True),
-- catAttrs
runTest "catAttrs" $
assertEval "catAttrs" "builtins.catAttrs \"a\" [ { a = 1; } { b = 2; } { a = 3; } ] == [ 1 3 ]" (VBool True),
-- listToAttrs
runTest "listToAttrs" $
assertEval "listToAttrs" "(builtins.listToAttrs [ { name = \"x\"; value = 1; } { name = \"y\"; value = 2; } ]).x" (VInt 1),
-- substring
runTest "substring basic" $
assertEval "substr" "builtins.substring 1 2 \"hello\"" (mkStr "el"),
runTest "substring clamped" $
assertEval "substr-clamp" "builtins.substring 3 100 \"hello\"" (mkStr "lo"),
-- concatStringsSep
runTest "concatStringsSep" $
assertEval "concatSep" "builtins.concatStringsSep \", \" [ \"a\" \"b\" \"c\" ]" (mkStr "a, b, c"),
-- Partial application
runTest "partial application" $
assertEval "partial" "let f = builtins.map (x: x + 1); in f [ 1 2 3 ] == [ 2 3 4 ]" (VBool True)
]
-- ---------------------------------------------------------------------------
-- Tests: Lexer
-- ---------------------------------------------------------------------------
testLexer :: IO [Bool]
testLexer = do
putStrLn "parser/lexer"
sequence
[ runTest "integer" $
assertRight "lex int" (tokenize "<test>" "42") $ \toks ->
assertEqual "tokens" [TokInt 42] (tokenTypes toks),
runTest "float" $
assertRight "lex float" (tokenize "<test>" "3.14") $ \toks ->
assertEqual "tokens" [TokFloat 3.14] (tokenTypes toks),
runTest "trailing-dot float lexes as one float token" $
assertRight "lex trailing-dot" (tokenize "<test>" "12.") $ \toks ->
assertEqual "tokens" [TokFloat 12.0] (tokenTypes toks),
-- Maximal munch: a dot-led run with a /-segment is one PATH token
-- (upstream's PATH regex), while a slashless dot-run is not.
runTest "dot-relative path lexes as one token" $
assertRight "lex dot-path" (tokenize "<test>" ".github/x") $ \toks ->
assertEqual "tokens" [TokPath ".github/x"] (tokenTypes toks),
runTest "leading-dot float still lexes as float" $
assertRight "lex dot-float" (tokenize "<test>" ".5") $ \toks ->
assertEqual "tokens" [TokFloat 0.5] (tokenTypes toks),
runTest "trailing-dot float with exponent lexes as one float token" $
assertRight "lex trailing-dot-exp" (tokenize "<test>" "12.e2") $ \toks ->
assertEqual "tokens" [TokFloat 1200.0] (tokenTypes toks),
-- Float literals convert with a single rounding (strtod semantics).
-- The exact value here sits between representable ..992 and ..994,
-- nearer ..994; rounding whole and fraction separately lands on ..992.
runTest "float literal rounds once at the 2^53 boundary" $
assertRight "lex float-tie" (tokenize "<test>" "9007199254740993.5") $ \toks ->
assertEqual "tokens" [TokFloat 9007199254740994.0] (tokenTypes toks),
-- A float 10 ^^ exponent overflows on subnormals and flushes to 0.
runTest "subnormal float literal survives" $
assertRight "lex float-subnormal" (tokenize "<test>" "1.0e-320") $ \toks ->
assertEqual "tokens" [TokFloat 1.0e-320] (tokenTypes toks),
-- Bounded number lexing: a literal's cost must follow its length,
-- never its exponent's magnitude, and megadigit literals must
-- resolve promptly. The watchdog turns a cost regression into a
-- FAIL instead of a stuck suite; the checks force full values.
runTestM "huge positive exponent saturates to Infinity" $ do
let saturated = case tokenize "<test>" "1.0e999999999" of
Right toks | [TokFloat f] <- tokenTypes toks -> isInfinite f && f > 0
_ -> False
outcome <- timeout walkWatchdogMicros (evaluate saturated)
pure $ case outcome of
Just True -> Pass
Just False -> Fail "wrong tokens for a huge positive exponent"
Nothing -> Fail "lexing did not return promptly",
runTestM "huge negative exponent saturates to zero" $ do
let flushed = case tokenize "<test>" "1.0e-999999999" of
Right toks -> tokenTypes toks == [TokFloat 0.0]
Left _ -> False
outcome <- timeout walkWatchdogMicros (evaluate flushed)
pure $ case outcome of
Just True -> Pass
Just False -> Fail "wrong tokens for a huge negative exponent"
Nothing -> Fail "lexing did not return promptly",
runTestM "zero mantissa ignores a huge exponent" $ do
let zeroed = case tokenize "<test>" "0.0e999999999" of
Right toks -> tokenTypes toks == [TokFloat 0.0]
Left _ -> False
outcome <- timeout walkWatchdogMicros (evaluate zeroed)
pure $ case outcome of
Just True -> Pass
Just False -> Fail "wrong tokens for a zero mantissa"
Nothing -> Fail "lexing did not return promptly",
runTestM "megadigit integer literal rejects promptly" $ do
let rejected = case tokenize "<test>" (T.replicate 1000000 "9") of
Left _ -> True
Right _ -> False
outcome <- timeout walkWatchdogMicros (evaluate rejected)
pure $ case outcome of
Just True -> Pass
Just False -> Fail "megadigit literal was not rejected"
Nothing -> Fail "range rejection did not return promptly",
runTestM "megadigit mantissa still rounds correctly" $ do
-- 1.999...9e5 sits within half an ulp of 200000.0; the kept-768
-- digits plus the sticky digit must round it there.
let rounded = case tokenize "<test>" ("1." <> T.replicate 1000000 "9" <> "e5") of
Right toks -> tokenTypes toks == [TokFloat 200000.0]
Left _ -> False
outcome <- timeout walkWatchdogMicros (evaluate rounded)
pure $ case outcome of
Just True -> Pass
Just False -> Fail "wrong rounding for a megadigit mantissa"
Nothing -> Fail "lexing did not return promptly",
runTest "true" $
assertRight "lex true" (tokenize "<test>" "true") $ \toks ->
assertEqual "tokens" [TokTrue] (tokenTypes toks),
runTest "false" $
assertRight "lex false" (tokenize "<test>" "false") $ \toks ->
assertEqual "tokens" [TokFalse] (tokenTypes toks),
runTest "null" $
assertRight "lex null" (tokenize "<test>" "null") $ \toks ->
assertEqual "tokens" [TokNull] (tokenTypes toks),
runTest "identifier" $
assertRight "lex ident" (tokenize "<test>" "foo") $ \toks ->
assertEqual "tokens" [TokIdent "foo"] (tokenTypes toks),
runTest "hyphened identifier" $
assertRight "lex hyphened" (tokenize "<test>" "hello-world") $ \toks ->
assertEqual "tokens" [TokIdent "hello-world"] (tokenTypes toks),
runTest "path ./foo" $
assertRight "lex path" (tokenize "<test>" "./foo") $ \toks ->
assertEqual "tokens" [TokPath "./foo"] (tokenTypes toks),
runTest "path ~/foo" $
assertRight "lex path home" (tokenize "<test>" "~/foo") $ \toks ->
assertEqual "tokens" [TokPath "~/foo"] (tokenTypes toks),
runTest "search path" $
assertRight "lex search path" (tokenize "<test>" "<nixpkgs>") $ \toks ->
assertEqual "tokens" [TokSearchPath "nixpkgs"] (tokenTypes toks),
runTest "URI" $
assertRight "lex uri" (tokenize "<test>" "https://example.com") $ \toks ->
assertEqual "tokens" [TokUri "https://example.com"] (tokenTypes toks),
-- Upstream URI = [a-zA-Z][a-zA-Z0-9+.-]*:[uri-char]+ with flex
-- maximal munch: no // required, and the URI beats identifiers,
-- keywords, and the lambda colon when it matches more characters.
runTest "scheme-only URI x:y" $
assertRight "lex uri x:y" (tokenize "<test>" "x:y") $ \toks ->
assertEqual "tokens" [TokUri "x:y"] (tokenTypes toks),
runTest "scheme-only URI mailto" $
assertRight "lex uri mailto" (tokenize "<test>" "mailto:foo@example.com") $ \toks ->
assertEqual "tokens" [TokUri "mailto:foo@example.com"] (tokenTypes toks),
runTest "URI scheme allows + . -" $
assertRight "lex uri scheme" (tokenize "<test>" "a+b.c:d") $ \toks ->
assertEqual "tokens" [TokUri "a+b.c:d"] (tokenTypes toks),
runTest "URI beats keyword by maximal munch" $
assertRight "lex uri keyword" (tokenize "<test>" "then:x") $ \toks ->
assertEqual "tokens" [TokUri "then:x"] (tokenTypes toks),
runTest "hash is not a URI char (starts a comment)" $
assertRight "lex uri hash" (tokenize "<test>" "http://a#frag") $ \toks ->
assertEqual "tokens" [TokUri "http://a"] (tokenTypes toks),
runTest "apostrophe and star are URI chars" $
assertRight "lex uri quote star" (tokenize "<test>" "http://e.com/a'b*c") $ \toks ->
assertEqual "tokens" [TokUri "http://e.com/a'b*c"] (tokenTypes toks),
runTest "lambda colon needs the space" $
assertRight "lex lambda colon" (tokenize "<test>" "x: y") $ \toks ->
assertEqual "tokens" [TokIdent "x", TokColon, TokIdent "y"] (tokenTypes toks),
runTest "underscore cannot start a URI scheme" $
assertRight "lex underscore colon" (tokenize "<test>" "_a:b") $ \toks ->
assertEqual "tokens" [TokIdent "_a", TokColon, TokIdent "b"] (tokenTypes toks),
-- Raw CR/CRLF normalizes to LF in double-quoted strings (upstream
-- unescapeStr); an escaped CR survives; indented strings keep CR
-- verbatim because upstream's IND_STRING chunks skip unescapeStr.
runTest "CRLF in double-quoted string normalizes to LF" $
assertRight "lex crlf string" (tokenize "<test>" "\"a\r\nb\"") $ \toks ->
assertEqual "tokens" [TokStringOpen, TokStringLit "a\nb", TokStringClose] (tokenTypes toks),
runTest "lone CR in double-quoted string normalizes to LF" $
assertRight "lex cr string" (tokenize "<test>" "\"a\rb\"") $ \toks ->
assertEqual "tokens" [TokStringOpen, TokStringLit "a\nb", TokStringClose] (tokenTypes toks),
runTest "escaped CR stays a literal CR" $
assertRight "lex escaped cr" (tokenize "<test>" "\"a\\\rb\"") $ \toks ->
assertEqual "tokens" [TokStringOpen, TokStringLit "a\rb", TokStringClose] (tokenTypes toks),
runTest "indented string keeps CRLF verbatim" $
assertRight "lex ind crlf" (tokenize "<test>" "''a\r\nb''") $ \toks ->
assertEqual "tokens" [TokIndStringOpen, TokStringLit "a\r\nb", TokIndStringClose] (tokenTypes toks),
-- The opener is '' with an optional run of spaces and one newline
-- (upstream lexer.l); a tab is not part of it.
runTest "indented string opener consumes trailing spaces and newline" $
assertRight "lex ind opener" (tokenize "<test>" "'' \n a''") $ \toks ->
assertEqual "tokens" [TokIndStringOpen, TokStringLit " a", TokIndStringClose] (tokenTypes toks),
runTest "indented string opener stops at a tab" $
assertRight "lex ind opener tab" (tokenize "<test>" "''\t\na''") $ \toks ->
assertEqual "tokens" [TokIndStringOpen, TokStringLit "\t\na", TokIndStringClose] (tokenTypes toks),
runTest "multi-char operators" $
assertRight "lex ops" (tokenize "<test>" "++ // -> == != && || <= >=") $ \toks ->
assertEqual
"tokens"
[TokConcat, TokUpdate, TokImpl, TokEq, TokNeq, TokAnd, TokOr, TokLte, TokGte]
(tokenTypes toks),
runTest "single-char operators" $
assertRight "lex single ops" (tokenize "<test>" "+ - * ! ? < >") $ \toks ->
assertEqual
"tokens"
[TokPlus, TokMinus, TokStar, TokNot, TokQuestion, TokLt, TokGt]
(tokenTypes toks),
runTest "division vs path" $
assertRight "lex div" (tokenize "<test>" "6 / 3") $ \toks ->
assertEqual "tokens" [TokInt 6, TokSlash, TokInt 3] (tokenTypes toks),
runTest "string tokens" $
assertRight "lex string" (tokenize "<test>" "\"hello\"") $ \toks ->
assertEqual
"tokens"
[TokStringOpen, TokStringLit "hello", TokStringClose]
(tokenTypes toks),
runTest "empty string" $
assertRight "lex empty string" (tokenize "<test>" "\"\"") $ \toks ->
assertEqual
"tokens"
[TokStringOpen, TokStringClose]
(tokenTypes toks),
runTest "string interpolation tokens" $
assertRight "lex interp" (tokenize "<test>" "\"a${x}b\"") $ \toks ->
assertEqual
"tokens"
[ TokStringOpen,
TokStringLit "a",
TokInterpOpen,
TokIdent "x",
TokInterpClose,
TokStringLit "b",
TokStringClose
]
(tokenTypes toks),
runTest "line comment" $
assertRight "lex comment" (tokenize "<test>" "# comment\n42") $ \toks ->
assertEqual "tokens" [TokInt 42] (tokenTypes toks),
runTest "block comment" $
assertRight "lex block comment" (tokenize "<test>" "/* comment */ 42") $ \toks ->
assertEqual "tokens" [TokInt 42] (tokenTypes toks),
runTest "ellipsis" $
assertRight "lex ellipsis" (tokenize "<test>" "...") $ \toks ->
assertEqual "tokens" [TokEllipsis] (tokenTypes toks),
runTest "punctuation" $
assertRight "lex punct" (tokenize "<test>" ". @ : ; = ,") $ \toks ->
assertEqual
"tokens"
[TokDot, TokAt, TokColon, TokSemicolon, TokAssign, TokComma]
(tokenTypes toks),
runTest "delimiters" $
assertRight "lex delimiters" (tokenize "<test>" "( ) { } [ ]") $ \toks ->
assertEqual
"tokens"
[TokLParen, TokRParen, TokLBrace, TokRBrace, TokLBracket, TokRBracket]
(tokenTypes toks),
runTest "keywords" $
assertRight "lex keywords" (tokenize "<test>" "if then else let in with assert rec inherit") $ \toks ->
assertEqual
"tokens"
[TokIf, TokThen, TokElse, TokLet, TokIn, TokWith, TokAssert, TokRec, TokInherit]
(tokenTypes toks),
runTest "or is identifier" $
assertRight "lex or" (tokenize "<test>" "or") $ \toks ->
assertEqual "tokens" [TokIdent "or"] (tokenTypes toks),
runTest "string escape sequences" $
assertRight "lex escapes" (tokenize "<test>" "\"\\n\\t\\\\\\\"\"") $ \toks ->
assertEqual
"tokens"
[TokStringOpen, TokStringLit "\n\t\\\"", TokStringClose]
(tokenTypes toks)
]
-- ---------------------------------------------------------------------------
-- Tests: Parser expressions
-- ---------------------------------------------------------------------------
testParserExprs :: IO [Bool]
testParserExprs = do
putStrLn "parser/exprs"
sequence
[ -- Atoms
runTest "parse int" $
assertParse "int" "42" (ELit (NixInt 42)),
runTest "parse float" $
assertParse "float" "3.14" (ELit (NixFloat 3.14)),
runTest "parse true" $
assertParse "true" "true" (ELit (NixBool True)),
runTest "parse false" $
assertParse "false" "false" (ELit (NixBool False)),
runTest "parse null" $
assertParse "null" "null" (ELit NixNull),
runTest "parse var" $
assertParseIn ["x"] "var" "x" (EVar "x"),
runTest "parse empty string" $
assertParse "empty string" "\"\"" (EStr []),
runTest "parse string literal" $
assertParse "string" "\"hello\"" (EStr [StrLit "hello"]),
runTest "parse string interpolation" $
assertParseIn
["name"]
"interp"
"\"hello ${name}\""
(EStr [StrLit "hello ", StrInterp (EVar "name")]),
runTest "parse nested string interpolation" $
assertParse
"nested interp"
"\"${\"inner\"}\""
(EStr [StrInterp (EStr [StrLit "inner"])]),
-- Arithmetic
runTest "parse add" $
assertParse "add" "1 + 2" (EBinary OpAdd (ELit (NixInt 1)) (ELit (NixInt 2))),
runTest "parse sub" $
assertParse "sub" "3 - 1" (EBinary OpSub (ELit (NixInt 3)) (ELit (NixInt 1))),
runTest "parse mul" $
assertParse "mul" "2 * 3" (EBinary OpMul (ELit (NixInt 2)) (ELit (NixInt 3))),
runTest "parse left-assoc add" $
assertParse
"left-assoc"
"1 + 2 + 3"
(EBinary OpAdd (EBinary OpAdd (ELit (NixInt 1)) (ELit (NixInt 2))) (ELit (NixInt 3))),
runTest "parse precedence mul over add" $
assertParse
"precedence"
"1 + 2 * 3"
(EBinary OpAdd (ELit (NixInt 1)) (EBinary OpMul (ELit (NixInt 2)) (ELit (NixInt 3)))),
-- Unary
runTest "parse negation" $
assertParse "negate" "-1" (EUnary OpNegate (ELit (NixInt 1))),
runTest "parse logical not" $
assertParse "not" "!true" (EUnary OpNot (ELit (NixBool True))),
-- Non-associative
runTest "parse eq" $
assertParse "eq" "1 == 2" (EBinary OpEq (ELit (NixInt 1)) (ELit (NixInt 2))),
runTest "parse lt" $
assertParse "lt" "1 < 2" (EBinary OpLt (ELit (NixInt 1)) (ELit (NixInt 2))),
-- Right-associative
runTest "parse implication" $
assertParseIn
["a", "b", "c"]
"impl"
"a -> b -> c"
(EBinary OpImpl (EVar "a") (EBinary OpImpl (EVar "b") (EVar "c"))),
runTest "parse concat right" $
assertParseIn
["a", "b", "c"]
"concat"
"a ++ b ++ c"
(EBinary OpConcat (EVar "a") (EBinary OpConcat (EVar "b") (EVar "c"))),
runTest "parse update right" $
assertParseIn
["a", "b", "c"]
"update"
"a // b // c"
(EBinary OpUpdate (EVar "a") (EBinary OpUpdate (EVar "b") (EVar "c"))),
-- Lambda
-- After variable resolution, lambda-bound vars become EResolvedVar.
-- FormalName "x" maps to slot 0; FormalSet [a,b] maps to a=0, b=1;
-- FormalNamedSet "args" [a] maps to args=0, a=1.
runTest "parse simple lambda" $
assertParse "lambda" "x: x" (ELambda (FormalName "x") (EResolvedVar 0 0) NoCaptureInfo),
runTest "parse set pattern lambda" $
assertParse
"set pattern"
"{ a, b }: a"
( ELambda
(FormalSet [Formal "a" Nothing, Formal "b" Nothing] False)
(EResolvedVar 0 0)
NoCaptureInfo
),
runTest "parse set pattern with defaults" $
assertParse
"defaults"
"{ a ? 1 }: a"
( ELambda
(FormalSet [Formal "a" (Just (ELit (NixInt 1)))] False)
(EResolvedVar 0 0)
NoCaptureInfo
),
runTest "parse set pattern with ellipsis" $
assertParse
"ellipsis"
"{ a, ... }: a"
( ELambda
(FormalSet [Formal "a" Nothing] True)
(EResolvedVar 0 0)
NoCaptureInfo
),
runTest "parse named set pattern (name@{...})" $
assertParse
"named set"
"args@{ a }: a"
( ELambda
(FormalNamedSet "args" [Formal "a" Nothing] False)
(EResolvedVar 0 1)
NoCaptureInfo
),
runTest "parse named set pattern ({...}@name)" $
assertParse
"set@name"
"{ a }@args: a"
( ELambda
(FormalNamedSet "args" [Formal "a" Nothing] False)
(EResolvedVar 0 1)
NoCaptureInfo
),
-- Application
runTest "parse application" $
assertParseIn ["f", "x"] "app" "f x" (EApp (EVar "f") (EVar "x")),
runTest "parse left-assoc application" $
assertParseIn ["f", "x", "y"] "app left" "f x y" (EApp (EApp (EVar "f") (EVar "x")) (EVar "y")),
runTest "parse application with parens" $
assertParseIn
["f"]
"app parens"
"f (1 + 2)"
(EApp (EVar "f") (EBinary OpAdd (ELit (NixInt 1)) (ELit (NixInt 2)))),
-- Select
runTest "parse select" $
assertParseIn ["a"] "select" "a.b" (ESelect (EVar "a") [StaticKey "b"] Nothing),
runTest "parse nested select" $
assertParseIn
["a"]
"nested select"
"a.b.c"
(ESelect (EVar "a") [StaticKey "b", StaticKey "c"] Nothing),
runTest "parse select or default" $
assertParseIn
["a"]
"select or"
"a.b or 1"
(ESelect (EVar "a") [StaticKey "b"] (Just (ELit (NixInt 1)))),
runTest "parse has-attr" $
assertParseIn ["a"] "has-attr" "a ? b" (EHasAttr (EVar "a") [StaticKey "b"]),
-- Attr sets
runTest "parse empty attrs" $
assertParse "empty attrs" "{ }" (EAttrs False [] NoCaptureInfo),
runTest "parse attrs with binding" $
assertParse
"attrs"
"{ a = 1; }"
(EAttrs False [NamedBinding (StaticKey "a") (ELit (NixInt 1))] NoCaptureInfo),
runTest "parse rec attrs" $
assertParse
"rec attrs"
"rec { a = 1; }"
(EAttrs True [NamedBinding (StaticKey "a") (ELit (NixInt 1))] NoCaptureInfo),
-- inherit x y; is one binding per name, each holding the variable it
-- copies, which resolution binds like any other variable.
runTest "parse inherit" $
assertParseIn
["x", "y"]
"inherit"
"{ inherit x y; }"
(EAttrs False [Inherit "x" (EVar "x"), Inherit "y" (EVar "y")] NoCaptureInfo),
runTest "parse inherit from" $
assertParseIn
["a"]
"inherit from"
"{ inherit (a) x; }"
(EAttrs False [InheritFrom (EVar "a") ["x"]] NoCaptureInfo),
-- Let/if/with/assert
runTest "parse let" $
assertParse
"let"
"let x = 1; in x"
(ELet [NamedBinding (StaticKey "x") (ELit (NixInt 1))] (EResolvedVar 0 0) NoCaptureInfo),
runTest "parse if-then-else" $
assertParse
"if"
"if true then 1 else 2"
(EIf (ELit (NixBool True)) (ELit (NixInt 1)) (ELit (NixInt 2))),
runTest "parse with" $
assertParseIn
["a"]
"with"
"with a; b"
(EWith (EVar "a") (EWithVar "b")),
runTest "parse assert" $
assertParse
"assert"
"assert true; 1"
(EAssert (ELit (NixBool True)) (ELit (NixInt 1))),
-- Lists
runTest "parse empty list" $
assertParse "empty list" "[ ]" (EList []),
runTest "parse list elements" $
assertParse
"list"
"[ 1 2 3 ]"
(EList [ELit (NixInt 1), ELit (NixInt 2), ELit (NixInt 3)]),
-- Parens
runTest "parse parens" $
assertParse "parens" "(42)" (ELit (NixInt 42)),
-- 'or' as identifier
runTest "or as identifier" $
assertParseIn ["or"] "or ident" "or" (EVar "or"),
-- 'or' as attr key
runTest "or as attr key" $
assertParse
"or attr key"
"{ or = 1; }"
(EAttrs False [NamedBinding (StaticKey "or") (ELit (NixInt 1))] NoCaptureInfo)
]
-- ---------------------------------------------------------------------------
-- Tests: Parser errors
-- ---------------------------------------------------------------------------
testParserErrors :: IO [Bool]
testParserErrors = do
putStrLn "parser/errors"
sequence
[ runTest "empty input" $
assertLeft "empty" (parseNix testBaseDir "<test>" ""),
runTest "unclosed paren" $
assertLeft "unclosed paren" (parseNix testBaseDir "<test>" "(1"),
runTest "unclosed string" $
assertLeft "unclosed string" (parseNix testBaseDir "<test>" "\"hello"),
runTest "unclosed brace" $
assertLeft "unclosed brace" (parseNix testBaseDir "<test>" "{ a = 1;"),
runTest "missing semicolon" $
assertLeft "missing semi" (parseNix testBaseDir "<test>" "{ a = 1 }"),
runTest "unclosed bracket" $
assertLeft "unclosed bracket" (parseNix testBaseDir "<test>" "[ 1 2"),
runTest "unexpected token" $
assertLeft "unexpected" (parseNix testBaseDir "<test>" ")"),
-- A failure deep in a lambda body is reported where it happened:
-- a parsed lambda header commits, instead of backtracking into
-- the attr-set reading and reporting its early stumble (a real
-- error at line 410 of a nixpkgs file used to surface at line 2).
runTest "deep formals-lambda body error reports its own line" $
assertRight "deep body" (syntaxErrorOf "{ a, b }:\n{\n x = 1;\n y = (;\n}") $ \err ->
assertEqual "error line" 4 (peLine err),
runTest "simple-lambda body error reports its own line" $
assertRight "simple body" (syntaxErrorOf "x:\n(;") $ \err ->
assertEqual "error line" 2 (peLine err),
-- The empty attr set is a successful PREFIX parse of "{ }: body",
-- so without commitment the outer parser complained at the colon.
runTest "empty-formals lambda body error reports its own line" $
assertRight "empty formals body" (syntaxErrorOf "{ }:\n(;") $ \err ->
assertEqual "error line" 2 (peLine err),
-- When neither reading parses, the deeper failure wins: the
-- malformed formal at column 7, not the attr-set branch's
-- stumble over the first comma at column 4.
runTest "a malformed formal beats the attr-set branch's earlier error" $
assertRight "malformed formal" (syntaxErrorOf "{ a, b.c }: x") $ \err ->
assertEqual "deeper than the attr-set stumble" True ((peLine err, peCol err) > (1, 4)),
-- End-of-input failures carry no position and must rank as the
-- furthest a branch can get.
runTest "truncated lambda reports end of input" $
assertRight "truncated lambda" (syntaxErrorOf "{ a, b }:") $ \err ->
assertEqual "end of input" True ("end of input" `T.isInfixOf` peMessage err)
]
-- ---------------------------------------------------------------------------
-- Tests: Parser integration
-- ---------------------------------------------------------------------------
testParserIntegration :: IO [Bool]
testParserIntegration = do
putStrLn "parser/integration"
sequence
[ runTest "shell.nix pattern" $
assertRight "shell.nix" (parseNix testBaseDir "<test>" "{ pkgs ? import <nixpkgs> {} }: pkgs.mkShell { buildInputs = [ pkgs.ghc ]; }") $ \case
ELambda {} -> Pass
other -> Fail ("expected ELambda, got: " <> T.pack (show other)),
runTest "let with multiple bindings" $
assertParse
"multi-let"
"let x = 1; y = 2; in x + y"
( ELet
[ NamedBinding (StaticKey "x") (ELit (NixInt 1)),
NamedBinding (StaticKey "y") (ELit (NixInt 2))
]
(EBinary OpAdd (EResolvedVar 0 0) (EResolvedVar 0 1))
NoCaptureInfo
),
runTest "nested attr set" $
-- Normalization hoists a nested attrpath into nested literal sets
-- (upstream parser.y addAttr), so a.b.c = 1 parses like
-- a = { b = { c = 1; }; }.
assertParse
"nested attrs"
"{ a.b.c = 1; d = { e = 2; }; }"
( EAttrs
False
[ NamedBinding
(StaticKey "a")
( EAttrs
False
[ NamedBinding
(StaticKey "b")
(EAttrs False [NamedBinding (StaticKey "c") (ELit (NixInt 1))] NoCaptureInfo)
]
NoCaptureInfo
),
NamedBinding (StaticKey "d") (EAttrs False [NamedBinding (StaticKey "e") (ELit (NixInt 2))] NoCaptureInfo)
]
NoCaptureInfo
),
runTest "indented string" $
assertRight "ind string" (parseNix testBaseDir "<test>" "''hello''") $ \case
EIndStr _ -> Pass
other -> Fail ("expected EIndStr, got: " <> T.pack (show other)),
runTest "indented string escape is its own part" $
assertRight "ind string esc" (parseNix testBaseDir "<test>" "''a'''b''") $ \case
EIndStr [StrLit "a", StrEsc "''", StrLit "b"] -> Pass
other -> Fail ("expected literal, escape, literal, got: " <> T.pack (show other)),
-- Positional let/rec resolution tests
runTest "let inherit from outer lambda" $
assertRight "let-inherit-lambda" (parseNix testBaseDir "<test>" "x: let inherit x; in x") $ \case
-- x: let inherit x; in x
-- The lambda formal x is at level 0, index 0.
-- The let scope is level 0 (for the let body).
-- The inherited variable resolves against the outer (lambda)
-- scope, one level up from the let it is evaluated in.
-- The body x resolves to level 0, index 0 (the let scope).
ELambda _ (ELet [Inherit "x" _rhsExpr] (EResolvedVar 0 0) _) _ -> Pass
other -> Fail ("expected ELambda with let-inherit, got: " <> T.pack (show other)),
runTest "nested lambda in let" $
assertEval
"let-nested-lambda"
"let f = x: x + 1; g = y: f y; in g 5"
(VInt 6),
runTest "rec attrs positional resolution" $
assertEval
"rec-positional"
"let s = rec { a = 1; b = a + 1; }; in s.b"
(VInt 2)
]
-- ---------------------------------------------------------------------------
-- Tests: Batch 1 - Trivial pure builtins + constants
-- ---------------------------------------------------------------------------
testBatch1 :: IO [Bool]
testBatch1 = do
putStrLn "eval/builtins-batch1"
sequence
[ -- isPath
runTest "isPath true" $
assertEval "isPath-t" "builtins.isPath ./foo" (VBool True),
runTest "isPath false" $
assertEval "isPath-f" "builtins.isPath \"foo\"" (VBool False),
-- ceil
runTest "ceil float" $
assertEval "ceil" "builtins.ceil 1.2" (VInt 2),
runTest "ceil int passthrough" $
assertEval "ceil-int" "builtins.ceil 5" (VInt 5),
runTest "ceil negative" $
assertEval "ceil-neg" "builtins.ceil (- 1.7)" (VInt (-1)),
runTest "ceil type error" $
assertEvalFail "ceil-err" "builtins.ceil \"hi\"",
-- floor
runTest "floor float" $
assertEval "floor" "builtins.floor 1.7" (VInt 1),
runTest "floor int passthrough" $
assertEval "floor-int" "builtins.floor 5" (VInt 5),
runTest "floor negative" $
assertEval "floor-neg" "builtins.floor (- 1.2)" (VInt (-2)),
-- NaN, infinity, and out-of-range floats are eval errors (Nix 2.24),
-- not whatever Int64 Haskell's unchecked conversion produces.
runTest "ceil NaN fails" $
assertEvalFail "ceil-nan" "builtins.ceil ((1.0e308 * 10) * 0.0)",
runTest "floor infinity fails" $
assertEvalFail "floor-inf" "builtins.floor (1.0e308 * 10)",
runTest "ceil out of integer range fails" $
assertEvalFail "ceil-range" "builtins.ceil 1.0e300",
-- seq
runTest "seq returns second" $
assertEval "seq" "builtins.seq 1 42" (VInt 42),
-- trace
runTest "trace returns second" $
assertEval "trace" "builtins.trace \"msg\" 42" (VInt 42),
-- unsafeDiscardStringContext
runTest "discardContext" $
assertEval "discard" "builtins.unsafeDiscardStringContext \"hello\"" (mkStr "hello"),
-- unsafeDiscardOutputDependency
runTest "discardOutputDep" $
assertEval "discardOut" "builtins.unsafeDiscardOutputDependency \"hello\"" (mkStr "hello"),
-- baseNameOf
runTest "baseNameOf string" $
assertEval "baseName-str" "builtins.baseNameOf \"/foo/bar/baz\"" (mkStr "baz"),
runTest "baseNameOf path" $
assertEval "baseName-path" "builtins.baseNameOf ./foo/bar" (mkStr "bar"),
runTest "baseNameOf no slash" $
assertEval "baseName-flat" "builtins.baseNameOf \"filename\"" (mkStr "filename"),
runTest "baseNameOf type error" $
assertEvalFail "baseName-err" "builtins.baseNameOf 42",
-- dirOf
runTest "dirOf string" $
assertEval "dirOf-str" "builtins.dirOf \"/foo/bar/baz\"" (mkStr "/foo/bar"),
runTest "dirOf no slash" $
assertEval "dirOf-flat" "builtins.dirOf \"filename\"" (mkStr "."),
runTest "dirOf root-level path" $
assertEval "dirOf-root" "builtins.dirOf \"/foo\"" (mkStr "/"),
-- Path VALUES arrive native-spelled when eval's base dir is a
-- native path (the CLI case); the path-operand splits must be
-- separator-aware. The forward-slash tests above use a '/'
-- base and cannot see this.
runTestM "baseNameOf on a native-based path value" $ do
cwd <- Dir.getCurrentDirectory
result <- evalNixIO cwd "builtins.baseNameOf ./regression-name.nix"
pure $ case result of
Right v
| v == mkStr "regression-name.nix" -> Pass
| otherwise -> Fail ("wrong basename: " <> T.pack (show v))
Left err -> Fail ("eval failed: " <> T.pack (show err)),
-- The path-value spec: absolute, lexically canonical, and
-- slash-spelled regardless of the base dir's native spelling.
runTestM "path values are slash-canonical from a native base" $ do
cwd <- Dir.getCurrentDirectory
result <- evalNixIO cwd "toString ./spec-name.nix"
let expected = mkStr (T.replace "\\" "/" (T.pack cwd) <> "/spec-name.nix")
pure $ case result of
Right v
| v == expected -> Pass
| otherwise -> Fail ("wrong spelling: " <> T.pack (show v))
Left err -> Fail ("eval failed: " <> T.pack (show err)),
runTest "canonPathValue folds platform separators only" $
let folded = canonPathValue "C:\\a\\.\\b"
expectedByPlatform =
if SI.os == "mingw32"
then "C:/a/b" -- '\\' is a separator here and folds
else "C:\\a\\.\\b" -- '\\' is a file-name character, preserved
in assertEqual "platform fold" expectedByPlatform folded,
runTestM "dirOf on a native-based path value" $ do
cwd <- Dir.getCurrentDirectory
dirResult <- evalNixIO cwd "builtins.dirOf ./sub/regression-name.nix"
parentResult <- evalNixIO cwd "./sub"
pure $
if dirResult == parentResult
then Pass
else
Fail
( "dirOf mismatch: "
<> T.pack (show dirResult)
<> " vs "
<> T.pack (show parentResult)
),
-- appendContext: a key that is not a store path must refuse, as
-- upstream does - a fabricated identity would flow into
-- derivation inputs.
runTest "appendContext rejects a non-store-path key" $
assertEvalFail
"appendContext-badkey"
"builtins.appendContext \"x\" { \"not-a-store-path\" = { path = true; }; }",
runTest "appendContext accepts a store-path key" $
assertEval
"appendContext-ok"
"if (builtins.appendContext \"x\" { \"/nix/store/00000000000000000000000000000000-y\" = { path = true; }; }) == \"x\" then \"ok\" else \"no\""
(mkStr "ok"),
-- storePath: the hash component is charset-validated like every
-- other store-path parse boundary ('E' is outside nix-base32), and
-- refused with upstream's StorePath constructor text (path.cc at
-- 2.24.9).
runTest "storePath rejects a non-base32 hash" $
assertEvalError
"storePath-badhash"
"builtins.storePath \"/nix/store/EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE-x\""
"store path 'EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE-x' contains illegal base-32 character 'E'",
runTest "storePath refuses a path outside the store" $
assertEvalError "storePath-outside" "builtins.storePath \"/x\"" "path '/x' is not in the Nix store",
runTest "storePath refuses the store directory itself" $
assertEvalError "storePath-storedir" "builtins.storePath \"/nix/store/\"" "path '/nix/store' is not in the Nix store",
runTest "storePath refuses a component too short for a hash" $
assertEvalError "storePath-short" "builtins.storePath \"/nix/store/x\"" "'x' is too short to be a valid store path",
runTest "storePath refuses an empty name" $
assertEvalError "storePath-empty-name" "builtins.storePath \"/nix/store/00000000000000000000000000000000-\"" "path '00000000000000000000000000000000-' is not a valid store path: name must not be empty",
runTest "storePath refuses an illegal name" $
assertEvalError "storePath-bad-name" "builtins.storePath \"/nix/store/00000000000000000000000000000000-a b\"" "path '00000000000000000000000000000000-a b' is not a valid store path: name 'a b' contains illegal character ' '",
runTest "storePath accepts a valid store path" $
assertEval
"storePath-ok"
"if (builtins.storePath \"/nix/store/00000000000000000000000000000000-x\") == \"/nix/store/00000000000000000000000000000000-x\" then \"ok\" else \"no\""
(mkStr "ok"),
runTest "dirOf root" $
assertEval "dirOf-slash" "builtins.dirOf \"/\"" (mkStr "/"),
-- concatLists
runTest "concatLists basic" $
assertEval "concatLists" "builtins.concatLists [ [ 1 2 ] [ 3 ] [ 4 5 ] ] == [ 1 2 3 4 5 ]" (VBool True),
runTest "concatLists empty" $
assertEval "concatLists-empty" "builtins.concatLists [ ]" (VList emptyCList),
runTest "concatLists type error" $
assertEvalFail "concatLists-err" "builtins.concatLists [ 1 2 ]",
-- lessThan
runTest "lessThan true" $
assertEval "lt-t" "builtins.lessThan 1 2" (VBool True),
runTest "lessThan false" $
assertEval "lt-f" "builtins.lessThan 2 1" (VBool False),
runTest "lessThan strings" $
assertEval "lt-str" "builtins.lessThan \"a\" \"b\"" (VBool True),
-- List < decides at the first UNEQUAL pair, as upstream: a pair
-- where < holds in neither direction (NaN) decides False rather
-- than being skipped as equal.
-- Distinct NaN values: a shared binding would be skipped as equal
-- via reference identity, which upstream's eqValues also does.
runTest "list compare decides at the first unequal pair" $
assertEval "lt-list-nan" "let inf = 1.0e308 * 10; in [ (inf - inf) 1 ] < [ (inf - inf) 2 ]" (VBool False),
runTest "list compare skips equal prefixes" $
assertEval "lt-list-prefix" "[ 1 2 ] < [ 1 3 ]" (VBool True),
-- Constants
runTest "storeDir" $
assertEval "storeDir" "builtins.storeDir" (mkStr defaultStoreDirText),
runTest "nixVersion" $
assertEval "nixVersion" "builtins.nixVersion" (mkStr "2.24.0"),
runTest "langVersion" $
assertEval "langVersion" "builtins.langVersion" (VInt 6),
runTest "nixPath" $
assertEval "nixPath" "builtins.nixPath" (VList emptyCList)
]
-- ---------------------------------------------------------------------------
-- Tests: Batch 2 - Arithmetic + bitwise builtins
-- ---------------------------------------------------------------------------
testBatch2 :: IO [Bool]
testBatch2 = do
putStrLn "eval/builtins-batch2"
sequence
[ -- add
runTest "add ints" $
assertEval "add-int" "builtins.add 3 4" (VInt 7),
runTest "add int+float" $
assertEval "add-mixed" "builtins.add 1 2.5" (VFloat 3.5),
runTest "add type error" $
assertEvalFail "add-err" "builtins.add \"a\" 1",
-- sub
runTest "sub ints" $
assertEval "sub-int" "builtins.sub 10 3" (VInt 7),
runTest "sub float" $
assertEval "sub-float" "builtins.sub 5.5 2.0" (VFloat 3.5),
-- mul
runTest "mul ints" $
assertEval "mul-int" "builtins.mul 3 4" (VInt 12),
runTest "mul float" $
assertEval "mul-float" "builtins.mul 2 3.0" (VFloat 6.0),
-- div
runTest "div ints" $
assertEval "div-int" "builtins.div 10 3" (VInt 3),
runTest "div float" $
assertEval "div-float" "builtins.div 7.0 2.0" (VFloat 3.5),
runTest "div by zero" $
assertEvalFail "div-zero" "builtins.div 1 0",
-- bitAnd
runTest "bitAnd" $
assertEval "bitAnd" "builtins.bitAnd 12 10" (VInt 8),
runTest "bitAnd type error" $
assertEvalFail "bitAnd-err" "builtins.bitAnd 1.0 2",
-- bitOr
runTest "bitOr" $
assertEval "bitOr" "builtins.bitOr 12 10" (VInt 14),
-- bitXor
runTest "bitXor" $
assertEval "bitXor" "builtins.bitXor 12 10" (VInt 6)
]
-- ---------------------------------------------------------------------------
-- Tests: Batch 3 - Attrset higher-order builtins
-- ---------------------------------------------------------------------------
testBatch3 :: IO [Bool]
testBatch3 = do
putStrLn "eval/builtins-batch3"
let functionArgsError = "'functionArgs' requires a function"
sequence
[ -- mapAttrs
runTest "mapAttrs basic" $
assertEval "mapAttrs" "(builtins.mapAttrs (name: val: val + 1) { a = 1; b = 2; }).a" (VInt 2),
runTest "mapAttrs name usage" $
assertEval "mapAttrs-name" "(builtins.mapAttrs (name: val: name) { a = 1; }).a" (mkStr "a"),
runTest "mapAttrs type error" $
assertEvalFail "mapAttrs-err" "builtins.mapAttrs (n: v: v) [ 1 ]",
runTest "mapAttrs lazy" $
assertEval "mapAttrs-lazy" "let s = builtins.mapAttrs (k: v: if k == \"a\" then v else throw \"boom\") { a = 1; b = 2; }; in s.a" (VInt 1),
-- functionArgs
runTest "functionArgs set pattern" $
assertEval "funcArgs" "(builtins.functionArgs ({ a, b ? 1 }: a)).b" (VBool True),
runTest "functionArgs no default" $
assertEval "funcArgs-nodef" "(builtins.functionArgs ({ a, b ? 1 }: a)).a" (VBool False),
runTest "functionArgs simple lambda" $
assertEval "funcArgs-simple" "builtins.functionArgs (x: x)" (VAttrs (attrSetFromMap Map.empty)),
-- Upstream's prim_functionArgs message (primops.cc at 2.24.9), the
-- same whatever the argument, and tryEval does not catch it.
runTest "functionArgs of a set is upstream's error" $
assertEvalError "funcArgs-set" "builtins.functionArgs {}" functionArgsError,
runTest "functionArgs of a path is upstream's error" $
assertEvalError "funcArgs-path" "builtins.functionArgs ./foo" functionArgsError,
runTest "functionArgs of an integer is upstream's error" $
assertEvalError "funcArgs-int" "builtins.functionArgs 42" functionArgsError,
runTest "functionArgs of a string is upstream's error" $
assertEvalError "funcArgs-string" "builtins.functionArgs \"s\"" functionArgsError,
runTest "tryEval does not catch the functionArgs error" $
assertEvalError "funcArgs-tryEval" "builtins.tryEval (builtins.functionArgs {})" functionArgsError,
-- The builtins set is observable (hasAttr/attrNames), so it must
-- match upstream's primop set exactly: no mod/min/max/
-- setFunctionArgs extensions (nixpkgs lib defines those in Nix),
-- and functionArgs never consults __functionArgs - a functor set
-- is an error, as upstream throws (lib.functionArgs unwraps
-- functor sets itself before reaching the builtin).
runTest "no invented arithmetic builtins" $
assertEval
"no-fake-builtins"
"!(builtins ? mod) && !(builtins ? min) && !(builtins ? max) && !(builtins ? setFunctionArgs)"
(VBool True),
runTest "functionArgs rejects functor sets" $
assertEvalFail
"funcArgs-functor-err"
"builtins.functionArgs { __functor = self: x: x; __functionArgs = { a = false; }; }",
-- zipAttrsWith
runTest "zipAttrsWith basic" $
assertEval
"zipAttrs"
"(builtins.zipAttrsWith (name: vals: builtins.head vals) [ { a = 1; } { a = 2; b = 3; } ]).b"
(VInt 3),
runTest "zipAttrsWith collect" $
assertEval
"zipAttrs-collect"
"builtins.length (builtins.zipAttrsWith (name: vals: vals) [ { a = 1; } { a = 2; } ]).a"
(VInt 2)
]
-- ---------------------------------------------------------------------------
-- Tests: Batch 4 - String operations
-- ---------------------------------------------------------------------------
testBatch4 :: IO [Bool]
testBatch4 = do
putStrLn "eval/builtins-batch4"
sequence
[ -- replaceStrings
runTest "replaceStrings basic" $
assertEval "replace" "builtins.replaceStrings [ \"o\" ] [ \"0\" ] \"foobar\"" (mkStr "f00bar"),
runTest "replaceStrings multi" $
assertEval "replace-multi" "builtins.replaceStrings [ \"a\" \"b\" ] [ \"A\" \"B\" ] \"abc\"" (mkStr "ABc"),
runTest "replaceStrings empty from" $
assertEval "replace-empty" "builtins.replaceStrings [ \"\" ] [ \"x\" ] \"ab\"" (mkStr "xaxbx"),
runTest "replaceStrings no match" $
assertEval "replace-nomatch" "builtins.replaceStrings [ \"z\" ] [ \"Z\" ] \"abc\"" (mkStr "abc"),
-- Match-gated forcing: an unmatched replacement is never evaluated.
runTest "replaceStrings never forces an unmatched replacement" $
assertEval "replace-lazy" "builtins.replaceStrings [ \"z\" ] [ (builtins.throw \"unused\") ] \"abc\"" (mkStr "abc"),
-- compareVersions
runTest "compareVersions equal" $
assertEval "cmpVer-eq" "builtins.compareVersions \"1.2.3\" \"1.2.3\"" (VInt 0),
runTest "compareVersions less" $
assertEval "cmpVer-lt" "builtins.compareVersions \"1.2\" \"1.3\"" (VInt (-1)),
runTest "compareVersions greater" $
assertEval "cmpVer-gt" "builtins.compareVersions \"2.0\" \"1.9\"" (VInt 1),
runTest "compareVersions type error" $
assertEvalFail "cmpVer-err" "builtins.compareVersions 1 2",
runTest "compareVersions treats - as a separator" $
assertEval "cmpVer-dash" "builtins.compareVersions \"1.0-2\" \"1.0.2\"" (VInt 0),
-- splitVersion
runTest "splitVersion basic" $
assertEval "splitVer" "builtins.splitVersion \"1.2.3\" == [ \"1\" \"2\" \"3\" ]" (VBool True),
runTest "splitVersion pre" $
assertEval "splitVer-pre" "builtins.splitVersion \"1.2pre\" == [ \"1\" \"2\" \"pre\" ]" (VBool True),
runTest "splitVersion type error" $
assertEvalFail "splitVer-err" "builtins.splitVersion 42",
-- parseDrvName
runTest "parseDrvName basic" $
assertEval "parseDrv" "(builtins.parseDrvName \"hello-1.2.3\").name" (mkStr "hello"),
runTest "parseDrvName version" $
assertEval "parseDrv-ver" "(builtins.parseDrvName \"hello-1.2.3\").version" (mkStr "1.2.3"),
runTest "parseDrvName no version" $
assertEval "parseDrv-nover" "(builtins.parseDrvName \"hello\").version" (mkStr ""),
runTest "parseDrvName type error" $
assertEvalFail "parseDrv-err" "builtins.parseDrvName 42"
]
-- ---------------------------------------------------------------------------
-- Tests: Batch 5 - Serialization + hashing
-- ---------------------------------------------------------------------------
testBatch5 :: IO [Bool]
testBatch5 = do
putStrLn "eval/builtins-batch5"
sequence
[ -- toJSON
runTest "toJSON int" $
assertEval "toJSON-int" "builtins.toJSON 42" (mkStr "42"),
runTest "toJSON string" $
assertEval "toJSON-str" "builtins.toJSON \"hello\"" (mkStr "\"hello\""),
runTest "toJSON null" $
assertEval "toJSON-null" "builtins.toJSON null" (mkStr "null"),
runTest "toJSON bool" $
assertEval "toJSON-bool" "builtins.toJSON true" (mkStr "true"),
runTest "toJSON list" $
assertEval "toJSON-list" "builtins.toJSON [ 1 2 3 ]" (mkStr "[1,2,3]"),
runTest "toJSON attrs" $
assertEval "toJSON-attrs" "builtins.toJSON { a = 1; }" (mkStr "{\"a\":1}"),
runTest "toJSON lambda error" $
assertEvalFail "toJSON-fn" "builtins.toJSON (x: x)",
-- fromJSON
runTest "fromJSON int" $
assertEval "fromJSON-int" "builtins.fromJSON \"42\"" (VInt 42),
runTest "fromJSON string" $
assertEval "fromJSON-str" "builtins.fromJSON \"\\\"hello\\\"\"" (mkStr "hello"),
runTest "fromJSON null" $
assertEval "fromJSON-null" "builtins.fromJSON \"null\"" VNull,
runTest "fromJSON bool" $
assertEval "fromJSON-bool" "builtins.fromJSON \"true\"" (VBool True),
runTest "fromJSON array" $
assertEval "fromJSON-arr" "builtins.length (builtins.fromJSON \"[1,2,3]\")" (VInt 3),
runTest "fromJSON object" $
assertEval "fromJSON-obj" "(builtins.fromJSON \"{\\\"a\\\": 1}\").a" (VInt 1),
runTest "fromJSON roundtrip" $
assertEval "fromJSON-rt" "let x = builtins.fromJSON (builtins.toJSON { a = 1; b = [ 2 3 ]; }); in x.a == 1 && x.b == [ 2 3 ]" (VBool True),
runTest "fromJSON invalid" $
assertEvalFail "fromJSON-bad" "builtins.fromJSON \"not json\"",
-- The integer range as json-to-value.cc has it at 2.25 and after.
runTest "fromJSON reads the largest int" $
assertEval "fromJSON-int-max" "builtins.fromJSON \"9223372036854775807\"" (VInt 9223372036854775807),
runTest "fromJSON reads the smallest int" $
assertEval "fromJSON-int-min" "builtins.fromJSON \"-9223372036854775808\"" (VInt (-9223372036854775808)),
runTest "fromJSON refuses one past the largest int" $
assertEvalError "fromJSON-past-int" "builtins.fromJSON \"9223372036854775808\"" "unsigned json number 9223372036854775808 outside of Nix integer range",
runTest "fromJSON refuses the largest unsigned" $
assertEvalError "fromJSON-uint-max" "builtins.fromJSON \"18446744073709551615\"" "unsigned json number 18446744073709551615 outside of Nix integer range",
runTest "fromJSON refuses an unsigned number inside a list" $
assertEvalError "fromJSON-uint-list" "builtins.fromJSON \"[1,[18446744073709551615]]\"" "unsigned json number 18446744073709551615 outside of Nix integer range",
runTest "fromJSON refuses an unsigned number inside a set" $
assertEvalError "fromJSON-uint-set" "builtins.fromJSON ''{\"a\":18446744073709551615}''" "unsigned json number 18446744073709551615 outside of Nix integer range",
runTest "fromJSON names the first such number in the document, not in key order" $
assertEvalError "fromJSON-uint-order" "builtins.fromJSON ''{\"b\":18446744073709551615,\"a\":9223372036854775808}''" "unsigned json number 18446744073709551615 outside of Nix integer range",
runTest "fromJSON refuses such a number ahead of a later syntax error" $
assertEvalError "fromJSON-uint-syntax" "builtins.fromJSON \"[18446744073709551615,nonsense\"" "unsigned json number 18446744073709551615 outside of Nix integer range",
-- nlohmann's grammar (json-to-value.cc at 2.24.9), strict RFC 8259:
-- each case below is refused or read as nix-instantiate reads it.
runTest "fromJSON reads the backspace and form feed escapes" $
assertEval "fromJSON-bf" "builtins.fromJSON ''\"a\\bb\\fc\"''" (mkStr "a\bb\fc"),
runTest "fromJSON reads a surrogate pair" $
assertEval "fromJSON-pair" "builtins.fromJSON ''\"\\ud83d\\ude00\"''" (mkStr "\128512"),
runTest "fromJSON skips a leading byte order mark" $
assertEval "fromJSON-bom" "builtins.fromJSON \"\65279 1\"" (VInt 1),
runTest "fromJSON refuses an unterminated string" $
assertEvalError "fromJSON-unterminated" "builtins.fromJSON ''\"abc''" "unterminated string",
runTest "fromJSON refuses a trailing comma in an array" $
assertEvalError "fromJSON-array-comma" "builtins.fromJSON \"[1,]\"" "unexpected ']', expected a JSON value",
runTest "fromJSON refuses a trailing comma in an object" $
assertEvalError "fromJSON-object-comma" "builtins.fromJSON ''{\"a\":1,}''" "unexpected '}' in an object, expected a member name",
runTest "fromJSON refuses a leading zero" $
assertEvalError "fromJSON-leading-zero" "builtins.fromJSON \"01\"" "unexpected content after the JSON value: '1'",
runTest "fromJSON refuses a raw control character in a string" $
assertEvalError "fromJSON-raw-tab" "builtins.fromJSON \"\\\"a\\tb\\\"\"" "control character U+0009 must be escaped",
runTest "fromJSON refuses a \\u escape short of four hex digits" $
assertEvalError "fromJSON-short-u" "builtins.fromJSON ''\"\\u12\"''" "invalid \\u escape '12\"'",
runTest "fromJSON refuses a lone high surrogate" $
assertEvalError "fromJSON-lone-high" "builtins.fromJSON ''\"\\ud800\"''" "a high surrogate must be followed by a low surrogate",
runTest "fromJSON refuses a lone low surrogate" $
assertEvalError "fromJSON-lone-low" "builtins.fromJSON ''\"\\udc00\"''" "a low surrogate must follow a high surrogate",
runTest "fromJSON refuses an unknown escape" $
assertEvalError "fromJSON-bad-escape" "builtins.fromJSON ''\"a\\x\"''" "invalid escape \\x",
runTest "fromJSON refuses a number past the double range" $
assertEvalError "fromJSON-overflow" "builtins.fromJSON \"1e400\"" "number overflow parsing '1e400'",
runTest "fromJSON refuses whitespace JSON does not define" $
assertEvalError "fromJSON-nbsp" "builtins.fromJSON \"\160 1\"" "unexpected '\160 1', expected a JSON value",
runTest "fromJSON refuses a vertical tab around a value" $
assertEvalError "fromJSON-vt" "builtins.fromJSON \"\v1\"" "unexpected '\v1', expected a JSON value",
-- hashString
runTest "hashString sha256" $
assertEval "hash-sha256" "builtins.hashString \"sha256\" \"hello\"" (mkStr "2cf24dba5fb0a30e26e83b2ac5b9e29e1b161e5c1fa7425e73043362938b9824"),
runTest "hashString md5" $
assertEval "hash-md5" "builtins.hashString \"md5\" \"hello\"" (mkStr "5d41402abc4b2a76b9719d911017c592"),
runTest "hashString sha1" $
assertEval "hash-sha1" "builtins.hashString \"sha1\" \"hello\"" (mkStr "aaf4c61ddcc5e8a2dabede0f3b482cd9aea9434d"),
runTest "hashString unknown algo" $
assertEvalFail "hash-bad" "builtins.hashString \"sha999\" \"hello\"",
runTest "hashString type error" $
assertEvalFail "hash-err" "builtins.hashString \"sha256\" 42"
]
-- ---------------------------------------------------------------------------
-- Tests: Batch 6 - tryEval + deepSeq
-- ---------------------------------------------------------------------------
testBatch6 :: IO [Bool]
testBatch6 = do
putStrLn "eval/builtins-batch6"
sequence
[ -- tryEval success
runTest "tryEval success" $
assertEval "tryEval-ok" "(builtins.tryEval 42).value" (VInt 42),
runTest "tryEval success flag" $
assertEval "tryEval-flag" "(builtins.tryEval 42).success" (VBool True),
-- tryEval failure
runTest "tryEval catches throw" $
assertEval "tryEval-throw" "(builtins.tryEval (builtins.throw \"boom\")).success" (VBool False),
runTest "tryEval failure value" $
assertEval "tryEval-fval" "(builtins.tryEval (builtins.throw \"boom\")).value" (VBool False),
-- tryEval catches ONLY throw/assert (upstream ThrownError/
-- AssertionError); type errors and missing attrs escape it.
runTest "tryEval catches failed assert" $
assertEval "tryEval-assert" "(builtins.tryEval (assert false; 1)).success" (VBool False),
runTest "tryEval does not catch a type error" $
assertEvalFail "tryEval-tyerr" "(builtins.tryEval ({} + [])).success",
runTest "tryEval does not catch a missing attribute" $
assertEvalFail "tryEval-noattr" "(builtins.tryEval ({ a = 1; }.b)).success",
runTest "tryEval catches a throw nested under forcing" $
assertEval "tryEval-deep-throw" "(builtins.tryEval (builtins.deepSeq [ (builtins.throw \"x\") ] 1)).success" (VBool False),
-- tryEval passed as a VALUE (comparator/element positions) instead
-- of applied syntactically: every application path must keep the
-- catch around the argument's evaluation, and none may leak the
-- old internal 'unreachable' dispatch error.
runTest "tryEval as sort comparator fails like upstream" $
case evalNix "builtins.sort builtins.tryEval [ 1 2 ]" of
Left err
| "unreachable" `T.isInfixOf` err -> Fail ("internal error leaked: " <> err)
| otherwise -> Pass
Right v -> Fail ("expected a boolean-coercion failure, got " <> T.pack (show v)),
runTest "tryEval via map catches a throwing element" $
assertEval
"tryEval-map"
"(builtins.elemAt (builtins.map builtins.tryEval [ (builtins.throw \"m\") ]) 0).success"
(VBool False),
runTest "tryEval via map success-wraps a clean element" $
assertEval
"tryEval-map-ok"
"(builtins.elemAt (builtins.map builtins.tryEval [ 7 ]) 0).value"
(VInt 7),
runTest "tryEval through filter catches the element throw" $
case evalNix "builtins.filter builtins.tryEval [ (builtins.throw \"leaked\") ]" of
Left err
| "leaked" `T.isInfixOf` err -> Fail ("throw escaped tryEval: " <> err)
| otherwise -> Pass
Right v -> Fail ("expected a boolean-coercion failure, got " <> T.pack (show v)),
runTest "functor returning tryEval keeps the catch" $
assertEval
"tryEval-functor"
"(({ __functor = self: builtins.tryEval; }) (builtins.throw \"f\")).success"
(VBool False),
-- deepSeq
runTest "deepSeq returns second" $
assertEval "deepSeq" "builtins.deepSeq [ 1 2 3 ] 42" (VInt 42),
runTest "deepSeq forces nested" $
assertEvalFail "deepSeq-err" "builtins.deepSeq [ (builtins.throw \"boom\") ] 42",
runTest "deepSeq forces attrs" $
assertEvalFail "deepSeq-attr" "builtins.deepSeq { a = builtins.throw \"boom\"; } 42"
]
-- ---------------------------------------------------------------------------
-- Tests: Batch 7 - genericClosure
-- ---------------------------------------------------------------------------
testBatch7 :: IO [Bool]
testBatch7 = do
putStrLn "eval/builtins-batch7"
sequence
[ runTest "genericClosure basic" $
assertEval
"closure-basic"
"builtins.length (builtins.genericClosure { startSet = [ { key = 1; } ]; operator = item: [ ]; })"
(VInt 1),
runTest "genericClosure expansion" $
assertEval
"closure-expand"
"builtins.length (builtins.genericClosure { startSet = [ { key = 1; next = 2; } ]; operator = item: if item.next == 0 then [ ] else [ { key = item.next; next = 0; } ]; })"
(VInt 2),
runTest "genericClosure dedup" $
assertEval
"closure-dedup"
"builtins.length (builtins.genericClosure { startSet = [ { key = 1; } { key = 1; } ]; operator = item: [ ]; })"
(VInt 1),
runTest "genericClosure missing startSet" $
assertEvalFail "closure-nostart" "builtins.genericClosure { operator = x: [ ]; }",
runTest "genericClosure type error" $
assertEvalFail "closure-tyerr" "builtins.genericClosure 42"
]
-- ---------------------------------------------------------------------------
-- Tests: import and IO builtins (pure)
-- ---------------------------------------------------------------------------
testImportPure :: IO [Bool]
testImportPure = do
putStrLn "eval/import-pure"
sequence
[ runTest "import errors in pure mode" $
assertEvalFail "import-pure" "import ./foo.nix",
runTest "builtins.typeOf import is lambda" $
assertEval "typeof-import" "builtins.typeOf import" (mkStr "lambda"),
runTest "pathExists returns false in pure mode" $
assertEval "pathExists-pure" "builtins.pathExists ./nonexistent" (VBool False),
runTest "readFile errors in pure mode" $
assertEvalFail "readFile-pure" "builtins.readFile ./foo.nix",
runTest "readDir errors in pure mode" $
assertEvalFail "readDir-pure" "builtins.readDir ./some-dir"
]
-- ---------------------------------------------------------------------------
-- Tests: import and IO builtins (IO)
-- ---------------------------------------------------------------------------
-- | Parse and evaluate Nix source using the IO evaluator.
-- | The per-suite temp store 'evalNixIO' evaluates against, exposed so
-- a test inspecting materialized trees resolves the same directory.
evalNixIOStoreDir :: IO StoreDir
evalNixIOStoreDir = do
tmpBase <- getTemporaryDirectory
pure (StoreDir (tmpBase </> "nova-nix-test-eval-store"))
-- | IO eval against a per-suite temp store, so no test needs a real,
-- writable platform store root: eval-time store writes land under the
-- temp directory, and the suite runs everywhere without provisioning.
evalNixIO :: FilePath -> Text -> IO (Either Text NixValue)
evalNixIO baseDir source = do
storeDir <- evalNixIOStoreDir
evalNixIOStore storeDir baseDir source
-- | 'evalNixIO' keeping a failure whole, its lines of context included.
evalNixIOTraced :: FilePath -> Text -> IO (Either EvalFailure NixValue)
evalNixIOTraced baseDir source = case parseNix baseDir "<test>" source of
Left err -> pure (Left (EvalFailure [] (T.pack (show err))))
Right expr -> do
storeDir <- evalNixIOStoreDir
st <- newEvalState storeDir baseDir
runEvalIOTraced st (eval (builtinEnv unrestrictedPolicy (esTimestamp st) (esSearchPaths st)) expr)
-- | IO eval of a derivation expression to the 'Derivation' the session
-- recorded for it: forcing the expression's @drvPath@ runs derivationStrict,
-- which records the @.drv@ under that path, and the recipe is read back the
-- way the build driver reads it. Only the IO evaluator keeps the record.
evalDerivationIO :: FilePath -> Text -> IO (Either Text Derivation)
evalDerivationIO baseDir source = case parseNix baseDir "<test>" ("(" <> source <> ").drvPath") of
Left err -> pure (Left (T.pack (show err)))
Right expr -> do
storeDir <- evalNixIOStoreDir
st <- newEvalState storeDir baseDir
runEvalIO st $ do
pathVal <- eval (builtinEnv unrestrictedPolicy (esTimestamp st) (esSearchPaths st)) expr
case pathVal of
VStr pathBytes _ -> do
recorded <- lookupSessionDrv (bytesText pathBytes)
maybe (throwEvalError ("no .drv was recorded for " <> bytesText pathBytes)) pure recorded
other -> throwEvalError ("expected a drvPath string, got " <> typeName other)
-- | Run a named IO eval test - single label, no double-wrapping.
runTestIO :: Text -> FilePath -> Text -> NixValue -> IO Bool
runTestIO label baseDir source expected = do
result <- evalNixIO baseDir source
runTest label $ assertRight label result $ \actual ->
assertEqual label expected actual
-- | Run a named IO eval test that should fail.
runTestIOFail :: Text -> FilePath -> Text -> IO Bool
runTestIOFail label baseDir source = do
result <- evalNixIO baseDir source
runTest label $ assertLeft label result
-- | Quoted path literal for embedding absolute paths in Nix source.
nixQuotedPath :: FilePath -> Text
nixQuotedPath p = T.pack (show p)
-- | The name, builder and system of a derivation, read as upstream's
-- derivationStrict reads them (primops.cc at 2.24.9): the name with
-- forceStringNoCtx, the builder and system as their environment entries
-- coerce, each checked for presence once all are read. Every expected
-- message is nix-instantiate 2.24.9's final error line.
testDerivationFields :: IO [Bool]
testDerivationFields = do
putStrLn "eval/derivation-fields"
let drvWith fields = "(derivation { " <> fields <> " }).drvPath"
plain = "system = \"x\"; builder = \"/bin/sh\";"
withDep body = "let d = derivation { name = \"d\"; " <> plain <> " }; in " <> body
fails label source expected = runTest label (assertEvalError label source expected)
depOut = "/nix/store/simq0c07kvm2wyvasl0k1f619wishj4y-d"
depDrv = "wwk71dy0w17kn5spjd8hbsrk6520xs11-d.drv"
sequence
[ fails "a name that is not a string is refused" (drvWith ("name = 1; " <> plain)) "expected a string but found an integer: 1",
fails "a name with an output's context names it" (withDep (drvWith ("name = \"x${d}\"; " <> plain))) ("the string 'x" <> depOut <> "' is not allowed to refer to a store path (such as '!out!" <> depDrv <> "')"),
fails "a name with a drvPath's context names it" (withDep (drvWith ("name = \"x${d.drvPath}\"; " <> plain))) ("the string 'x/nix/store/" <> depDrv <> "' is not allowed to refer to a store path (such as '=" <> depDrv <> "')"),
fails "a plain path comes first among a name's context" (withDep (drvWith ("name = builtins.appendContext \"x${d}\" { \"/nix/store/00000000000000000000000000000000-a\" = { path = true; }; }; " <> plain))) ("the string 'x" <> depOut <> "' is not allowed to refer to a store path (such as '00000000000000000000000000000000-a')"),
fails "all outputs come before one among a name's context" (withDep (drvWith ("name = \"x${d}${d.drvPath}\"; " <> plain))) ("the string 'x" <> depOut <> "/nix/store/" <> depDrv <> "' is not allowed to refer to a store path (such as '=" <> depDrv <> "')"),
fails "an absent name is getAttr's error" (drvWith plain) "attribute 'name' missing",
fails "an absent builder is refused" (drvWith "name = \"a\"; system = \"x\";") "required attribute 'builder' missing",
fails "an empty builder is refused as absent" (drvWith "name = \"a\"; system = \"x\"; builder = \"\";") "required attribute 'builder' missing",
fails "an empty system is refused as absent" (drvWith "name = \"a\"; system = \"\"; builder = \"/bin/sh\";") "required attribute 'system' missing",
fails "the builder is checked before the system" (drvWith "name = \"a\";") "required attribute 'builder' missing",
fails "an empty name is invalid" (drvWith ("name = \"\"; " <> plain)) "invalid derivation name: name must not be empty. Please pass a different 'name'.",
fails "a dot name is invalid" (drvWith ("name = \".\"; " <> plain)) "invalid derivation name: name '.' is not valid. Please pass a different 'name'.",
fails "a dot component is invalid" (drvWith ("name = \".-a\"; " <> plain)) "invalid derivation name: name '.-a' is not valid: first dash-separated component must not be '.'. Please pass a different 'name'.",
fails "an illegal character is named" (drvWith ("name = \"a b\"; " <> plain)) "invalid derivation name: name 'a b' contains illegal character ' '. Please pass a different 'name'."
]
-- | A path as a derivation's builder or system is copied to the store, as
-- its environment entry is, so the .drv's builder and platform fields hold
-- the store path. Each drvPath is nix-instantiate 2.24.9's.
testDerivationPathFieldsIO :: IO [Bool]
testDerivationPathFieldsIO = do
putStrLn "eval/derivation-path-fields-io"
tmpBase <- getTemporaryDirectory
let dir = tmpBase </> "nova-nix-test-derivation-path-fields"
drvPathOf fields = "builtins.unsafeDiscardStringContext (derivation { name = \"a\"; " <> fields <> " }).drvPath"
script = "/. + " <> nixQuotedPath (dir </> "b.sh")
Dir.removePathForcibly dir
createDirectoryIfMissing True dir
BS.writeFile (dir </> "b.sh") "echo hi\n"
results <-
sequence
[ runTestIO "a path builder is copied to the store" dir (drvPathOf ("system = \"x\"; builder = " <> script <> ";")) (mkStr "/nix/store/gz23n4381jlqwn1gvjqgs3411vr3w4nx-a.drv"),
runTestIO "a path system is copied to the store" dir (drvPathOf ("system = " <> script <> "; builder = \"/bin/sh\";")) (mkStr "/nix/store/382y120pp033h5kx5zfw02q0pglf297l-a.drv")
]
Dir.removePathForcibly dir
pure results
-- | A builtin taking a path coerces its argument as upstream's
-- coerceToPath does (eval.cc at 2.24.9), and baseNameOf and dirOf as
-- their coerceToString does. Each expected value or message is
-- nix-instantiate 2.24.9's.
testPathArguments :: IO [Bool]
testPathArguments = do
putStrLn "eval/path-arguments"
let refuses label source = runTest label (assertEvalError label source "cannot coerce an integer to a string: 1")
fails label source expected = runTest label (assertEvalError label source expected)
gives label source expected = runTest label (assertEval label source expected)
sequence
[ refuses "readFile coerces its argument" "builtins.readFile 1",
refuses "readDir coerces its argument" "builtins.readDir 1",
refuses "pathExists coerces its argument" "builtins.pathExists 1",
refuses "hashFile coerces its path" "builtins.hashFile \"sha256\" 1",
refuses "readFileType coerces its argument" "builtins.readFileType 1",
refuses "import coerces its argument" "import 1",
refuses "scopedImport coerces its path" "builtins.scopedImport { } 1",
refuses "builtins.path coerces its path" "builtins.path { path = 1; }",
refuses "filterSource coerces its path" "builtins.filterSource (p: t: true) 1",
refuses "toPath coerces its argument" "builtins.toPath 1",
fails "a coerced path must be absolute" "builtins.toPath \"a\"" "string 'a' doesn't represent an absolute path",
fails "builtins.path needs a path" "builtins.path { name = \"x\"; }" "missing required 'path' attribute in the first argument to builtins.path",
fails "baseNameOf refuses null as coerceToString does" "builtins.baseNameOf null" "cannot coerce null to a string: null",
fails "dirOf refuses a Boolean as coerceToString does" "builtins.dirOf true" "cannot coerce a Boolean to a string: true",
gives "toPath gives a string" "builtins.typeOf (builtins.toPath \"/a/b\")" (mkStr "string"),
gives "toPath canonicalizes an outPath" "builtins.toPath { outPath = \"/a//b/\"; }" (mkStr "/a/b"),
gives "toPath keeps the context it coerced" "let d = derivation { name = \"d\"; system = \"x\"; builder = \"/bin/sh\"; }; in builtins.concatStringsSep \",\" (builtins.attrNames (builtins.getContext (builtins.toPath \"${d}/bin\")))" (mkStr "/nix/store/wwk71dy0w17kn5spjd8hbsrk6520xs11-d.drv"),
gives "baseNameOf takes a __toString" "builtins.baseNameOf { __toString = s: \"/a/b\"; }" (mkStr "b"),
gives "dirOf takes an outPath, giving a string" "builtins.dirOf { outPath = /a/b; }" (mkStr "/a"),
gives "dirOf of a path stays a path" "builtins.typeOf (builtins.dirOf /a/b)" (mkStr "path")
]
-- | The same coercion reaching the filesystem: an outPath or a __toString
-- names the file read.
testPathArgumentsIO :: IO [Bool]
testPathArgumentsIO = do
putStrLn "eval/path-arguments-io"
-- readFileType refuses a symlink above its path, as upstream's does, and
-- macOS keeps the temporary directory under /var, a link.
tmpBase <- Dir.canonicalizePath =<< getTemporaryDirectory
let dir = tmpBase </> "nova-nix-test-path-arguments"
file = nixQuotedPath (dir </> "f")
Dir.removePathForcibly dir
createDirectoryIfMissing True dir
BS.writeFile (dir </> "f") "contents"
results <-
sequence
[ runTestIO "readFile reads an outPath" dir ("builtins.readFile { outPath = " <> file <> "; }") (mkStr "contents"),
runTestIO "pathExists follows an outPath" dir ("builtins.pathExists { outPath = " <> file <> "; }") (VBool True),
runTestIO "readFileType follows a __toString" dir ("builtins.readFileType { __toString = s: " <> file <> "; }") (mkStr "regular"),
runTestIO "hashFile hashes an outPath" dir ("builtins.hashFile \"sha256\" { outPath = " <> file <> "; }") (mkStr "d1b2a59fbea7e20077af9f91b27e95e865061b270be03ff539ab3b73587882e8")
]
Dir.removePathForcibly dir
pure results
-- | The lines of context a failure gathers on its way out of
-- derivationStrict, and how the CLI reports them (#221). Only the IO
-- evaluator keeps them.
testDerivationTraceIO :: IO [Bool]
testDerivationTraceIO = do
putStrLn "eval/derivation-trace"
let derivationFailure attrs expected = do
tmpBase <- getTemporaryDirectory
result <- evalNixIOTraced tmpBase ("(derivation { builder = \"b\"; " <> attrs <> " }).drvPath")
pure $ case result of
Left failure -> assertEqual "derivation-failure" expected failure
Right val -> Fail ("expected a failure, got " <> T.pack (show val))
sequence
[ -- A failure processing one attribute carries upstream's line naming
-- it and its derivation (derivationStrictInternal, primops.cc at
-- 2.24.9); the message itself is unchanged.
runTestM
"a failing derivation attribute is named in the failure's trace"
( derivationFailure
"system = \"s\"; name = \"x\"; foo = { };"
(EvalFailure ["while evaluating attribute 'foo' of derivation 'x'"] "cannot coerce a set to a string: { }")
),
runTestM
"a structured attribute with no JSON form is named in the failure's trace"
( derivationFailure
"system = \"s\"; name = \"x\"; __structuredAttrs = true; foo = x: x;"
(EvalFailure ["while evaluating attribute 'foo' of derivation 'x'"] "builtins.toJSON: cannot convert a function to JSON")
),
-- prim_derivationStrict adds its own line outside forceStringNoCtx's.
runTestM
"a failing name carries both of upstream's lines"
( derivationFailure
"system = \"s\"; name = throw \"n\";"
( EvalFailure
[ "while evaluating the derivation attribute 'name'",
"while evaluating the `name` attribute passed to builtins.derivationStrict"
]
"n"
)
),
runTestM
"a switch that is not a Boolean is named in the failure's trace"
( derivationFailure
"system = \"s\"; name = \"x\"; __ignoreNulls = 1;"
(EvalFailure ["while evaluating the `__ignoreNulls` attribute passed to builtins.derivationStrict"] "expected a Boolean but found an integer: 1")
),
runTestM
"a structured-attributes switch that is not a Boolean is named in the failure's trace"
( derivationFailure
"system = \"s\"; name = \"x\"; __structuredAttrs = 1;"
(EvalFailure ["while evaluating the `__structuredAttrs` attribute passed to builtins.derivationStrict"] "expected a Boolean but found an integer: 1")
),
runTestM
"a structured string field that is not a string is named in the failure's trace"
( derivationFailure
"system = \"s\"; name = \"x\"; __structuredAttrs = true; outputHash = 1;"
(EvalFailure ["while evaluating attribute 'outputHash' of derivation 'x'"] "expected a string but found an integer: 1")
),
runTestM
"a missing attribute is refused without a line naming it"
(derivationFailure "name = \"x\";" (EvalFailure [] "required attribute 'system' missing")),
runTestM "a failure in a dependency is traced through each derivation, outermost first" $ do
tmpBase <- getTemporaryDirectory
result <-
evalNixIOTraced tmpBase $
"let inner = derivation { name = \"inner\"; system = \"s\"; builder = \"b\"; bad = { }; };"
<> " in (derivation { name = \"outer\"; system = \"s\"; builder = \"b\"; dep = inner; }).drvPath"
pure $ case result of
Left failure ->
assertEqual
"nested-trace"
["while evaluating attribute 'dep' of derivation 'outer'", "while evaluating attribute 'bad' of derivation 'inner'"]
(failureTrace failure)
Right val -> Fail ("expected a failure, got " <> T.pack (show val)),
runTestM "a throw in a derivation attribute stays catchable" $ do
tmpBase <- getTemporaryDirectory
result <- evalNixIO tmpBase "(builtins.tryEval (derivation { name = \"x\"; system = \"s\"; builder = \"b\"; foo = throw \"t\"; }).drvPath).success"
pure $ assertRight "trace-catchable" result (assertEqual "trace-catchable" (VBool False)),
-- upstream's showErrorInfo and indent (error.cc at 2.24.9), checked
-- against nix-instantiate 2.24.9's report for the same failure with
-- its positioned lines left out.
runTest "a failure renders as upstream reports it" $
assertEqual
"render-traced"
"error:\n \x2026 while evaluating attribute 'foo' of derivation 'x'\n\n error: a\n b"
(renderEvalFailure (EvalFailure ["while evaluating attribute 'foo' of derivation 'x'"] "a\nb")),
runTest "a failure with no trace renders on the error line" $
assertEqual "render-untraced" "error: a\n b" (renderEvalFailure (EvalFailure [] "a\nb"))
]
-- | Regression: a thunk whose force throws a catchable error (builtins.throw,
-- a type error) must be restored to PENDING, not left BLACKHOLE - otherwise a
-- later force of the same shared thunk aborts with a bogus "infinite recursion"
-- that escapes tryEval. Genuine self-recursion must still escape tryEval.
-- EvalIO-only: PureEval never blackholes.
testBlackholeRecoveryIO :: IO [Bool]
testBlackholeRecoveryIO = do
putStrLn "eval/blackhole-recovery-io"
sequence
[ runTestIO
"tryEval twice on a shared throwing thunk recovers (no bogus recursion)"
"."
"let x = builtins.throw \"boom\"; in (if (builtins.tryEval x).success then 1 else 0) + (if (builtins.tryEval x).success then 1 else 0)"
(VInt 0),
runTestIOFail
"genuine infinite recursion still escapes tryEval"
"."
"builtins.tryEval (let y = y; in y)"
]
-- | builtins.path/filterSource with a filter: the tree is serialized with
-- rejected entries removed (a rejected directory prunes its subtree),
-- content-addressed over the FILTERED NAR, and materialized to the store.
testPathFilterIO :: IO [Bool]
testPathFilterIO = do
putStrLn "eval/path-filter-io"
testPathFilterBody
testPathFilterBody :: IO [Bool]
testPathFilterBody = do
tmpBase <- getTemporaryDirectory
let srcDir = tmpBase </> "nova-nix-test-path-filter"
setup = do
removeIfExists srcDir
createDirectoryIfMissing True (srcDir </> "sub")
createDirectoryIfMissing True (srcDir </> "dropdir")
BS.writeFile (srcDir </> "keep.txt") "keep"
BS.writeFile (srcDir </> "drop.log") "drop"
BS.writeFile (srcDir </> "sub" </> "inner.txt") "inner"
BS.writeFile (srcDir </> "dropdir" </> "x.txt") "gone"
quoted = nixQuotedPath srcDir
filterExpr = "(p: t: builtins.match \".*[.]log\" p == null && baseNameOf p != \"dropdir\")"
filteredPath = "(builtins.path { path = " <> quoted <> "; name = \"src\"; filter = " <> filterExpr <> "; })"
unfilteredPath = "(builtins.path { path = " <> quoted <> "; name = \"src\"; })"
-- bracket_: cleanup runs even if tests throw
bracket_ setup (removeIfExists srcDir) $
sequence
[ runTestIO
"kept file survives with its content"
"."
("builtins.readFile (" <> filteredPath <> " + \"/keep.txt\")")
(mkStr "keep"),
runTestIO
"kept subtree survives"
"."
("builtins.readFile (" <> filteredPath <> " + \"/sub/inner.txt\")")
(mkStr "inner"),
runTestIO
"rejected file is dropped"
"."
("builtins.pathExists (" <> filteredPath <> " + \"/drop.log\")")
(VBool False),
runTestIO
"rejected directory prunes its subtree"
"."
("builtins.pathExists (" <> filteredPath <> " + \"/dropdir\")")
(VBool False),
runTestIO
"filtered and unfiltered store paths differ"
"."
(filteredPath <> " == " <> unfilteredPath)
(VBool False),
runTestIO
"same filter yields the same store path"
"."
(filteredPath <> " == " <> filteredPath)
(VBool True),
runTestIO
"filterSource is path-with-filter under the source basename"
"."
( "builtins.filterSource (p: t: true) "
<> quoted
<> " == builtins.path { path = "
<> quoted
<> "; filter = (p: t: true); }"
)
(VBool True)
]
-- | Whether this host can create symlinks (Windows needs Developer Mode
-- or elevation). The symlink-walk fixtures cannot be built without it,
-- so their groups skip loudly rather than fail.
symlinksAvailable :: IO Bool
symlinksAvailable = do
tmpBase <- getTemporaryDirectory
let probeDir = tmpBase </> "nova-nix-test-link-probe"
Dir.removePathForcibly probeDir
createDirectoryIfMissing True probeDir
BS.writeFile (probeDir </> "target.txt") "t"
outcome <- try (Dir.createFileLink "target.txt" (probeDir </> "link"))
Dir.removePathForcibly probeDir
pure $ case (outcome :: Either SomeException ()) of
Left _ -> False
Right () -> True
-- | Interpolating a path that is a symlink copies what it points to,
-- under the link's own name: upstream's copyPathToStore stores
-- path.resolveSymlinks() under path.baseName() (eval.cc at 2.24.9).
testInterpolatedSymlinkIO :: IO [Bool]
testInterpolatedSymlinkIO = do
putStrLn "eval/interpolated-symlink-io"
canLink <- symlinksAvailable
if not canLink
then do
putStrLn " SKIP needs symlink privilege"
pure []
else testInterpolatedSymlinkBody
testInterpolatedSymlinkBody :: IO [Bool]
testInterpolatedSymlinkBody = do
tmpBase <- getTemporaryDirectory
let dir = tmpBase </> "nova-nix-test-interpolated-symlink"
Dir.removePathForcibly dir
createDirectoryIfMissing True (dir </> "sub")
BS.writeFile (dir </> "data.txt") "linked bytes"
BS.writeFile (dir </> "sub" </> "inner.txt") "inner"
Dir.createFileLink "data.txt" (dir </> "filelink")
Dir.createDirectoryLink "sub" (dir </> "dirlink")
fileEntry <- NAR.serialiseFromPath (dir </> "data.txt")
dirEntry <- NAR.serialiseFromPath (dir </> "sub")
let interpolated name = evalNixIO "." ("\"${/. + " <> nixQuotedPath (dir </> name) <> "}\"")
copiedAs name entry =
either (const Nothing) (Just . storePathToText defaultStoreDir) (makeFixedOutputPath (T.pack name) "sha256" "recursive" (sha256Digest (NAR.serialise entry)))
copies name entry = runTestM ("interpolating " <> T.pack name <> " copies its target") $ do
result <- interpolated name
pure $ case (result, copiedAs name entry) of
(_, Nothing) -> Fail "fixture store path rejected"
(Right (VStr got _), Just expected) -> assertEqual (T.pack name) (TE.encodeUtf8 expected) got
(Right other, _) -> Fail ("expected a string, got " <> T.pack (show other))
(Left err, _) -> Fail ("eval failed: " <> err)
results <-
sequence
[ copies "filelink" fileEntry,
copies "dirlink" dirEntry
]
Dir.removePathForcibly dir
pure results
-- | A failed source-path access reworded as upstream's PosixSourceAccessor
-- words it (2.24.9), from IOExceptions shaped as GHC raises them.
testSourceErrorMessage :: IO [Bool]
testSourceErrorMessage = do
putStrLn "eval/source-error-message"
let errnoFailure kind (Errno code) description =
IOError Nothing kind "test" description (Just code) (Just "/d/x")
absent = errnoFailure NoSuchThing eNOENT "No such file or directory"
notDirectory = errnoFailure InappropriateType eNOTDIR "Not a directory"
denied = errnoFailure PermissionDenied eACCES "Permission denied"
isDirectory = errnoFailure InappropriateType eISDIR "Is a directory"
-- GHC's openFile refuses a directory itself, with no errno.
ghcDirectory = IOError Nothing InappropriateType "openFile" "is a directory" Nothing (Just "/d/dir")
says label access path err expected =
runTest label (assertEqual label expected (sourceErrorMessage access path err))
sequence
[ says "a stat of an absent path" StatPath "/d/nope" absent "path '/d/nope' does not exist",
says "a stat through a file is absent too" StatPath "/d/file/x" notDirectory "path '/d/file/x' does not exist",
says "a stat refused otherwise names the stat" StatPath "/d/x" denied "getting status of '/d/x': Permission denied",
says "opening an absent file" ReadFile "/d/nope" absent "opening file '/d/nope': No such file or directory",
says "opening a file refused" ReadFile "/d/x" denied "opening file '/d/x': Permission denied",
says "reading a directory as a file" ReadFile "/d/dir" isDirectory "reading from file '/d/dir': Is a directory",
says "GHC's own directory refusal reads as upstream's" ReadFile "/d/dir" ghcDirectory "reading from file '/d/dir': Is a directory",
says "listing a file" ReadDirectory "/d/file" notDirectory "reading directory /d/file: Not a directory"
]
-- | The same failures through the IO evaluator, against a real tree.
-- POSIX only: Windows reports its own error text, and a path there is
-- spelled with a drive.
testSourceReadErrorsIO :: IO [Bool]
testSourceReadErrorsIO = do
putStrLn "eval/source-read-errors-io"
if SI.os == "mingw32"
then do
putStrLn " SKIP POSIX error text"
pure []
else testSourceReadErrorsBody
testSourceReadErrorsBody :: IO [Bool]
testSourceReadErrorsBody = do
-- The temporary directory's own symlinks resolved (macOS keeps it under
-- /var, a link), so the only link in play is the one made below.
tmpBase <- Dir.canonicalizePath =<< getTemporaryDirectory
let dir = tmpBase </> "nova-nix-test-source-read-errors"
Dir.removePathForcibly dir
createDirectoryIfMissing True (dir </> "sub")
createDirectoryIfMissing True (dir </> "real")
BS.writeFile (dir </> "file") "f"
Dir.createDirectoryLink "real" (dir </> "link")
let resolved = T.pack dir
given = T.pack dir
at name = "/. + " <> nixQuotedPath (dir </> name)
fails label source expected = runTestM label (assertEvalErrorIO dir label source expected)
results <-
sequence
[ fails "readFile of an absent file" ("builtins.readFile (" <> at "nope" <> ")") ("opening file '" <> resolved <> "/nope': No such file or directory"),
fails "hashFile of an absent file" ("builtins.hashFile \"sha256\" (" <> at "nope" <> ")") ("opening file '" <> resolved <> "/nope': No such file or directory"),
fails "readFile through a file" ("builtins.readFile (" <> at "file/x" <> ")") ("opening file '" <> resolved <> "/file/x': Not a directory"),
fails "readFile of a directory" ("builtins.readFile (" <> at "sub" <> ")") ("reading from file '" <> resolved <> "/sub': Is a directory"),
fails "readDir of an absent directory" ("builtins.readDir (" <> at "nope" <> ")") ("reading directory " <> resolved <> "/nope: No such file or directory"),
fails "readDir of a file" ("builtins.readDir (" <> at "file" <> ")") ("reading directory " <> resolved <> "/file: Not a directory"),
fails "readFileType of an absent path" ("builtins.readFileType (" <> at "nope" <> ")") ("path '" <> given <> "/nope' does not exist"),
fails "interpolating an absent path" ("\"${" <> at "nope" <> "}\"") ("path '" <> resolved <> "/nope' does not exist"),
fails "builtins.path of an absent path" ("builtins.path { path = " <> at "nope" <> "; }") ("path '" <> resolved <> "/nope' does not exist"),
fails "importing an absent path" ("import (" <> at "nope" <> ")") ("path '" <> resolved <> "/nope' does not exist"),
fails "importing a directory without default.nix" ("import (" <> at "sub" <> ")") ("opening file '" <> resolved <> "/sub/default.nix': No such file or directory"),
-- Through a symlinked directory a read names the resolved path, as
-- realisePath resolves it, and readFileType refuses the link.
fails "readFile through a link names the resolved path" ("builtins.readFile (" <> at "link/nope" <> ")") ("opening file '" <> resolved <> "/real/nope': No such file or directory"),
fails "readDir through a link names the resolved path" ("builtins.readDir (" <> at "link/nope" <> ")") ("reading directory " <> resolved <> "/real/nope: No such file or directory"),
fails "import through a link names the resolved path" ("import (" <> at "link/nope" <> ")") ("path '" <> resolved <> "/real/nope' does not exist"),
fails "readFileType through a link refuses the link" ("builtins.readFileType (" <> at "link/nope" <> ")") ("path '" <> given <> "/link' is a symlink")
]
Dir.removePathForcibly dir
pure results
-- | Watchdog for cycle-termination tests: with symlinks as leaves every
-- walk returns promptly, while a regression to link-following recurses
-- forever - and a hung suite is worse than a failed one.
walkWatchdogMicros :: Int
walkWatchdogMicros = 30 * 1000 * 1000
-- | @builtins.path@ with no filter over a tree that contains a symlink.
-- The store-path name comes from the NAR serialization, which records
-- the link as a leaf entry - so the copy must replicate the link for
-- the stored bytes to still match the recorded content address.
testPathSymlinkIO :: IO [Bool]
testPathSymlinkIO = do
putStrLn "eval/path-symlink-io"
canLink <- symlinksAvailable
if not canLink
then do
putStrLn " SKIP needs symlink privilege"
pure []
else testPathSymlinkBody
testPathSymlinkBody :: IO [Bool]
testPathSymlinkBody = do
tmpBase <- getTemporaryDirectory
let srcDir = tmpBase </> "nova-nix-test-path-symlink"
cycleDir = tmpBase </> "nova-nix-test-path-cycle"
Dir.removePathForcibly srcDir
Dir.removePathForcibly cycleDir
createDirectoryIfMissing True srcDir
BS.writeFile (srcDir </> "data.txt") "linked bytes"
Dir.createFileLink "data.txt" (srcDir </> "link")
createDirectoryIfMissing True cycleDir
BS.writeFile (cycleDir </> "f.txt") "f"
Dir.createDirectoryLink "." (cycleDir </> "loop")
linkEntry <- NAR.serialiseFromPath srcDir
cycleEntry <- NAR.serialiseFromPath cycleDir
let pathExprFor dir name =
"builtins.path { path = " <> nixQuotedPath dir <> "; name = \"" <> name <> "\"; }"
spFor name entry =
makeFixedOutputPath name "sha256" "recursive" (sha256Digest (NAR.serialise entry))
results <- case (spFor "path-symlink-src" linkEntry, spFor "path-symlink-cycle" cycleEntry) of
(Right linkSp, Right cycleSp) -> do
-- The same mapping the evaluator's copy uses for its destination.
evalStore <- evalNixIOStoreDir
let linkDest = storePathToFilePath evalStore linkSp
cycleDest = storePathToFilePath evalStore cycleSp
-- A leftover materialization from an earlier (possibly pre-fix) run
-- would short-circuit the copy under test.
Dir.removePathForcibly linkDest
Dir.removePathForcibly cycleDest
linkEval <- evalNixIO "." (pathExprFor srcDir "path-symlink-src")
cycleEval <- timeout walkWatchdogMicros (evalNixIO "." (pathExprFor cycleDir "path-symlink-cycle"))
sequence
[ runTestM "unfiltered builtins.path replicates a symlink" $
case linkEval of
Left err -> pure (Fail ("eval failed: " <> err))
Right _ -> do
isLink <- Dir.pathIsSymbolicLink (linkDest </> "link")
if isLink
then do
target <- Dir.getSymbolicLinkTarget (linkDest </> "link")
pure (assertEqual "link target" "data.txt" target)
else pure (Fail "materialized 'link' is not a symlink"),
runTestM "materialized bytes reproduce the recorded content address" $
case linkEval of
Left err -> pure (Fail ("eval failed: " <> err))
Right _ -> do
onDisk <- NAR.serialiseFromPath linkDest
pure $ case spFor "path-symlink-src" onDisk of
Left err -> Fail ("on-disk tree's name rejected: " <> T.pack (show err))
Right recomputed -> assertEqual "recomputed path" linkSp recomputed,
runTestM "builtins.path terminates on a link cycle" $
case cycleEval of
Nothing -> pure (Fail "copy did not terminate on a link cycle")
Just (Left err) -> pure (Fail ("eval failed: " <> err))
Just (Right _) -> do
isLink <- Dir.pathIsSymbolicLink (cycleDest </> "loop")
pure (if isLink then Pass else Fail "cycle link not replicated as a link")
]
(badLink, badCycle) ->
sequence
[ runTest "path-symlink fixture store paths accepted" $
Fail ("test store path rejected: " <> T.pack (show (badLink, badCycle)))
]
Dir.removePathForcibly srcDir
Dir.removePathForcibly cycleDir
pure results
testImportIO :: IO [Bool]
testImportIO = do
putStrLn "eval/import-io"
tmpBase <- getTemporaryDirectory
let testDir = tmpBase </> "nova-nix-test-import"
subDir = testDir </> "sub"
setup = do
createDirectoryIfMissing True subDir
TIO.writeFile (testDir </> "literal.nix") "42"
TIO.writeFile (testDir </> "expr.nix") "1 + 2"
TIO.writeFile (testDir </> "nested-inner.nix") "99"
TIO.writeFile (testDir </> "nested-outer.nix") "import ./nested-inner.nix"
TIO.writeFile (testDir </> "attrset.nix") "{ x = 1; y = 2; }"
TIO.writeFile (testDir </> "uses-arg.nix") "let f = x: x + 10; in f 5"
TIO.writeFile (subDir </> "from-sub.nix") "7"
cleanup = do
exists <- doesDirectoryExist testDir
when exists (removeDirectoryRecursive testDir)
-- bracket_: cleanup runs even if tests throw
bracket_ setup cleanup $
sequence
[ -- import
runTestIO "import literal" testDir "import ./literal.nix" (VInt 42),
runTestIO "import expression" testDir "import ./expr.nix" (VInt 3),
runTestIO "import nested (A imports B)" testDir "import ./nested-outer.nix" (VInt 99),
runTestIO
"import cache (same file twice)"
testDir
"(import ./literal.nix) + (import ./literal.nix)"
(VInt 84),
runTestIOFail "import nonexistent -> error" testDir "import ./nonexistent.nix",
runTestIO "import attrset + select" testDir "(import ./attrset.nix).x" (VInt 1),
runTestIO "import let/lambda" testDir "import ./uses-arg.nix" (VInt 15),
-- A string is coerced to a path only when it spells an absolute
-- one; upstream refuses a relative string outright.
runTestIOFail "import refuses a relative string" testDir "import \"./literal.nix\"",
-- pathExists
runTestIO
"pathExists true"
testDir
("builtins.pathExists " <> nixQuotedPath (testDir </> "literal.nix"))
(VBool True),
runTestIO
"pathExists false"
testDir
("builtins.pathExists " <> nixQuotedPath (testDir </> "nope.nix"))
(VBool False),
-- readFile
runTestIO
"readFile contents"
testDir
("builtins.readFile " <> nixQuotedPath (testDir </> "literal.nix"))
(mkStr "42"),
runTestIOFail
"readFile missing -> error"
testDir
("builtins.readFile " <> nixQuotedPath (testDir </> "ghost.nix")),
-- readDir: entries have correct file types
runTestIO
"readDir classifies directory"
testDir
("(builtins.readDir " <> nixQuotedPath testDir <> ").sub")
(mkStr "directory"),
runTestIO
"readDir classifies regular file"
testDir
("builtins.getAttr \"literal.nix\" (builtins.readDir " <> nixQuotedPath testDir <> ")")
(mkStr "regular")
]
-- ---------------------------------------------------------------------------
-- Tests: Batch A - getEnv, currentTime, toPath
-- ---------------------------------------------------------------------------
testBatchA :: IO [Bool]
testBatchA = do
putStrLn "eval/builtins-batchA"
sequence
[ -- getEnv
runTest "getEnv pure returns empty" $
assertEval "getEnv-pure" "builtins.getEnv \"HOME\"" (mkStr ""),
runTest "getEnv type error" $
assertEvalFail "getEnv-err" "builtins.getEnv 42",
-- toPath
runTest "toPath absolute" $
assertEval "toPath-abs" "builtins.toPath \"/foo/bar\"" (mkStr "/foo/bar"),
runTest "toPath rejects relative" $
assertEvalFail "toPath-rel" "builtins.toPath \"foo/bar\"",
runTest "toPath of a path gives its string" $
assertEval "toPath-vpath" "builtins.toPath /foo/bar" (mkStr "/foo/bar"),
runTest "toPath type error" $
assertEvalFail "toPath-err" "builtins.toPath 42",
runTest "toPath rejects empty" $
assertEvalFail "toPath-empty" "builtins.toPath \"\"",
-- currentTime
runTest "currentTime is int" $
assertEval "currentTime" "builtins.typeOf builtins.currentTime" (mkStr "int"),
runTest "currentTime is 0 in pure" $
assertEval "currentTime-pure" "builtins.currentTime" (VInt 0),
runTest "currentTime >= 0" $
assertEval "currentTime-pos" "builtins.currentTime >= 0" (VBool True)
]
-- ---------------------------------------------------------------------------
-- Tests: Batch A - IO tests (getEnv)
-- ---------------------------------------------------------------------------
testBatchAIO :: IO [Bool]
testBatchAIO = do
putStrLn "eval/builtins-batchA-io"
tmpBase <- getTemporaryDirectory
let testDir = tmpBase </> "nova-nix-test-batchA"
bracket_
(createDirectoryIfMissing True testDir)
( do
exists <- doesDirectoryExist testDir
when exists (removeDirectoryRecursive testDir)
)
$ sequence
[ -- getEnv HOME should be non-empty in IO mode
do
result <- evalNixIO testDir "builtins.getEnv \"PATH\""
runTest "getEnv PATH non-empty (IO)" $ assertRight "getEnv-io" result $ \val ->
case val of
VStr s _ -> if BS.null s then Fail "PATH was empty" else Pass
_ -> Fail ("expected VStr, got " <> T.pack (show val)),
-- currentTime in IO should be > 0
do
result <- evalNixIO testDir "builtins.currentTime"
runTest "currentTime > 0 (IO)" $ assertRight "currentTime-io" result $ \val ->
case val of
VInt n -> if n > 0 then Pass else Fail ("expected > 0, got " <> T.pack (show n))
_ -> Fail ("expected VInt, got " <> T.pack (show val))
]
-- ---------------------------------------------------------------------------
-- Tests: environment values as bytes
-- ---------------------------------------------------------------------------
-- | An environment value reaches the evaluator as its bytes, through
-- @builtins.getEnv@ and through @NIX_PATH@, as upstream's @getenv@ reads
-- it; each case's outcome was read off nix-instantiate 2.33.2 under the
-- same environment. A POSIX environment is bytes and a Windows one is
-- UTF-16, so each platform runs the cases its environment can express.
testEnvironmentBytes :: IO [Bool]
testEnvironmentBytes = do
putStrLn "eval/environment-bytes"
tmpBase <- getTemporaryDirectory
let testDir = tmpBase </> "nova-nix-test-env-bytes"
pkgDir = testDir </> "mypkg"
bracket_
( do
createDirectoryIfMissing True pkgDir
BS.writeFile (pkgDir </> "default.nix") "42"
BS.writeFile (testDir </> "name.bin") nonUtf8EnvName
)
(Dir.removePathForcibly testDir)
$ do
getEnvResults <- mapM (getEnvCase testDir) envByteCases
nixPathResults <- mapM (nixPathCase testDir) envByteCases
rest <-
sequence
[ withEnvBytes "a lookup passes a NIX_PATH entry whose prefix has no UTF-8 reading" (TE.encodeUtf8 nixPathVarName) ("\xFC=/nonexistent:mypkg=" <> TE.encodeUtf8 (T.pack pkgDir)) $
assertEqual "lookup" (Right (VInt 42)) <$> evalNixIO testDir "import <mypkg>",
withEnvBytes "getEnv looks a name up by its bytes" nonUtf8EnvName "hello" $
expectBytes "name" "hello" <$> evalNixIO testDir "builtins.getEnv (builtins.readFile ./name.bin)",
unpairedSurrogateGetEnv testDir,
unpairedSurrogateNixPath testDir
]
pure (getEnvResults ++ nixPathResults ++ rest)
where
getEnvCase dir (label, bytes) =
withEnvBytes ("getEnv carries " <> label) (TE.encodeUtf8 testEnvVarName) bytes $
expectBytes "getEnv" bytes <$> evalNixIO dir ("builtins.getEnv \"" <> testEnvVarName <> "\"")
nixPathCase dir (label, bytes) =
withEnvBytes ("NIX_PATH carries " <> label <> " into prefix and path") (TE.encodeUtf8 nixPathVarName) (bytes <> "=/x" <> bytes) $
expectBytes "nixPath" (bytes <> "|/x" <> bytes) <$> evalNixIO dir "let e = builtins.head builtins.nixPath; in e.prefix + \"|\" + e.path"
expectBytes label expected = \case
Right (VStr actual _) -> assertEqual label expected actual
other -> Fail (label <> ": expected a string, got " <> T.pack (show other))
-- | The values the environment cases carry: a byte with no UTF-8 reading,
-- a multibyte UTF-8 character, and nothing at all.
envByteCases :: [(Text, BS.ByteString)]
envByteCases =
[ ("a byte with no UTF-8 reading", "\xFC"),
("a multibyte UTF-8 value", "caf\xC3\xA9"),
("an empty value", "")
]
testEnvVarName :: Text
testEnvVarName = "NOVA_NIX_TEST_ENV_BYTES"
nixPathVarName :: Text
nixPathVarName = "NIX_PATH"
-- | A variable name holding a byte with no UTF-8 reading.
nonUtf8EnvName :: BS.ByteString
nonUtf8EnvName = "NOVA_NIX_TEST_ENV_\xFC"
-- | Run one case with a variable set to the given bytes, restoring it
-- afterwards. A Windows environment is UTF-16 and cannot hold a byte
-- with no UTF-8 reading, so such a case skips there.
withEnvBytes :: Text -> BS.ByteString -> BS.ByteString -> IO TestResult -> IO Bool
withEnvBytes label name value check = do
spelledName <- envSpelling name
spelledValue <- envSpelling value
case (,) <$> spelledName <*> spelledValue of
Nothing -> True <$ putStrLn (" SKIP " <> T.unpack label <> ": a Windows environment cannot hold a byte with no UTF-8 reading")
Just (nameSpelling, valueSpelling) -> runTestM label (withEnvVar nameSpelling valueSpelling check)
-- | The 'String' that base's environment setters and file functions, and
-- a spawned process's environment, write as the given bytes: on POSIX
-- they encode with the file-system encoding, whose round-trip escape
-- restores every byte its decoding escaped, and on Windows they write
-- UTF-16.
envSpelling :: BS.ByteString -> IO (Maybe String)
envSpelling bytes
| SI.os == "mingw32" = pure (either (const Nothing) (Just . T.unpack) (TE.decodeUtf8' bytes))
| otherwise = do
encoding <- getFileSystemEncoding
Just <$> BS.useAsCStringLen bytes (GHCForeign.peekCStringLen encoding)
-- | Run an action with a variable set (to an empty value too, which
-- 'setEnv' would unset), restoring what the variable held afterwards.
withEnvVar :: String -> String -> IO a -> IO a
withEnvVar name value action =
bracket (lookupEnv name) restore (const (Blank.setEnv name value True >> action))
where
restore = maybe (unsetEnv name) (\saved -> Blank.setEnv name saved True)
-- | A Windows value holding an unpaired UTF-16 surrogate has no UTF-8
-- form, so getEnv refuses it rather than substituting U+FFFD.
unpairedSurrogateGetEnv :: FilePath -> IO Bool
unpairedSurrogateGetEnv dir
| SI.os /= "mingw32" = True <$ putStrLn unpairedSurrogateSkip
| otherwise =
runTestM "getEnv refuses a value holding an unpaired surrogate" $
withEnvVar (T.unpack testEnvVarName) "a\xD800" $ do
result <- evalNixIO dir ("builtins.getEnv \"" <> testEnvVarName <> "\"")
pure $ case result of
Left err | unpairedSurrogateWords `T.isInfixOf` err -> Pass
other -> Fail ("expected the unpaired-surrogate refusal, got " <> T.pack (show other))
-- | The same refusal for @NIX_PATH@, raised as the evaluation state is
-- created.
unpairedSurrogateNixPath :: FilePath -> IO Bool
unpairedSurrogateNixPath dir
| SI.os /= "mingw32" = True <$ putStrLn unpairedSurrogateSkip
| otherwise =
runTestM "NIX_PATH holding an unpaired surrogate is refused" $
withEnvVar (T.unpack nixPathVarName) "a=\xD800" $ do
storeDir <- evalNixIOStoreDir
outcome <- try (newEvalState storeDir dir)
pure $ case outcome of
Left (err :: IOException)
| unpairedSurrogateWords `T.isInfixOf` T.pack (displayException err) -> Pass
| otherwise -> Fail ("wrong error: " <> T.pack (displayException err))
Right _ -> Fail "NIX_PATH was accepted"
unpairedSurrogateWords :: Text
unpairedSurrogateWords = "unpaired UTF-16 surrogate"
unpairedSurrogateSkip :: String
unpairedSurrogateSkip = " SKIP an unpaired UTF-16 surrogate exists only in a Windows environment"
-- ---------------------------------------------------------------------------
-- Tests: Batch B - placeholder, storePath
-- ---------------------------------------------------------------------------
testBatchB :: IO [Bool]
testBatchB = do
putStrLn "eval/builtins-batchB"
sequence
[ -- placeholder
runTest "placeholder out matches Nix hashPlaceholder" $
assertRight "placeholder-out" (evalNix "builtins.placeholder \"out\"") $ \val ->
case val of
VStr p _ -> assertEqual "placeholder out" "/1rz4g4znpzjwh1xymhjpm42vipw92pr73vdgl6xs1hycac8kf2n9" p
_ -> Fail ("expected VStr, got " <> T.pack (show val)),
runTest "placeholder deterministic" $
assertRight "placeholder-det" (evalNix "builtins.placeholder \"out\" == builtins.placeholder \"out\"") $ \val ->
assertEqual "deterministic" (VBool True) val,
runTest "placeholder out /= placeholder dev" $
assertRight "placeholder-diff" (evalNix "builtins.placeholder \"out\" == builtins.placeholder \"dev\"") $ \val ->
assertEqual "different" (VBool False) val,
runTest "placeholder type error" $
assertEvalFail "placeholder-err" "builtins.placeholder 42",
-- storePath returns a STRING marked already-in-store (SCPlain context),
-- not a bare path - the marker is what stops a later coercion re-NARing it.
runTest "storePath returns an in-store string" $
assertEval
"storePath-isstring"
"builtins.isString (builtins.storePath \"/nix/store/s66mzxpvicwk07gjbjfw9izjfa797vsw-hello-2.12.1\")"
(VBool True),
runTest "storePath result carries a plain-path context" $
assertEval
"storePath-hasctx"
"(builtins.getContext (builtins.storePath \"/nix/store/s66mzxpvicwk07gjbjfw9izjfa797vsw-hello-2.12.1\")).\"/nix/store/s66mzxpvicwk07gjbjfw9izjfa797vsw-hello-2.12.1\".path"
(VBool True),
runTest "storePath preserves the path text" $
assertEval
"storePath-text"
"builtins.unsafeDiscardStringContext (builtins.storePath \"/nix/store/s66mzxpvicwk07gjbjfw9izjfa797vsw-hello-2.12.1\")"
(mkStr "/nix/store/s66mzxpvicwk07gjbjfw9izjfa797vsw-hello-2.12.1"),
runTest "storePath invalid" $
assertEvalFail "storePath-bad" "builtins.storePath \"/tmp/not-a-store-path\"",
runTest "storePath type error" $
assertEvalFail "storePath-err" "builtins.storePath 42"
]
-- ---------------------------------------------------------------------------
-- Tests: Batch C - findFile
-- ---------------------------------------------------------------------------
testBatchC :: IO [Bool]
testBatchC = do
putStrLn "eval/builtins-batchC"
sequence
[ runTest "findFile empty list errors" $
assertEvalFail "findFile-empty" "builtins.findFile [ ] \"foo\"",
runTest "findFile type error arg1" $
assertEvalFail "findFile-err1" "builtins.findFile 42 \"foo\"",
runTest "findFile type error arg2" $
assertEvalFail "findFile-err2" "builtins.findFile [ ] 42"
]
testBatchCIO :: IO [Bool]
testBatchCIO = do
putStrLn "eval/builtins-batchC-io"
tmpBase <- getTemporaryDirectory
let testDir = tmpBase </> "nova-nix-test-batchC"
nixpkgsDir = testDir </> "nixpkgs"
bracket_
( do
createDirectoryIfMissing True nixpkgsDir
TIO.writeFile (nixpkgsDir </> "default.nix") "42"
)
( do
exists <- doesDirectoryExist testDir
when exists (removeDirectoryRecursive testDir)
)
$ sequence
[ runTestIO
"findFile with matching entry"
testDir
( "builtins.findFile [ { prefix = \"nixpkgs\"; path = "
<> nixQuotedPath nixpkgsDir
<> "; } ] \"nixpkgs\""
)
(VPath (canonPathValue (T.pack nixpkgsDir))),
runTestIOFail
"findFile no match"
testDir
"builtins.findFile [ { prefix = \"other\"; path = \"/nope\"; } ] \"nixpkgs\""
]
-- ---------------------------------------------------------------------------
-- Tests: Blackhole (infinite recursion detection)
-- ---------------------------------------------------------------------------
testBlackhole :: IO [Bool]
testBlackhole = do
putStrLn "eval/blackhole"
tmpBase <- getTemporaryDirectory
sequence
[ runTestIOFail "let x = x; in x" tmpBase "let x = x; in x",
runTestIOFail "rec { a = a; }.a" tmpBase "rec { a = a; }.a",
runTestIOFail "let a = b; b = a; in a" tmpBase "let a = b; b = a; in a",
-- Non-recursive cases must still work
runTestIO "rec { a = 1; b = a; }.b" tmpBase "rec { a = 1; b = a; }.b" (VInt 1),
runTestIO "let a = 1; b = a + 1; in b" tmpBase "let a = 1; b = a + 1; in b" (VInt 2)
]
-- ---------------------------------------------------------------------------
-- Tests: Eval - Call depth (max-call-depth)
-- ---------------------------------------------------------------------------
-- | The issue's counter recursion to a given depth.
counterRecursion :: Int -> Text
counterRecursion n = "let f = n: if n == 0 then 0 else 1 + f (n - 1); in f " <> T.pack (show n)
-- | The identity applied to itself syntactically @n@ deep: a chain of pure
-- lambda frames with nothing else counted.
lambdaNesting :: Int -> Text
lambdaNesting n = "let f = x: x; in " <> T.replicate n "f (" <> "0" <> T.replicate n ")"
-- | Upstream's message, which the CLI prints after its own "error: ".
maxCallDepthMessage :: Text
maxCallDepthMessage = "stack overflow; max-call-depth exceeded"
-- | A result that must be the max-call-depth error, word for word.
expectMaxCallDepth :: Text -> Either Text NixValue -> TestResult
expectMaxCallDepth label result = case result of
Left err
| err == maxCallDepthMessage -> Pass
| otherwise -> Fail (label <> ": wrong error: " <> err)
Right val -> Fail (label <> ": expected the max-call-depth error but got: " <> T.pack (show val))
-- | IO evaluation under an explicit call-depth ceiling.
evalAtCeiling :: Word32 -> Text -> IO (Either Text NixValue)
evalAtCeiling limit source = case parseNix "." "<test>" source of
Left err -> pure (Left (T.pack (show err)))
Right expr -> do
storeDir <- evalNixIOStoreDir
st0 <- newEvalState storeDir "."
let st = st0 {esCallDepth = topLevelCallDepth limit}
runEvalIO st (eval (builtinEnv unrestrictedPolicy (esTimestamp st) (esSearchPaths st)) expr)
-- | The function-call nesting ceiling, upstream's max-call-depth (10000).
-- Every boundary here was read off nix-instantiate 2.33.2 and the 2.24.9
-- source: the count is the frames already active, checked on entry, so
-- 10001 nested lambda calls pass and 10002 fail, and the counter
-- recursion passes at 9999 and fails at 10000, its deepest frame being
-- the @n - 1@ forced inside @f 0@, a builtin call upstream's parser
-- desugars @-@ into. The cases under a ceiling of 10 pin what costs a
-- frame and what does not, each boundary taken from the same upstream.
testCallDepth :: IO [Bool]
testCallDepth = do
putStrLn "eval/call-depth"
sequence
[ failsIO "the issue expression is refused with upstream's words" (counterRecursion 100000),
runTestIO "the counter recursion one under the ceiling evaluates" "." (counterRecursion 9999) (VInt 9999),
failsIO "the counter recursion at the ceiling is refused" (counterRecursion 10000),
runTest "pure evaluation enforces the ceiling too" $
assertEval "pure-under" (lambdaNesting 10001) (VInt 0),
runTest "pure evaluation refuses past the ceiling with upstream's words" $
expectMaxCallDepth "pure-over" (evalNix (lambdaNesting 10002)),
-- Under a ceiling of n, n + 1 nested lambda calls pass and n + 2 fail.
passesAt 10 "lambda nesting one past the ceiling passes" (lambdaNesting 11) (VInt 0),
failsAt 10 "lambda nesting two past the ceiling fails" (lambdaNesting 12),
-- The operators upstream desugars into builtin calls cost a frame
-- while their operands are forced; its native operators cost none.
passesAt 10 "a subtraction at the ceiling passes" (wrapped 10 "1 - 1") (VInt 0),
failsAt 10 "a subtraction one past the ceiling fails" (wrapped 11 "1 - 1"),
failsAt 10 "a multiplication one past the ceiling fails" (wrapped 11 "2 * 1"),
failsAt 10 "a division one past the ceiling fails" (wrapped 11 "2 / 1"),
failsAt 10 "a less-than one past the ceiling fails" (wrapped 11 "1 < 2"),
failsAt 10 "a less-or-equal one past the ceiling fails" (wrapped 11 "1 <= 2"),
failsAt 10 "a greater-than one past the ceiling fails" (wrapped 11 "2 > 1"),
failsAt 10 "a greater-or-equal one past the ceiling fails" (wrapped 11 "2 >= 1"),
failsAt 10 "a negation one past the ceiling fails" (wrapped 11 "-1"),
passesAt 10 "an equality one past the ceiling passes" (wrapped 11 "1 == 1") (VBool True),
passesAt 10 "an inequality one past the ceiling passes" (wrapped 11 "1 != 2") (VBool True),
passesAt 10 "a not one past the ceiling passes" (wrapped 11 "!true") (VBool False),
passesAt 10 "an addition one past the ceiling passes" (wrapped 11 "1 + 1") (VInt 2),
passesAt 10 "a list concatenation one past the ceiling passes" (wrapped 11 "([1] ++ [2]) == [1 2]") (VBool True),
passesAt 10 "an attrset update one past the ceiling passes" (wrapped 11 "({ a = 1; } // { b = 2; }) == { a = 1; b = 2; }") (VBool True),
-- A builtin costs a frame even when partially applied.
failsAt 10 "a partially applied builtin one past the ceiling fails" (wrapped 11 "builtins.add 0"),
failsAt 10 "a builtin application one past the ceiling fails" (wrapped 11 "builtins.add 0 0"),
-- A functor costs two frames: its inner call is a callFunction of its own.
passesAt 10 "functor nesting of five passes" (functorNesting 5) (VInt 0),
failsAt 10 "functor nesting of six fails" (functorNesting 6),
-- A __toString coercion is a callFunction.
passesAt 10 "a __toString coercion at the ceiling passes" (wrapped 10 "\"${s}\"") (mkStr "a"),
failsAt 10 "a __toString coercion one past the ceiling fails" (wrapped 11 "\"${s}\""),
-- A higher-order builtin's callback is applied where its result is
-- forced, not inside the builtin's frame: upstream's prim_map returns
-- app values. Forced by ==, which opens no frame, the callback at
-- the ceiling passes; forced by elemAt, a frame deeper, it is
-- elemAt's own call that fails.
passesAt 10 "a map callback forced at the ceiling passes" (wrapped 10 "(builtins.map f [ 0 ]) == [ 0 ]") (VBool True),
failsAt 10 "a map callback forced one past the ceiling fails" (wrapped 11 "(builtins.map f [ 0 ]) == [ 0 ]"),
passesAt 10 "an elemAt over map under the ceiling passes" (wrapped 9 "builtins.elemAt (builtins.map f [ 0 ]) 0") (VInt 0),
failsAt 10 "an elemAt over map at the ceiling fails" (wrapped 10 "builtins.elemAt (builtins.map f [ 0 ]) 0"),
-- mapAttrs and zipAttrsWith apply @f name@ a frame below the value
-- application: upstream builds two nested app values.
passesAt 10 "a mapAttrs callback under the ceiling passes" (wrapped 9 "(builtins.mapAttrs (n: v: v) { a = 0; }).a") (VInt 0),
failsAt 10 "a mapAttrs callback at the ceiling fails" (wrapped 10 "(builtins.mapAttrs (n: v: v) { a = 0; }).a"),
passesAt 10 "a zipAttrsWith callback under the ceiling passes" (wrapped 9 "(builtins.zipAttrsWith (n: vs: 0) [ { a = 1; } ]).a") (VInt 0),
failsAt 10 "a zipAttrsWith callback at the ceiling fails" (wrapped 10 "(builtins.zipAttrsWith (n: vs: 0) [ { a = 1; } ]).a"),
-- A sort by builtins.lessThan itself opens no frame per comparison
-- (upstream's prim_sort bypass); a lambda comparator costs its call
-- and the < inside it.
passesAt 10 "a sort by lessThan at the ceiling passes" (wrapped 10 "builtins.sort builtins.lessThan [ 2 1 ] == [ 1 2 ]") (VBool True),
failsAt 10 "a sort by lessThan one past the ceiling fails" (wrapped 11 "builtins.sort builtins.lessThan [ 2 1 ] == [ 1 2 ]"),
passesAt 10 "a sort by a lambda two under the ceiling passes" (wrapped 8 "builtins.sort (a: b: a < b) [ 2 1 ] == [ 1 2 ]") (VBool True),
failsAt 10 "a sort by a lambda one under the ceiling fails" (wrapped 9 "builtins.sort (a: b: a < b) [ 2 1 ] == [ 1 2 ]"),
passesAt 10 "the counter recursion to 9 passes under a ceiling of 10" (counterRecursion 9) (VInt 9),
failsAt 10 "the counter recursion to 10 fails under a ceiling of 10" (counterRecursion 10),
-- An eval error, not a throw: tryEval does not catch it.
failsAt 10 "tryEval does not catch the ceiling" ("(builtins.tryEval (" <> lambdaNesting 12 <> ")).success"),
-- A ceiling of 0 still admits one frame: the check is against the
-- frames already active when the call is entered.
passesAt 0 "one call passes under a ceiling of 0" "(x: x) 1" (VInt 1),
failsAt 0 "a nested call fails under a ceiling of 0" "(x: x) ((x: x) 1)",
passesAt 0 "a bare subtraction passes under a ceiling of 0" "1 - 1" (VInt 0),
failsAt 0 "a subtraction inside a call fails under a ceiling of 0" "(x: x - 1) 1"
]
where
failsIO label source = evalNixIO "." source >>= runTest label . expectMaxCallDepth label
passesAt limit label source expected = do
result <- evalAtCeiling limit source
runTest label $ assertRight label result $ assertEqual label expected
failsAt limit label source = evalAtCeiling limit source >>= runTest label . expectMaxCallDepth label
wrapped n inner = scope <> T.replicate n "f (" <> inner <> T.replicate n ")"
functorNesting n = scope <> T.replicate n "g (" <> "0" <> T.replicate n ")"
scope = "let f = x: x; g = { __functor = self: x: x; }; s = { __toString = self: \"a\"; }; in "
-- ---------------------------------------------------------------------------
-- Tests: Batch D - toFile
-- ---------------------------------------------------------------------------
testBatchD :: IO [Bool]
testBatchD = do
putStrLn "eval/builtins-batchD"
sequence
[ runTest "toFile pure mode error" $
assertEvalFail "toFile-pure" "builtins.toFile \"hello\" \"world\"",
runTest "toFile type error arg1" $
assertEvalFail "toFile-err1" "builtins.toFile 42 \"world\"",
runTest "toFile type error arg2" $
assertEvalFail "toFile-err2" "builtins.toFile \"hello\" 42"
]
-- ---------------------------------------------------------------------------
-- Tests: Batch E - scopedImport
-- ---------------------------------------------------------------------------
testBatchE :: IO [Bool]
testBatchE = do
putStrLn "eval/builtins-batchE"
sequence
[ runTest "scopedImport pure error" $
assertEvalFail "scopedImport-pure" "builtins.scopedImport { } ./foo.nix",
runTest "scopedImport type error arg1" $
assertEvalFail "scopedImport-err1" "builtins.scopedImport 42 ./foo.nix",
runTest "scopedImport type error arg2" $
assertEvalFail "scopedImport-err2" "builtins.scopedImport { } 42"
]
testBatchEIO :: IO [Bool]
testBatchEIO = do
putStrLn "eval/builtins-batchE-io"
tmpBase <- getTemporaryDirectory
let testDir = tmpBase </> "nova-nix-test-batchE"
bracket_
( do
createDirectoryIfMissing True testDir
TIO.writeFile (testDir </> "scoped.nix") "x"
)
( do
exists <- doesDirectoryExist testDir
when exists (removeDirectoryRecursive testDir)
)
$ sequence
[ runTestIO
"scopedImport injects scope"
testDir
("builtins.scopedImport { x = 42; } " <> nixQuotedPath (testDir </> "scoped.nix"))
(VInt 42)
]
-- ---------------------------------------------------------------------------
-- Tests: Batch F - fetchurl, fetchTarball, fetchGit
-- ---------------------------------------------------------------------------
testBatchF :: IO [Bool]
testBatchF = do
putStrLn "eval/builtins-batchF"
sequence
[ runTest "fetchurl pure error" $
assertEvalFail "fetchurl-pure" "builtins.fetchurl \"http://example.com\"",
runTest "fetchurl type error" $
assertEvalFail "fetchurl-err" "builtins.fetchurl 42",
runTest "fetchTarball pure error" $
assertEvalFail "fetchTarball-pure" "builtins.fetchTarball \"http://example.com\"",
runTest "fetchTarball type error" $
assertEvalFail "fetchTarball-err" "builtins.fetchTarball 42",
runTest "fetchGit pure error" $
assertEvalFail "fetchGit-pure" "builtins.fetchGit \"http://example.com\"",
runTest "fetchGit type error" $
assertEvalFail "fetchGit-err" "builtins.fetchGit 42"
]
-- ---------------------------------------------------------------------------
-- Tests: Batch G - ATerm serialization
-- ---------------------------------------------------------------------------
testBatchG :: IO [Bool]
testBatchG = do
putStrLn "derivation/aterm"
let minimalDrv =
Derivation
{ drvOutputs = [],
drvInputDrvs = Map.empty,
drvInputSrcs = [],
drvPlatform = X86_64_Linux,
drvBuilder = "/bin/sh",
drvArgs = [],
drvEnv = Map.empty
}
let drvWithOutput =
minimalDrv
{ drvOutputs =
[ DerivationOutput
{ doName = "out",
doPath = StorePath "abc" "hello",
doHashAlgo = "",
doHash = ""
}
]
}
let drvWithEnv =
minimalDrv
{ drvEnv = Map.fromList [("name", "hello"), ("system", "x86_64-linux")]
}
sequence
[ runTest "ATerm minimal" $
let aterm = toATerm minimalDrv
in if BS.isPrefixOf "Derive(" aterm && BS.isSuffixOf ")" aterm
then Pass
else Fail ("bad ATerm: " <> bytesText aterm),
runTest "ATerm has output" $
let aterm = toATerm drvWithOutput
in if "\"out\"" `BS.isInfixOf` aterm
then Pass
else Fail ("missing output in ATerm: " <> bytesText aterm),
runTest "ATerm env sorted" $
let aterm = toATerm drvWithEnv
in -- "name" should come before "system" in sorted order
case (BS.breakSubstring "\"name\"" aterm, BS.breakSubstring "\"system\"" aterm) of
((before1, _), (before2, _)) ->
if BS.length before1 < BS.length before2
then Pass
else Fail ("env not sorted in ATerm: " <> bytesText aterm),
runTest "ATerm string escaping" $
let drv = minimalDrv {drvEnv = Map.fromList [("msg", "hello\nworld")]}
aterm = toATerm drv
in if "\\n" `BS.isInfixOf` aterm
then Pass
else Fail ("missing escaped newline: " <> bytesText aterm),
runTest "ATerm deterministic" $
assertEqual "deterministic" (toATerm minimalDrv) (toATerm minimalDrv),
-- platformToText
runTest "platformToText linux" $
assertEqual "linux" "x86_64-linux" (platformToText X86_64_Linux),
runTest "platformToText darwin" $
assertEqual "darwin" "x86_64-darwin" (platformToText X86_64_Darwin),
runTest "platformToText aarch64-darwin" $
assertEqual "aarch64" "aarch64-darwin" (platformToText Aarch64_Darwin),
runTest "platformToText windows" $
assertEqual "windows" "x86_64-windows" (platformToText X86_64_Windows),
runTest "platformToText aarch64-linux" $
assertEqual "aarch64-linux" "aarch64-linux" (platformToText Aarch64_Linux),
runTest "platformToText i686" $
assertEqual "i686" ["i686-linux", "i686-windows"] (map platformToText [I686_Linux, I686_Windows]),
runTest "platformToText other" $
assertEqual "other" "riscv64-freebsd" (platformToText (OtherPlatform "riscv64-freebsd")),
-- The i686 spellings parse to their own constructors, not to
-- OtherPlatform, or extraPlatforms could never name them.
runTest "textToPlatform round-trips every named platform" $
assertEqual
"round-trip"
namedPlatforms
(map (textToPlatform . platformToText) namedPlatforms),
-- Upstream's default extra-platforms, and nothing more: the x86_64
-- hosts run their i686 counterpart, every other host runs only itself.
runTest "extraPlatforms is the i686 counterpart on x86_64 hosts only" $
assertEqual
"extra"
[[I686_Linux], [I686_Windows], [], [], [], [], []]
(map extraPlatforms [X86_64_Linux, X86_64_Windows, X86_64_Darwin, Aarch64_Darwin, Aarch64_Linux, I686_Linux, I686_Windows])
]
where
namedPlatforms = [X86_64_Linux, X86_64_Darwin, Aarch64_Darwin, X86_64_Windows, Aarch64_Linux, I686_Linux, I686_Windows]
-- ---------------------------------------------------------------------------
-- Tests: Batch H - derivation
-- ---------------------------------------------------------------------------
testBatchH :: IO [Bool]
testBatchH = do
putStrLn "eval/builtins-batchH"
let withTwoOutputs expr =
"let D = derivation { name = \"x\"; system = \"s\"; builder = \"b\"; outputs = [ \"out\" \"dev\" ]; }; in " <> expr
sequence
[ runTest "derivation has type" $
assertEval
"drv-type"
"let d = derivation { name = \"hello\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }; in d.type"
(mkStr "derivation"),
runTest "derivation has drvPath" $
assertRight "drv-drvPath" (evalNix "let d = derivation { name = \"hello\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }; in d.drvPath") $ \val ->
case val of
VStr p ctx ->
if "/nix/store/" `BS.isPrefixOf` p && ".drv" `BS.isSuffixOf` p && ctx /= emptyContext
then Pass
else Fail ("bad drvPath: " <> bytesText p)
_ -> Fail ("expected VStr with context, got " <> T.pack (show val)),
runTest "derivation has outPath" $
assertRight "drv-outPath" (evalNix "let d = derivation { name = \"hello\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }; in d.outPath") $ \val ->
case val of
VStr p ctx ->
if "/nix/store/" `BS.isPrefixOf` p && ctx /= emptyContext
then Pass
else Fail ("bad outPath: " <> bytesText p)
_ -> Fail ("expected VStr with context, got " <> T.pack (show val)),
-- 'derivation' is lazy (matches C++ Nix): the missing-required-attribute
-- error fires when a path is forced (.drvPath), not at construction.
runTest "derivation missing name" $
assertEvalFail "drv-noname" "(derivation { system = \"x86_64-linux\"; builder = \"/bin/sh\"; }).drvPath",
runTest "derivation missing system" $
assertEvalFail "drv-nosys" "(derivation { name = \"hello\"; builder = \"/bin/sh\"; }).drvPath",
runTest "derivation missing builder" $
assertEvalFail "drv-nobuilder" "(derivation { name = \"hello\"; system = \"x86_64-linux\"; }).drvPath",
runTest "derivation type error" $
assertEvalFail "drv-tyerr" "derivation 42",
runTest "derivation deterministic" $
assertRight "drv-det" (evalNix "let d1 = derivation { name = \"a\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }; d2 = derivation { name = \"a\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }; in d1.drvPath == d2.drvPath") $ \val ->
assertEqual "deterministic" (VBool True) val,
-- The result is upstream's derivation.nix wrapper evaluated as the
-- builtin, so its shape is the wrapper's: every row below was read
-- from nix-instantiate 2.33.2 (#217).
runTest "derivation result carries exactly upstream's attributes" $
assertEval
"drv-attrnames"
(withTwoOutputs "builtins.attrNames D == [ \"all\" \"builder\" \"dev\" \"drvAttrs\" \"drvPath\" \"name\" \"out\" \"outPath\" \"outputName\" \"outputs\" \"system\" \"type\" ]")
(VBool True),
runTest "derivation outputName is the first output" $
assertEval "drv-outputname" (withTwoOutputs "D.outputName") (mkStr "out"),
runTest "derivation default output is the first listed, not out" $
assertEval
"drv-first-output"
"(derivation { name = \"x\"; system = \"s\"; builder = \"b\"; outputs = [ \"dev\" \"out\" ]; }).outputName"
(mkStr "dev"),
runTest "every output attribute is a complete derivation set" $
assertEval "drv-output-set" (withTwoOutputs "builtins.attrNames D.dev == builtins.attrNames D") (VBool True),
runTest "an output set names its own output" $
assertEval "drv-output-name" (withTwoOutputs "D.dev.outputName") (mkStr "dev"),
runTest "output sets refer back to each other" $
assertEval "drv-output-cycle" (withTwoOutputs "D.dev.out.outPath == D.outPath && D.dev.dev.out.dev.outputName == \"dev\"") (VBool True),
runTest "derivation all lists every output set in order" $
assertEval "drv-all" (withTwoOutputs "map (o: o.outputName) D.all == [ \"out\" \"dev\" ]") (VBool True),
runTest "derivation drvAttrs is the argument set" $
assertEval "drv-drvattrs" (withTwoOutputs "builtins.attrNames D.drvAttrs == [ \"builder\" \"name\" \"outputs\" \"system\" ]") (VBool True),
runTest "derivation leaks no internal attribute" $
assertEval "drv-no-internal" (withTwoOutputs "D ? _derivation") (VBool False),
-- derivationStrict is reached only through outPath and drvPath, so a
-- derivation forced to WHNF forces none of its inputs.
runTest "forcing a derivation to WHNF forces no input" $
assertEval
"drv-whnf"
"builtins.seq (derivation { name = \"x\"; system = \"s\"; builder = throw \"forced\"; }) \"whnf-ok\""
(mkStr "whnf-ok"),
runTest "derivationStrict returns drvPath and one path per output" $
assertEval
"drvstrict-shape"
"builtins.attrNames (derivationStrict { name = \"x\"; system = \"s\"; builder = \"b\"; outputs = [ \"out\" \"dev\" ]; }) == [ \"dev\" \"drvPath\" \"out\" ]"
(VBool True),
runTest "derivation is a lambda with upstream's formals" $
assertEval "drv-functionargs" "builtins.functionArgs derivation == { outputs = true; }" (VBool True)
]
-- ---------------------------------------------------------------------------
-- Tests: StringContext (Phase 3, Batch 1)
-- ---------------------------------------------------------------------------
testStringContext :: IO [Bool]
testStringContext = do
putStrLn "eval/string-context"
let sp1 = StorePath "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "hello"
sp2 = StorePath "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" "world"
sequence
[ runTest "StringContext Eq" $
let ctx1 = StringContext (Set.singleton (SCPlain sp1))
ctx2 = StringContext (Set.singleton (SCPlain sp1))
in assertEqual "ctx-eq" ctx1 ctx2,
runTest "mkStr constructor" $
let v = mkStr "hello"
in case v of
VStr t ctx ->
if t == "hello" && ctx == emptyContext
then Pass
else Fail "mkStr produced wrong value"
_ -> Fail "mkStr did not produce VStr",
runTest "mergeContexts mempty" $
let ctx1 = StringContext (Set.singleton (SCPlain sp1))
merged = ctx1 <> emptyContext
in assertEqual "merge-mempty" ctx1 merged,
runTest "mergeContexts union" $
let ctx1 = StringContext (Set.singleton (SCPlain sp1))
ctx2 = StringContext (Set.singleton (SCDrvOutput sp2 "out"))
merged = ctx1 <> ctx2
expected = StringContext (Set.fromList [SCPlain sp1, SCDrvOutput sp2 "out"])
in assertEqual "merge-union" expected merged
]
-- ---------------------------------------------------------------------------
-- Tests: Context propagation (Phase 3, Batch 3)
-- ---------------------------------------------------------------------------
testContextPropagation :: IO [Bool]
testContextPropagation = do
putStrLn "eval/context-propagation"
sequence
[ -- String equality ignores context
runTest "string equality ignores context" $
assertEval "str-eq-ctx" "\"hello\" == \"hello\"" (VBool True),
-- String comparison ignores context
runTest "string comparison ignores context" $
assertEval "str-cmp-ctx" "\"a\" < \"b\"" (VBool True),
-- Interpolation produces correct text
runTest "interp text correct" $
assertEval "interp-text" "let x = \"world\"; in \"hello ${x}\"" (mkStr "hello world"),
-- String + merges (tested at value level)
runTest "string + merges text" $
assertEval "str-plus" "\"a\" + \"b\"" (mkStr "ab"),
-- concatStringsSep merges text
runTest "concatStringsSep result" $
assertEval "css-text" "builtins.concatStringsSep \"-\" [\"a\" \"b\"]" (mkStr "a-b"),
-- substring preserves text
runTest "substring text" $
assertEval "substr-text" "builtins.substring 1 2 \"hello\"" (mkStr "el"),
-- unsafeDiscardStringContext strips context
runTest "discardContext strips" $
assertEval "discard-ctx" "builtins.unsafeDiscardStringContext \"hello\"" (mkStr "hello"),
-- stringLength drops context (returns int)
runTest "stringLength drops context" $
assertEval "strlen-drop" "builtins.stringLength \"hello\"" (VInt 5),
-- hashString drops context (returns string with no context)
runTest "hashString result type" $
assertRight "hash-type" (evalNix "builtins.typeOf (builtins.hashString \"sha256\" \"x\")") $ \val ->
assertEqual "hash-typeof" (mkStr "string") val,
-- replaceStrings text result
runTest "replaceStrings text" $
assertEval "replace-text" "builtins.replaceStrings [\"o\"] [\"0\"] \"foo\"" (mkStr "f00"),
-- baseNameOf preserves text
runTest "baseNameOf text" $
assertEval "basename-text" "builtins.baseNameOf \"/foo/bar\"" (mkStr "bar"),
-- dirOf preserves text
runTest "dirOf text" $
assertEval "dirof-text" "builtins.dirOf \"/foo/bar\"" (mkStr "/foo"),
-- toString propagates
runTest "toString on string" $
assertEval "tostr-str" "builtins.toString \"hello\"" (mkStr "hello"),
-- toString on int (no context)
runTest "toString on int" $
assertEval "tostr-int" "builtins.toString 42" (mkStr "42")
]
-- ---------------------------------------------------------------------------
-- Tests: Context helpers (Phase 3, Batch 2)
-- ---------------------------------------------------------------------------
testContextHelpers :: IO [Bool]
testContextHelpers = do
putStrLn "eval/context-helpers"
let sp1 = StorePath "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "hello"
sp2 = StorePath "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" "world.drv"
sp3 = StorePath "cccccccccccccccccccccccccccccccc" "source.tar.gz"
sequence
[ runTest "plainContext singleton" $
let ctx = Context.plainContext sp1
in assertEqual "plain" (StringContext (Set.singleton (SCPlain sp1))) ctx,
runTest "drvOutputContext singleton" $
let ctx = Context.drvOutputContext sp2 "out"
in assertEqual "drvOut" (StringContext (Set.singleton (SCDrvOutput sp2 "out"))) ctx,
runTest "allOutputsContext singleton" $
let ctx = Context.allOutputsContext sp2
in assertEqual "allOut" (StringContext (Set.singleton (SCAllOutputs sp2))) ctx,
runTest "contextIsEmpty on mempty" $
assertEqual "emptyCtx" True (Context.contextIsEmpty emptyContext),
runTest "contextIsEmpty on non-empty" $
assertEqual "nonEmptyCtx" False (Context.contextIsEmpty (Context.plainContext sp1)),
runTest "extractInputSrcs" $
let ctx = Context.plainContext sp1 <> Context.drvOutputContext sp2 "out"
in assertEqual "srcs" [sp1] (Context.extractInputSrcs ctx),
runTest "extractInputDrvs" $
let ctx = Context.drvOutputContext sp2 "out" <> Context.drvOutputContext sp2 "dev" <> Context.plainContext sp3
drvs = Context.extractInputDrvs ctx
in case Map.lookup sp2 drvs of
Just outs -> if length outs == 2 then Pass else Fail ("expected 2 outputs, got " <> T.pack (show (length outs)))
Nothing -> Fail "sp2 not found in drvs",
runTest "appendStrings merges" $
let ctx1 = Context.plainContext sp1
ctx2 = Context.drvOutputContext sp2 "out"
(txt, ctx) = Context.appendStrings "hello" ctx1 "world" ctx2
in if txt == "helloworld" && not (Context.contextIsEmpty ctx) then Pass else Fail "bad append",
runTest "concatStrings empty" $
let (txt, ctx) = Context.concatStrings []
in if txt == "" && Context.contextIsEmpty ctx then Pass else Fail "bad empty concat",
runTest "concatStrings merges all" $
let ctx1 = Context.plainContext sp1
ctx2 = Context.drvOutputContext sp2 "out"
(txt, ctx) = Context.concatStrings [("a", ctx1), ("b", ctx2), ("c", mempty)]
in if txt == "abc" && Set.size (unStringContext ctx) == 2 then Pass else Fail "bad concat"
]
-- ---------------------------------------------------------------------------
-- Tests: structured attributes and the JSON they travel as
-- ---------------------------------------------------------------------------
-- | @__structuredAttrs@ end to end on the evaluation side, and the JSON
-- rules the evaluator and builder share. Every drvPath, rendering and
-- @.attrs.sh@ expected here was read off Nix 2.33.2 (nix-instantiate and
-- a build on aarch64-darwin), whose code for each is 2.24.9's.
testStructuredAttrs :: IO [Bool]
testStructuredAttrs = do
putStrLn "derivation/structured-attrs"
tmpBase <- getTemporaryDirectory
let base = "name = \"sa\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; __structuredAttrs = true; "
structured attrs = "(derivation { " <> base <> attrs <> " })"
withoutContext expr = "builtins.unsafeDiscardStringContext " <> expr
drvPathIs label attrs expected =
runTest label (assertEval label (withoutContext (structured attrs <> ".drvPath")) (mkStr expected))
dependency = "let d = derivation { name = \"d\"; system = \"x\"; builder = \"b\"; }; in "
envResult <- evalDerivationIO tmpBase (structured "outputs = [ \"out\" \"dev\" \"lib\" ];")
-- A file for the outPath that is a path, copied to the store as upstream
-- copies it: "hello\n" named x is m5zd3qj7...-x there.
let jsonDir = tmpBase </> "nova-nix-test-json-outpath"
createDirectoryIfMissing True jsonDir
BS.writeFile (jsonDir </> "x") "hello\n"
copiedOutPath <- evalNixIO jsonDir "builtins.unsafeDiscardStringContext (builtins.toJSON { outPath = ./x; })"
lengthOfPath <- evalNixIO jsonDir "builtins.stringLength ./x"
substringOfPath <- evalNixIO jsonDir "builtins.substring 11 32 ./x"
substringContext <- evalNixIO jsonDir "builtins.hasContext (builtins.substring 11 32 ./x)"
discardedPath <- evalNixIO jsonDir "builtins.unsafeDiscardStringContext ./x"
discardedContext <- evalNixIO jsonDir "builtins.hasContext (builtins.unsafeDiscardStringContext ./x)"
copiedContext <- evalNixIO jsonDir "builtins.attrNames (builtins.getContext (builtins.toJSON { outPath = ./x; })) == [ \"/nix/store/m5zd3qj7c4bs4g5d8hqvs5pc5xicclfg-x\" ]"
-- The IO evaluator, because it is the one with a store to copy into.
uncopiedPath <- evalNixIO jsonDir "builtins.toJSON { __toString = s: ./x; }"
uncopiedNested <- evalNixIO jsonDir "builtins.toJSON { __toString = s: { outPath = ./x; }; }"
removeDirectoryRecursive jsonDir
let jsonDirPath = mkStr ("\"" <> canonPathValue (T.pack (jsonDir </> "x")) <> "\"")
sequence
[ drvPathIs
"a nested set and a mixed list are one JSON object"
"nested = { a = 1; b = { c = [ \"x\" \"y\" ]; }; \"with space\" = true; }; list = [ \"a\" \"b c\" 1 2.5 null true false ];"
"/nix/store/rkxyljjwm2miccr3ffbkvgm7fzmjqddg-sa.drv",
drvPathIs
"scalars render as nlohmann renders them"
"i = 42; neg = -7; f = 1.0; f2 = 0.1; big = 1.0e20; small = 1.0e-7; b = true; n = null; s = \"str\\n\\t\\\"q\\\"\\\\\";"
"/nix/store/hgzhpjmp6cpjj0r768xp982an303rh2q-sa.drv",
drvPathIs
"member names order by their bytes"
"\"\233\" = 1; \"Z\" = 2; \"a\" = 3; \"_\" = 4; \"1x\" = 5;"
"/nix/store/s2aaxxxqvmdh95wqq3sa75fqal0nv2vf-sa.drv",
drvPathIs "a kept null is a JSON null" "n = null;" "/nix/store/r3880xygjwsqk8a4xiq8zrbhpanlf9a3-sa.drv",
drvPathIs
"__ignoreNulls leaves a null out of the object"
"n = null; __ignoreNulls = true;"
"/nix/store/cms7b67rf9bn7b376f64i05v1cw2chrh-sa.drv",
drvPathIs
"a placeholder stays a placeholder in the object"
"here = builtins.placeholder \"out\";"
"/nix/store/2iqn1i3rl4x9ll8a6j46k1rkk9c3fkd5-sa.drv",
drvPathIs
"a fixed-output derivation keeps its hash fields in the object"
"outputHash = \"sha256-47DEQpj8HBSKTXA6xJbgU1CNMmz7W08F06XOTYP1hmM=\"; outputHashMode = \"flat\"; outputHashAlgo = \"sha256\";"
"/nix/store/dp6sib5psffrm1krca5l9wn9nshspn7f-sa.drv",
drvPathIs
"a set under outputChecks is passed as it is"
"outputChecks.out = { allowedReferences = [ ]; maxSize = 100; };"
"/nix/store/xzkk2dxqm69akjjshlvk45s8yd6y1dbn-sa.drv",
runTest "__structuredAttrs = false keeps one variable per attribute" $
assertEval
"sa-false"
(withoutContext "(derivation { name = \"sa\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; __structuredAttrs = false; x = [ \"a\" \"b\" ]; }).drvPath")
(mkStr "/nix/store/i9rm0fa7pbzrbrsaakninfa4232wmj7c-sa.drv"),
runTest "every output of a structured derivation gets upstream's path" $
assertEval
"sa-outputs"
(withoutContext (structured "outputs = [ \"out\" \"dev\" \"lib\" ];" <> ".dev.outPath"))
(mkStr "/nix/store/jfnikb9k7953srg5mlp3mccmqaijvxyy-sa-dev"),
runTest "the environment holds __json and the outputs, nothing else" $
assertRight "sa-env" envResult $ \drv ->
assertEqual
"sa-env"
[ ("__json", "{\"builder\":\"/bin/sh\",\"name\":\"sa\",\"outputs\":[\"out\",\"dev\",\"lib\"],\"system\":\"x86_64-linux\"}"),
("dev", "/nix/store/jfnikb9k7953srg5mlp3mccmqaijvxyy-sa-dev"),
("lib", "/nix/store/zpjd7d2l5jqzynv3377a36nk6rzb5il4-sa-lib"),
("out", "/nix/store/bs6ppbphi38qlbjfz67pfk86sx7l4vks-sa")
]
(Map.toList (drvEnv drv)),
-- toJSON's rules for a set, which the object above shares.
runTest "toJSON of a set with outPath converts the outPath value, not its string" $
assertEval "json-outpath-int" "builtins.toJSON { outPath = 1; }" (mkStr "1")
`andThen` assertEval "json-outpath-set" "builtins.toJSON { outPath = { a = 1; }; }" (mkStr "{\"a\":1}")
`andThen` assertEval "json-outpath-list" "builtins.toJSON { outPath = [ 1 { outPath = 2; } ]; }" (mkStr "[1,2]")
`andThen` assertEval "json-outpath-null" "builtins.toJSON { outPath = null; }" (mkStr "null"),
runTest "toJSON of a set whose outPath is a path copies it to the store, with context" $
assertRight "json-outpath-path" copiedOutPath (assertEqual "json-outpath-path" (mkStr "\"/nix/store/m5zd3qj7c4bs4g5d8hqvs5pc5xicclfg-x\""))
`andThen` assertRight "json-outpath-path-context" copiedContext (assertEqual "json-outpath-path-context" (VBool True)),
runTest "a builtin taking a string copies a path to the store first" $
assertRight "strlen-path" lengthOfPath (assertEqual "strlen-path" (VInt 45))
`andThen` assertRight "substring-path" substringOfPath (assertEqual "substring-path-text" "m5zd3qj7c4bs4g5d8hqvs5pc5xicclfg" . stringBytes)
`andThen` assertRight "substring-path-context" substringContext (assertEqual "substring-path-context" (VBool True))
`andThen` assertRight "discard-path" discardedPath (assertEqual "discard-path" (mkStr "/nix/store/m5zd3qj7c4bs4g5d8hqvs5pc5xicclfg-x"))
`andThen` assertRight "discard-path-context" discardedContext (assertEqual "discard-path-context" (VBool False)),
runTest "toJSON of a __toString set returning a path keeps the path's own text, uncopied" $
assertRight "json-tostring-path" uncopiedPath (assertEqual "json-tostring-path" jsonDirPath)
`andThen` assertRight "json-tostring-nested" uncopiedNested (assertEqual "json-tostring-nested" jsonDirPath),
runTest "toJSON of a __toString set returning a string keeps its context" $
let json = "(builtins.toJSON { __toString = s: \"${d}\"; })"
in assertEval "json-tostring-string" (dependency <> withoutContext json) (mkStr "\"/nix/store/74ii7m3ms7x609g9mcy8j52jfvpdizcp-d\"")
`andThen` assertEval
"json-tostring-context"
(dependency <> "builtins.getContext " <> json <> " == { \"/nix/store/nzvhjdd45mdh8mkqm4vz4hdqsjrvkm8j-d.drv\" = { outputs = [ \"out\" ]; }; }")
(VBool True),
runTest "toJSON of a __toString set returning an integer is an error, not a coercion" $
assertEvalFail "json-tostring-int" "builtins.toJSON { __toString = s: 1; }",
drvPathIs
"a structured attribute's outPath and __toString follow toJSON's rules"
"o = { outPath = { inner = 1; }; }; i = { outPath = 1; }; t = { __toString = s: \"str\"; };"
"/nix/store/rz7pfawzsr1a5ig11s1xssbsc2mxys9b-sa.drv",
runTest "toJSON escapes backspace and form feed by name" $
assertEval
"json-bf"
"builtins.toJSON (builtins.fromJSON \"\\\"\\\\u0008\\\\u000c\\\\u0001\\\"\")"
(mkStr "\"\\b\\f\\u0001\""),
runTest "__structuredAttrs must be a boolean" $
assertEvalFail "sa-flag" "(derivation { name = \"sa\"; system = \"x\"; builder = \"b\"; __structuredAttrs = \"yes\"; }).drvPath",
runTest "a structured system may not refer to a store path" $
assertEvalError
"sa-system-ctx"
(dependency <> "(derivation { name = \"sa\"; builder = \"/bin/sh\"; __structuredAttrs = true; system = \"${d}\"; }).drvPath")
"the string '/nix/store/74ii7m3ms7x609g9mcy8j52jfvpdizcp-d' is not allowed to refer to a store path (such as '!out!nzvhjdd45mdh8mkqm4vz4hdqsjrvkm8j-d.drv')",
runTest "a structured output name may not refer to a store path" $
assertEvalError
"sa-output-ctx"
(dependency <> structured "outputs = [ \"out\" \"${d}\" ];" <> ".drvPath")
"the string '/nix/store/74ii7m3ms7x609g9mcy8j52jfvpdizcp-d' is not allowed to refer to a store path (such as '!out!nzvhjdd45mdh8mkqm4vz4hdqsjrvkm8j-d.drv')",
runTest "a structured builder must be a string, not a value coerced to one" $
assertEvalError
"sa-builder"
"(derivation { name = \"sa\"; system = \"x\"; __structuredAttrs = true; builder = 1; }).drvPath"
"expected a string but found an integer: 1",
runTest "a structured outputHash must be a string" $
assertEvalError "sa-outputhash" (structured "outputHash = 1;" <> ".drvPath") "expected a string but found an integer: 1",
runTest "a function cannot become JSON" $
assertEvalFail "sa-function" (structured "f = x: x;" <> ".drvPath"),
-- The JSON both halves share.
runTest "JSON escapes control characters as nlohmann does" $
assertEqual
"json-escape"
(TE.encodeUtf8 "\"a\\b\\f\\n\\r\\t\\u0001\\u001f\127/\\\"\\\\\233\"")
(renderJson (JsonString "a\b\f\n\r\t\1\31\127/\"\\\233")),
runTest "JSON numbers render as nlohmann renders them" $
assertEqual
"json-numbers"
"[1.0,1e+20,1e-07,0.1,null,null,-7,18446744073709551615]"
(renderJson (JsonArray [JsonFloat 1, JsonFloat 1e20, JsonFloat 1e-7, JsonFloat 0.1, JsonFloat (1 / 0), JsonFloat (0 / 0), JsonInt (-7), JsonInt 18446744073709551615])),
runTest "upstream's .attrs.json reads back and renders to the same bytes" $
assertRight "json-upstream" (decodeStructuredAttrs upstreamAttrsJson) $ \attrs ->
assertEqual "json-upstream" (TE.encodeUtf8 upstreamAttrsJson) (encodeStructuredAttrs attrs),
runTest "the .attrs.sh renderer writes what upstream writes" $
assertRight "attrs-sh" (decodeStructuredAttrs upstreamAttrsJson) $ \attrs ->
assertEqual "attrs-sh" upstreamAttrsShell (renderAttrsShell attrs),
runTest "outputs become an object of placeholders" $
assertEqual
"outputs-object"
(StructuredAttrs (Map.fromList [("outputs", JsonObject (Map.fromList [("dev", JsonString (hashPlaceholder "dev")), ("out", JsonString (hashPlaceholder "out"))]))]))
(withOutputPlaceholders ["out", "dev"] (StructuredAttrs (Map.fromList [("outputs", JsonArray [JsonString "out", JsonString "dev"])]))),
runTest "a null __json is an empty object, another non-object an error" $
assertEqual "decode-shape" (Right (StructuredAttrs Map.empty)) (decodeStructuredAttrs "null")
`andThen` assertLeft "decode-array" (decodeStructuredAttrs "[1]"),
runTest "a list-of-strings attribute is read strictly" $
let attrs = StructuredAttrs (Map.fromList [("good", JsonArray [JsonString "a", JsonString "b"]), ("mixed", JsonArray [JsonString "a", JsonInt 1]), ("scalar", JsonString "a b")])
in assertEqual "strings-good" (Right (Just ["a", "b"])) (stringsAttr "good" attrs)
`andThen` assertEqual "strings-absent" (Right Nothing) (stringsAttr "absent" attrs)
`andThen` assertLeft "strings-mixed" (stringsAttr "mixed" attrs)
`andThen` assertLeft "strings-scalar" (stringsAttr "scalar" attrs),
runTest "JSON parsing decodes every escape, surrogate pairs included" $
assertEqual
"parse-escapes"
(Right (JsonString "\"\\/\b\f\n\r\t\233\128512"))
(parseJson "\"\\\"\\\\\\/\\b\\f\\n\\r\\t\\u00E9\\ud83d\\ude00\""),
runTest "JSON parsing keeps integers apart from floats, as nlohmann's lexer does" $
assertEqual
"parse-numbers"
(Right (JsonArray [JsonInt 18446744073709551615, JsonFloat 18446744073709551616, JsonInt (-9223372036854775808), JsonFloat (-9223372036854775809), JsonInt 0, JsonFloat 1, JsonFloat 100]))
(parseJson "[18446744073709551615,18446744073709551616,-9223372036854775808,-9223372036854775809,-0,1.0,1E2]"),
runTest "JSON parsing takes the last of a repeated name, whitespace and a byte order mark around" $
assertEqual
"parse-object"
(Right (JsonObject (Map.fromList [("a", JsonArray [JsonInt 2, JsonNull])])))
(parseJson "\65279 \n{ \"a\" : 1 , \"a\":[ 2 ,null ] }\r\n"),
runTest "JSON parsing refuses what nlohmann refuses" $
foldr
(\bad acc -> assertLeft ("parse-refuses " <> bad) (parseJson bad) `andThen` acc)
Pass
["\"a\tb\"", "01", "[1,]", "1e400", "{\"a\" 1}", "tru", "1 2", "\"\\ud800\"", "\"\\udc00\"", "\"\\x\"", "1.", "-", "\"unterminated", ""],
runTestM "rendered JSON parses back to the value it came from" $ do
result <-
QC.quickCheckWithResult QC.stdArgs {QC.chatty = False} $
QC.forAll (genJson 3) $ \json ->
(parseJson =<< either (Left . T.pack . show) Right (TE.decodeUtf8' (renderJson json))) QC.=== Right json
pure (if QC.isSuccess result then Pass else Fail (T.pack (QC.output result)))
]
-- | A subset of the @.attrs.json@ a Nix 2.33.2 build handed its builder
-- (the members holding no store path), byte for byte.
upstreamAttrsJson :: Text
upstreamAttrsJson =
"{\"1x\":\"skipped\",\"badList\":[\"a\",[\"nested\"]],\"badObj\":{\"k\":{\"nested\":1}},\"big\":1099511627776,\"ctl\":\"a\\b\\f\\u0001\\u001f\127/\\\"\\\\z\",\"emptyList\":[],\"emptyObj\":{},\"f\":1.5,\"fbig\":1e+20,\"fi\":3.0,\"fl\":false,\"fltList\":[1.5],\"fltObj\":{\"a\":1,\"b\":2.5},\"fneg\":-1e+20,\"fneg2\":-2.5,\"fsmall\":0.1,\"ftrunc\":16777217.5,\"huge\":9223372036854775807,\"int\":42,\"list\":[\"a\",\"b c\",1,2.0,true,false,null],\"n\":null,\"neg\":-7,\"obj\":{\"b\":false,\"k\":\"v\",\"key with space\":1,\"q\":\"'\"},\"str\":\"it's a \\\"test\\\"\\n\",\"t\":true,\"uni\":\"\233\8364\128512\",\"with space\":\"skipped\"}"
-- | The lines of that build's @.attrs.sh@ for the members of
-- 'upstreamAttrsJson'. Missing ones (a non-integral number, a nested
-- array or object, a name bash cannot hold) are upstream's omissions;
-- @fbig@ and @fneg@ are aarch64's saturating float conversion.
upstreamAttrsShell :: Text
upstreamAttrsShell =
"declare big=0\ndeclare ctl='a\8\12\1\31\127/\"\\z'\ndeclare -a emptyList=()\ndeclare -A emptyObj=()\ndeclare fbig=2147483647\ndeclare fi=3\ndeclare fl=\ndeclare fneg=-2147483648\ndeclare ftrunc=16777217\ndeclare huge=-1\ndeclare int=42\ndeclare -a list=('a' 'b c' 1 2 1 '' )\ndeclare n=''\ndeclare neg=-7\ndeclare -A obj=(['b']= ['k']='v' ['key with space']=1 ['q']=''\\''' )\ndeclare str='it'\\''s a \"test\"\n'\ndeclare t=1\ndeclare uni='\233\8364\128512'\n"
-- | JSON values up to a nesting depth, strings drawn from what the
-- renderer escapes and what it passes through as UTF-8, numbers across
-- both integer types and finite floats.
genJson :: Int -> QC.Gen Json
genJson depth = QC.oneof (scalars <> [nested | depth > 0])
where
scalars =
[ pure JsonNull,
JsonBool <$> QC.arbitrary,
JsonInt . toInteger <$> (QC.arbitrary :: QC.Gen Int64),
JsonInt . toInteger <$> (QC.arbitrary :: QC.Gen Word64),
JsonFloat <$> (QC.arbitrary `QC.suchThat` (\d -> not (isNaN d || isInfinite d))),
JsonString <$> genJsonText
]
nested =
QC.oneof
[ JsonArray <$> QC.resize 4 (QC.listOf (genJson (depth - 1))),
JsonObject . Map.fromList <$> QC.resize 4 (QC.listOf ((,) <$> genJsonText <*> genJson (depth - 1)))
]
-- | Text mixing the characters JSON escapes with plain and multi-byte ones.
genJsonText :: QC.Gen Text
genJsonText =
T.pack <$> QC.listOf (QC.elements ['"', '\\', '/', '\b', '\f', '\n', '\r', '\t', '\0', '\31', '\127', 'a', ' ', '\233', '\8364', '\128512'])
-- ---------------------------------------------------------------------------
-- Tests: Derivation context + new builtins (Phase 3, Batch 4)
-- ---------------------------------------------------------------------------
testDrvContext :: IO [Bool]
testDrvContext = do
putStrLn "eval/drv-context"
sequence
[ -- hasContext: plain string has no context
runTest "hasContext on plain string" $
assertEval "hasCtx-plain" "builtins.hasContext \"hello\"" (VBool False),
-- hasContext: derivation outPath has context
runTest "hasContext on drv outPath" $
assertEval
"hasCtx-drv"
"builtins.hasContext (derivation { name = \"test\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }).outPath"
(VBool True),
-- hasContext: after discardContext, no context
runTest "hasContext after discard" $
assertEval
"hasCtx-discard"
"builtins.hasContext (builtins.unsafeDiscardStringContext (derivation { name = \"test\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }).outPath)"
(VBool False),
-- getContext: plain string returns empty attrset
runTest "getContext on plain string" $
assertRight "getCtx-plain" (evalNix "builtins.getContext \"hello\"") $ \val ->
case val of
VAttrs m -> if attrSetNull m then Pass else Fail "expected empty attrset"
_ -> Fail ("expected VAttrs, got " <> T.pack (show val)),
-- getContext: drv outPath has outputs entry
runTest "getContext on drv outPath"
$ assertRight
"getCtx-drv"
(evalNix "builtins.getContext (derivation { name = \"test\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }).outPath")
$ \val -> case val of
VAttrs m ->
if attrSetSize m == 1
then Pass
else Fail ("expected 1 entry, got " <> T.pack (show (attrSetSize m)))
_ -> Fail ("expected VAttrs, got " <> T.pack (show val)),
-- getContext: drvPath has allOutputs
runTest "getContext on drvPath has allOutputs"
$ assertRight
"getCtx-drvPath"
(evalNix "let d = derivation { name = \"test\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }; ctx = builtins.getContext d.drvPath; in builtins.length (builtins.attrNames ctx)")
$ \val -> assertEqual "one-entry" (VInt 1) val,
-- getContext keys are identity: canonical /nix/store spelling on
-- every platform, never the platform file-path mapping.
runTest "getContext key is canonical store path"
$ assertRight
"getCtx-canonical"
(evalNix "let d = derivation { name = \"test\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }; in builtins.elemAt (builtins.attrNames (builtins.getContext d.drvPath)) 0")
$ \val -> case val of
VStr key _
| "/nix/store/" `BS.isPrefixOf` key && not ("\\" `BS.isInfixOf` key) -> Pass
| otherwise -> Fail ("expected a canonical /nix/store key, got " <> bytesText key)
_ -> Fail ("expected VStr, got " <> T.pack (show val)),
-- appendContext: adds context to plain string
runTest "appendContext adds context" $
assertEval
"appendCtx-add"
"let ctx = builtins.listToAttrs [{ name = \"/nix/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo\"; value = { path = true; }; }]; in builtins.hasContext (builtins.appendContext \"hello\" ctx)"
(VBool True),
-- appendContext: empty context is no-op
runTest "appendContext empty is no-op" $
assertEval "appendCtx-empty" "builtins.hasContext (builtins.appendContext \"hello\" {})" (VBool False),
-- unsafeDiscardOutputDependency KEEPS a derivation-output (Built) ref
-- unchanged (upstream), rather than dropping it as it once did.
runTest "discardOutputDep keeps output-dependency context"
$ assertRight
"discardOutDep-keep"
( evalNix $
T.concat
[ "let d = derivation { name = \"test\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }; ",
"stripped = builtins.unsafeDiscardOutputDependency d.outPath; ",
"in builtins.hasContext stripped"
]
)
$ \val -> assertEqual "keep-ctx" (VBool True) val,
-- ctx3: an all-outputs (DrvDeep) reference on d.drvPath is DOWNGRADED to
-- a plain path reference, not dropped.
runTest "discardOutputDep downgrades drvPath to a plain ref" $
assertEval
"discardOutDep-downgrade"
"let d = derivation { name = \"test\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }; ctx = builtins.getContext (builtins.unsafeDiscardOutputDependency d.drvPath); key = builtins.elemAt (builtins.attrNames ctx) 0; in ctx.${key} == { path = true; }"
(VBool True),
-- ctx4: getContext renders each path's output names ascending.
runTest "getContext output names are ascending" $
assertEval
"getctx-ascending"
"let d = derivation { name = \"test\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; outputs = [ \"out\" \"dev\" \"lib\" ]; }; s = \"${d.out}${d.lib}${d.dev}\"; ctx = builtins.getContext s; key = builtins.elemAt (builtins.attrNames ctx) 0; in ctx.${key}.outputs == [ \"dev\" \"lib\" \"out\" ]"
(VBool True),
-- ctx5: addDrvOutputDependencies upgrades a plain .drv reference back to
-- an all-outputs reference (the inverse of the ctx3 downgrade).
runTest "addDrvOutputDependencies upgrades a plain drv ref" $
assertEval
"adddrvout-upgrade"
"let d = derivation { name = \"test\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }; plain = builtins.unsafeDiscardOutputDependency d.drvPath; ctx = builtins.getContext (builtins.addDrvOutputDependencies plain); key = builtins.elemAt (builtins.attrNames ctx) 0; in ctx.${key} == { allOutputs = true; }"
(VBool True),
runTest "addDrvOutputDependencies rejects a derivation output" $
assertEvalFail
"adddrvout-built"
"let d = derivation { name = \"test\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }; in builtins.addDrvOutputDependencies d.outPath",
runTest "addDrvOutputDependencies rejects a multi-element context" $
assertEvalFail
"adddrvout-multi"
"let d = derivation { name = \"test\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }; in builtins.addDrvOutputDependencies \"${d.drvPath}${d.outPath}\"",
-- drv1: a derivation embedding another's drvPath (an all-outputs ref)
-- needs the referenced .drv's output names, which only the IO evaluator
-- supplies; pure eval fails loudly rather than dropping the reference.
runTest "deep drvPath reference fails loudly in pure eval" $
assertEvalFail
"drv1-pure-miss"
"let dep = derivation { name = \"dep\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }; main = derivation { name = \"main\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; ref = dep.drvPath; }; in main.drvPath",
-- derivation outPath is a string (not path) with context
runTest "drv outPath is VStr"
$ assertRight
"drv-outPath-type"
(evalNix "builtins.typeOf (derivation { name = \"test\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }).outPath")
$ \val -> assertEqual "string-type" (mkStr "string") val,
-- derivation drvPath is a string (not path) with context
runTest "drv drvPath is VStr"
$ assertRight
"drv-drvPath-type"
(evalNix "builtins.typeOf (derivation { name = \"test\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }).drvPath")
$ \val -> assertEqual "string-type" (mkStr "string") val,
-- hasContext error on non-string
runTest "hasContext type error" $
assertEvalFail "hasCtx-err" "builtins.hasContext 42",
-- getContext error on non-string
runTest "getContext type error" $
assertEvalFail "getCtx-err" "builtins.getContext 42",
-- appendContext error on non-string first arg
runTest "appendContext type error" $
assertEvalFail "appendCtx-err" "builtins.appendContext 42 {}",
-- deterministic: same derivation produces same paths
runTest "derivation with context deterministic"
$ assertRight
"drv-det-ctx"
(evalNix "let d1 = derivation { name = \"a\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }; d2 = derivation { name = \"a\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }; in d1.outPath == d2.outPath")
$ \val -> assertEqual "deterministic" (VBool True) val
]
-- ---------------------------------------------------------------------------
-- Tests: DependencyGraph (Phase 3, Batch 5)
-- ---------------------------------------------------------------------------
-- | 'DepGraph.buildDepGraph' over a pure .drv lookup.
pureDepGraph :: (StorePath -> Either Text Derivation) -> Derivation -> StorePath -> Either Text DepGraph.DepGraph
pureDepGraph readDrv rootDrv rootPath = runIdentity (DepGraph.buildDepGraph (Identity . readDrv) rootDrv rootPath)
testDepGraph :: IO [Bool]
testDepGraph = do
putStrLn "dep-graph"
let mkSP = StorePath
spA = mkSP "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "a.drv"
spB = mkSP "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" "b.drv"
spC = mkSP "cccccccccccccccccccccccccccccccccc" "c.drv"
spD = mkSP "dddddddddddddddddddddddddddddddd" "d.drv"
baseDrv =
Derivation
{ drvOutputs = [],
drvInputDrvs = Map.empty,
drvInputSrcs = [],
drvPlatform = X86_64_Linux,
drvBuilder = "/bin/sh",
drvArgs = [],
drvEnv = Map.empty
}
-- Single node: A has no deps
drvA = baseDrv
-- Linear chain: B depends on C
drvB = baseDrv {drvInputDrvs = Map.singleton spC ["out"]}
-- C has no deps
drvC = baseDrv
-- Diamond: D depends on B and C, B depends on C
drvD = baseDrv {drvInputDrvs = Map.fromList [(spB, ["out"]), (spC, ["out"])]}
-- Cycle: A depends on B, B depends on A
drvACycle = baseDrv {drvInputDrvs = Map.singleton spB ["out"]}
drvBCycle = baseDrv {drvInputDrvs = Map.singleton spA ["out"]}
readSingle _ = Left "not found"
readChain sp
| sp == spC = Right drvC
| otherwise = Left ("unknown drv: " <> spName sp)
readDiamond sp
| sp == spB = Right drvB
| sp == spC = Right drvC
| otherwise = Left ("unknown drv: " <> spName sp)
readCycle sp
| sp == spB = Right drvBCycle
| sp == spA = Right drvACycle
| otherwise = Left ("unknown drv: " <> spName sp)
-- Self-loop: A depends on itself
drvSelf = baseDrv {drvInputDrvs = Map.singleton spA ["out"]}
readSelf sp
| sp == spA = Right drvSelf
| otherwise = Left ("unknown drv: " <> spName sp)
sequence
[ -- Single node
runTest "single node graph" $ case pureDepGraph readSingle drvA spA of
Right (DepGraph.DepGraph g) -> assertEqual "single-size" 1 (Map.size g)
Left err -> Fail ("unexpected error: " <> err),
-- Linear chain A to C: topoSort should give [C, A]
runTest "linear chain topo" $ case pureDepGraph readChain drvB spB of
Right graph -> case DepGraph.topoSort graph of
DepGraph.TopoSorted order ->
case order of
[first, _] | first == spC -> Pass
_ -> Fail ("bad order: " <> T.pack (show order))
DepGraph.TopoCycle cyc -> Fail ("unexpected cycle: " <> T.pack (show cyc))
Left err -> Fail ("graph build failed: " <> err),
-- Diamond D to B,C; B to C: topoSort should have C first, D last
runTest "diamond topo" $ case pureDepGraph readDiamond drvD spD of
Right graph -> case DepGraph.topoSort graph of
DepGraph.TopoSorted order ->
case order of
[first, _, lastElem] | first == spC, lastElem == spD -> Pass
_ -> Fail ("bad diamond order: " <> T.pack (show order))
DepGraph.TopoCycle cyc -> Fail ("unexpected cycle: " <> T.pack (show cyc))
Left err -> Fail ("graph build failed: " <> err),
-- transitiveDeps
runTest "transitiveDeps diamond" $ case pureDepGraph readDiamond drvD spD of
Right graph ->
let deps = DepGraph.transitiveDeps graph spD
in if Set.size deps == 2 && Set.member spB deps && Set.member spC deps
then Pass
else Fail ("bad transitive deps: " <> T.pack (show deps))
Left err -> Fail ("graph build failed: " <> err),
-- directDeps
runTest "directDeps diamond" $ case pureDepGraph readDiamond drvD spD of
Right graph ->
let deps = DepGraph.directDeps graph spD
in assertEqual "direct-count" 2 (length deps)
Left err -> Fail ("graph build failed: " <> err),
-- Missing .drv causes failure
runTest "missing drv fails" $ case pureDepGraph readSingle drvB spB of
Left _ -> Pass
Right _ -> Fail "expected failure for missing drv",
-- Single node topoSort
runTest "single node topoSort" $ case pureDepGraph readSingle drvA spA of
Right graph -> case DepGraph.topoSort graph of
DepGraph.TopoSorted [x] -> assertEqual "single-topo" spA x
other -> Fail ("unexpected topo result: " <> T.pack (show other))
Left err -> Fail ("graph build failed: " <> err),
-- buildDepGraph with mock for cycle detection
-- (Cycle detection happens at topoSort level, not buildDepGraph)
runTest "cycle detection" $ case pureDepGraph readCycle drvACycle spA of
Right graph -> case DepGraph.topoSort graph of
DepGraph.TopoCycle _ -> Pass
-- A "sorted" cyclic graph means Kahn's silently dropped the
-- cycle: buildWithDeps would then loop or build with unbuilt
-- inputs.
DepGraph.TopoSorted order ->
Fail ("cyclic graph topo-sorted as " <> T.pack (show (length order)) <> " nodes")
-- A loud rejection at graph-build time also counts as detection.
Left _ -> Pass,
-- A root that depends on itself: the walk marks the root visited
-- on enqueue, so it terminates - and per contract the result
-- excludes the root, leaving nothing.
runTestM "transitiveDeps terminates on a self-loop" $ do
outcome <-
timeout walkWatchdogMicros $
evaluate $ case pureDepGraph readSelf drvSelf spA of
Left _ -> Nothing
Right graph -> Just $! DepGraph.transitiveDeps graph spA
pure $ case outcome of
Nothing -> Fail "did not terminate on a self-loop"
Just Nothing -> Fail "graph build failed"
Just (Just deps) -> assertEqual "self-loop deps" Set.empty deps,
-- A two-node cycle already terminated; pin that the root stays
-- excluded from its own transitive closure.
runTestM "transitiveDeps two-node cycle excludes the root" $ do
outcome <-
timeout walkWatchdogMicros $
evaluate $ case pureDepGraph readCycle drvACycle spA of
Left _ -> Nothing
Right graph -> Just $! DepGraph.transitiveDeps graph spA
pure $ case outcome of
Nothing -> Fail "did not terminate on a cycle"
Just Nothing -> Fail "graph build failed"
Just (Just deps) -> assertEqual "cycle deps" (Set.singleton spB) deps
]
-- ---------------------------------------------------------------------------
-- Tests: Substituter (Phase 3, Batch 6)
-- ---------------------------------------------------------------------------
-- | A fake HTTP body reader: yields the given chunks, then empty
-- forever (an HTTP BodyReader is just an IO ByteString).
chunkReader :: [BS.ByteString] -> IO (IO BS.ByteString)
chunkReader chunks = do
ref <- newIORef chunks
pure $
atomicModifyIORef' ref $ \case
[] -> ([], BS.empty)
(c : cs) -> (cs, c)
-- | Drain a chunk source to its byte count - the shape of a streaming
-- consumer, for tests that only care whether the pipeline fails.
drainChunkSource :: IO BS.ByteString -> IO (Either Subst.AttemptFailure Int)
drainChunkSource pull = go 0
where
go n = do
chunk <- pull
if BS.null chunk
then pure (Right n)
else let total = n + BS.length chunk in total `seq` go total
testSubstituter :: IO [Bool]
testSubstituter = do
putStrLn "substituter"
-- Every tree this group materializes under the temp directory keys
-- sibling names the way a store on that volume would.
tmpSensitivity <- tempCaseSensitivity
sequence
[ -- sortCaches: priority ordering
runTest "sortCaches priority ordering" $
let c1 = Subst.CacheConfig "https://a.example.com" ["key-a"] 40
c2 = Subst.CacheConfig "https://b.example.com" ["key-b"] 10
c3 = Subst.CacheConfig "https://c.example.com" ["key-c"] 30
sorted = Subst.sortCaches [c1, c2, c3]
in case sorted of
[s1, s2, s3] ->
if Subst.ccPriority s1 == 10 && Subst.ccPriority s2 == 30 && Subst.ccPriority s3 == 40
then Pass
else Fail ("bad order: " <> T.pack (show (map Subst.ccPriority sorted)))
_ -> Fail "expected 3 caches",
-- sortCaches: empty list
runTest "sortCaches empty" $
assertEqual "empty-sort" [] (Subst.sortCaches []),
-- readBodyCapped: the client-side body cap (mirror of the server's
-- readBodyLimited). A body reader is just IO ByteString yielding
-- chunks then empty.
runTestM "readBodyCapped concatenates under the cap" $ do
reader <- chunkReader ["abc", "def", "g"]
body <- Subst.readBodyCapped 10 reader
pure (assertEqual "under cap" (Just "abcdefg") body),
runTestM "readBodyCapped allows exactly the cap" $ do
reader <- chunkReader ["abcde", "fghij"]
body <- Subst.readBodyCapped 10 reader
pure (assertEqual "at cap" (Just "abcdefghij") body),
runTestM "readBodyCapped aborts past the cap" $ do
reader <- chunkReader ["abcdef", "ghijkl"]
body <- Subst.readBodyCapped 10 reader
pure (assertEqual "over cap" Nothing body),
-- decompressorFor decides support from the narinfo's declared
-- values alone, so unsupported compression rejects before any
-- NAR download; xz resolves a bounded decompressor.
runTest "decompressorFor xz resolves" $
case Subst.decompressorFor 1024 "xz" of
Right _ -> Pass
Left err -> Fail ("xz rejected: " <> err),
runTestM "decompressorFor none is identity" $
case Subst.decompressorFor 5 "none" of
Right decompress -> assertEqual "identity" (Right "bytes") <$> decompress "bytes"
Left err -> pure (Fail ("expected none to be supported, got: " <> err)),
-- verifyNarSize: the declared NarSize is a signed claim that flows
-- into the store DB, so it must equal the downloaded byte count.
runTest "verifyNarSize accepts matching size" $
assertEqual
"narsize-match"
(Right ())
(Subst.verifyNarSize ((sampleNarInfo sampleNarHash) {NarInfo.niNarSize = toInteger (BS.length sampleNarBytes)}) sampleNarBytes),
runTest "verifyNarSize rejects mismatched size" $
case Subst.verifyNarSize ((sampleNarInfo sampleNarHash) {NarInfo.niNarSize = toInteger (BS.length sampleNarBytes) + 1}) sampleNarBytes of
Left err | "size mismatch" `T.isInfixOf` err -> Pass
other -> Fail ("expected size mismatch, got: " <> T.pack (show other)),
-- decompressNar: "none" passes through
runTestM "decompressNar none" $
let input = "fake nar data"
in assertEqual "decompress-none" (Right input) <$> Subst.decompressNar (toInteger (BS.length input)) "none" input,
-- decompressNar: an empty Compression field means bzip2 upstream
-- (the field's historical default), never identity, so the empty
-- spelling must decode a real bzip2 body exactly as the named
-- one does.
runTestM "decompressNar empty means bzip2" $
case B64.decode bzip2FixtureB64 of
Left err -> pure (Fail ("fixture base64 does not decode: " <> T.pack err))
Right compressed -> do
out <- Subst.decompressNar xzFixtureSize "" compressed
pure $ case out of
Right decoded -> assertEqual "empty-is-bzip2" xzFixturePayload decoded
Left err -> Fail ("empty Compression failed to decode as bzip2: " <> err),
-- decompressNar: bzip2 decodes under the same declared-NarSize
-- bound as the other codecs; the fixture comes from the bzip2
-- CLI, so the decoder is checked against the format's own
-- reference encoder rather than its own library.
runTestM "decompressNar bzip2 bounded roundtrip" $
case B64.decode bzip2FixtureB64 of
Left err -> pure (Fail ("fixture base64 does not decode: " <> T.pack err))
Right compressed -> do
out <- Subst.decompressNar xzFixtureSize "bzip2" compressed
pure $ case out of
Right decoded -> assertEqual "bzip2-roundtrip" xzFixturePayload decoded
Left err -> Fail ("bzip2 roundtrip failed: " <> err),
runTestM "decompressNar bzip2 over-bound rejects" $
case B64.decode bzip2FixtureB64 of
Left err -> pure (Fail ("fixture base64 does not decode: " <> T.pack err))
Right compressed -> do
out <- Subst.decompressNar (xzFixtureSize - 1) "bzip2" compressed
pure $ case out of
Left err | "NarSize" `T.isInfixOf` err -> Pass
other -> Fail ("expected over-bound rejection, got: " <> T.pack (show other)),
-- decompressNar: xz decodes under the declared-NarSize bound
-- (the fixture is a real 112-byte xz stream of 1792 payload
-- bytes, embedded base64 to keep the source ASCII).
runTestM "decompressNar xz bounded roundtrip" $
case B64.decode xzFixtureB64 of
Left err -> pure (Fail ("fixture base64 does not decode: " <> T.pack err))
Right compressed -> do
out <- Subst.decompressNar xzFixtureSize "xz" compressed
pure $ case out of
Right decoded -> assertEqual "xz-roundtrip" xzFixturePayload decoded
Left err -> Fail ("xz roundtrip failed: " <> err),
-- The output bound is exact: one byte under the real size must
-- refuse, naming the declared NarSize.
runTestM "decompressNar xz over-bound rejects" $
case B64.decode xzFixtureB64 of
Left err -> pure (Fail ("fixture base64 does not decode: " <> T.pack err))
Right compressed -> do
out <- Subst.decompressNar (xzFixtureSize - 1) "xz" compressed
pure $ case out of
Left err | "NarSize" `T.isInfixOf` err -> Pass
other -> Fail ("expected over-bound rejection, got: " <> T.pack (show other)),
-- decompressNar: bytes that are not an xz stream are an error,
-- never silently passed through
runTestM "decompressNar xz garbage rejects" $ do
out <- Subst.decompressNar 64 "xz" "not an xz stream"
pure $ case out of
Left _ -> Pass
Right _ -> Fail "garbage decoded as xz",
-- decompressNar: zstd decodes under the same declared-NarSize
-- bound; the fixture compresses with the sublibrary's own
-- encoder, the same pairing the push path ships.
runTestM "decompressNar zstd bounded roundtrip" $ do
out <- Subst.decompressNar xzFixtureSize "zstd" zstdFixtureCompressed
pure $ case out of
Right decoded -> assertEqual "zstd-roundtrip" xzFixturePayload decoded
Left err -> Fail ("zstd roundtrip failed: " <> err),
runTestM "decompressNar zstd over-bound rejects" $ do
out <- Subst.decompressNar (xzFixtureSize - 1) "zstd" zstdFixtureCompressed
pure $ case out of
Left err | "NarSize" `T.isInfixOf` err -> Pass
other -> Fail ("expected over-bound rejection, got: " <> T.pack (show other)),
-- decompressNar: unknown compression
runTestM "decompressNar unknown" $ do
out <- Subst.decompressNar 4 "brotli" "data"
pure $ case out of
Left _ -> Pass
Right _ -> Fail "expected error for unknown",
-- parseReferences: narinfo references are wire-format basenames
runTest "parseReferences basenames" $
let refs = ["aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-hello", "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb-dep-2.0"]
expected =
[ StorePath "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "hello",
StorePath "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" "dep-2.0"
]
in assertEqual "parse-refs" (Right expected) (Subst.parseReferences refs),
-- parseReferences: a malformed token is a loud error, never dropped
runTest "parseReferences malformed rejected" $
case Subst.parseReferences ["not-a-store-path"] of
Left _ -> Pass
Right refs -> Fail ("expected rejection, got: " <> T.pack (show refs)),
-- parseDeriver: basename becomes the DB's full path text
runTest "parseDeriver basename" $
let sp = StorePath "cccccccccccccccccccccccccccccccc" "hello.drv"
expected = Just (T.pack (storePathToFilePath defaultStoreDir sp))
in assertEqual "parse-deriver" (Right expected) (Subst.parseDeriver defaultStoreDir (Just "cccccccccccccccccccccccccccccccc-hello.drv")),
-- parseDeriver: upstream's unknown-deriver sentinel means no deriver
runTest "parseDeriver unknown sentinel" $
assertEqual "parse-deriver-unknown" (Right Nothing) (Subst.parseDeriver defaultStoreDir (Just "unknown-deriver")),
-- parseDeriver: absent stays absent, malformed is an error
runTest "parseDeriver absent and malformed" $
case (Subst.parseDeriver defaultStoreDir Nothing, Subst.parseDeriver defaultStoreDir (Just "bogus")) of
(Right Nothing, Left _) -> Pass
other -> Fail ("unexpected: " <> T.pack (show other)),
-- Recorded production narinfos from cache.nixos.org (paths this
-- codebase did not produce): the parse -> validate -> signature
-- pipeline against real cache data, the production ed25519
-- signature verified offline with the shipped public key.
runTest "recorded cache.nixos.org narinfo verifies end to end" $
case NarInfo.parseNarInfo recordedHelloNarInfo of
Left err -> Fail ("parse failed: " <> T.pack err)
Right ni ->
case Subst.validateNarInfoFields ni >> Subst.verifySigs Subst.defaultCacheConfig ni of
Left err -> Fail ("validate/verify failed: " <> err)
Right () -> assertEqual "compression" "xz" (NarInfo.niCompression ni),
-- References of a path built by Hydra, including the self
-- reference, and its Deriver - both produced by upstream Nix.
runTest "recorded narinfo references and deriver parse" $
case NarInfo.parseNarInfo recordedHelloNarInfo of
Left err -> Fail ("parse failed: " <> T.pack err)
Right ni ->
case (Subst.parseReferences (NarInfo.niReferences ni), Subst.parseDeriver defaultStoreDir (NarInfo.niDeriver ni)) of
(Right refs, Right (Just _)) ->
assertEqual
"reference hashes"
["dska0s3gxxd8azbsn85pwm6xcqhivldw", "jppkr0h8aap5z7m4xy4vg5yrwlly9h2v"]
(map spHash refs)
other -> Fail ("references/deriver did not parse: " <> T.pack (show other)),
-- The empty References line ("References: " with a trailing
-- space) production caches emit for leaf paths.
runTest "recorded no-reference narinfo verifies" $
case NarInfo.parseNarInfo recordedHelloDocNarInfo of
Left err -> Fail ("parse failed: " <> T.pack err)
Right ni ->
case Subst.validateNarInfoFields ni >> Subst.verifySigs Subst.defaultCacheConfig ni >> Subst.parseReferences (NarInfo.niReferences ni) of
Right [] -> Pass
other -> Fail ("expected verified empty references, got: " <> T.pack (show other)),
-- The fingerprint covers NarSize: altering the signed claim must
-- break the production signature.
runTest "tampered recorded narinfo fails signature" $
case NarInfo.parseNarInfo recordedHelloNarInfo of
Left err -> Fail ("parse failed: " <> T.pack err)
Right ni ->
case Subst.verifySigs Subst.defaultCacheConfig (ni {NarInfo.niNarSize = NarInfo.niNarSize ni + 1}) of
Left _ -> Pass
Right () -> Fail "signature verified over an altered NarSize",
-- Streaming pipeline: the chunk-fed download materializes,
-- hashes, and verifies without ever holding the NAR. The tree
-- carries the interesting shapes: nesting, an executable, a
-- symlink, and a sibling pair colliding on folding filesystems -
-- the digest equality proves the materialized tree re-serialises
-- to its NAR on every platform strategy.
-- Every length word, tag, and padding run must survive splitting
-- across Await boundaries, so the whole materialization runs at
-- several chunk sizes including single-byte feeds.
runTestM "streaming unpack materializes and verifies across chunk sizes" $ do
tmpBase <- getTemporaryDirectory
let tmpDir = tmpBase </> "nova-nix-test-stream-unpack"
chunkSizes = [1, 7, 8, 11] :: [Int]
runAt n = do
let dest = tmpDir </> ("out-" <> show n)
source <- chunkReader (streamChunks n streamTestNar)
result <- Subst.consumeNarStream tmpSensitivity dest (streamTestNarInfo streamTestNar) streamTestDigest source
onDisk <- ExecBit.serialiseFromPath (volumeCaseHack tmpSensitivity) dest
pure $ case result of
Left err ->
Just ("chunk size " <> T.pack (show n) <> ": " <> Subst.attemptFailureMessage err)
Right narByteCount
| narByteCount == BS.length streamTestNar
&& CHash.hashBytes (NAR.serialise onDisk) == streamTestDigest ->
Nothing
| otherwise ->
Just ("chunk size " <> T.pack (show n) <> ": streamed tree diverges from its NAR")
forceRemoveIfExists tmpDir
createDirectoryIfMissing True tmpDir
outcomes <- mapM runAt chunkSizes
forceRemoveIfExists tmpDir
pure $ case catMaybes outcomes of
[] -> Pass
(msg : _) -> Fail msg,
-- A truncated stream is a loud parse failure, never a short
-- tree - and it retries: truncation and a torn transfer
-- parse-fail the same way.
runTestM "streaming unpack refuses a truncated stream as transient" $ do
tmpBase <- getTemporaryDirectory
let tmpDir = tmpBase </> "nova-nix-test-stream-trunc"
forceRemoveIfExists tmpDir
createDirectoryIfMissing True tmpDir
source <- chunkReader (streamChunks 7 (BS.take (BS.length streamTestNar - 10) streamTestNar))
result <- Subst.consumeNarStream tmpSensitivity (tmpDir </> "out") (streamTestNarInfo streamTestNar) streamTestDigest source
forceRemoveIfExists tmpDir
pure $ case result of
Left (Subst.TransientFailure _) -> Pass
Left (Subst.FatalFailure err) -> Fail ("truncation classified fatal: " <> err)
Right _ -> Fail "truncated NAR stream was accepted",
-- A digest mismatch reports before the tree is trusted, and it
-- is fatal: the size matched, so the transfer completed.
runTestM "streaming unpack refuses a digest mismatch as fatal" $ do
tmpBase <- getTemporaryDirectory
let tmpDir = tmpBase </> "nova-nix-test-stream-digest"
forceRemoveIfExists tmpDir
createDirectoryIfMissing True tmpDir
source <- chunkReader (streamChunks 7 streamTestNar)
result <- Subst.consumeNarStream tmpSensitivity (tmpDir </> "out") (streamTestNarInfo streamTestNar) (CHash.hashBytes "not the nar") source
forceRemoveIfExists tmpDir
pure $ case result of
Left (Subst.FatalFailure err) | "hash mismatch" `T.isInfixOf` err -> Pass
Left other -> Fail ("expected fatal hash mismatch, got: " <> Subst.attemptFailureMessage other)
Right _ -> Fail "digest mismatch was accepted",
-- A narinfo lying about NarSize in either direction is refused
-- at NarDone - the grammar completed, so the mismatch is the
-- narinfo misdeclaring, and fatal.
runTestM "streaming unpack refuses an overdeclared NarSize" $ do
tmpBase <- getTemporaryDirectory
let tmpDir = tmpBase </> "nova-nix-test-stream-oversize"
lying = (streamTestNarInfo streamTestNar) {NarInfo.niNarSize = toInteger (BS.length streamTestNar) + 1}
forceRemoveIfExists tmpDir
createDirectoryIfMissing True tmpDir
source <- chunkReader (streamChunks 7 streamTestNar)
result <- Subst.consumeNarStream tmpSensitivity (tmpDir </> "out") lying streamTestDigest source
forceRemoveIfExists tmpDir
pure $ case result of
Left (Subst.FatalFailure err) | "size mismatch" `T.isInfixOf` err -> Pass
Left other -> Fail ("expected fatal size mismatch, got: " <> Subst.attemptFailureMessage other)
Right _ -> Fail "overdeclared NarSize was accepted",
runTestM "streaming unpack refuses an underdeclared NarSize" $ do
tmpBase <- getTemporaryDirectory
let tmpDir = tmpBase </> "nova-nix-test-stream-undersize"
lying = (streamTestNarInfo streamTestNar) {NarInfo.niNarSize = toInteger (BS.length streamTestNar) - 1}
forceRemoveIfExists tmpDir
createDirectoryIfMissing True tmpDir
source <- chunkReader (streamChunks 7 streamTestNar)
result <- Subst.consumeNarStream tmpSensitivity (tmpDir </> "out") lying streamTestDigest source
forceRemoveIfExists tmpDir
pure $ case result of
Left (Subst.FatalFailure err) | "size mismatch" `T.isInfixOf` err -> Pass
Left other -> Fail ("expected fatal size mismatch, got: " <> Subst.attemptFailureMessage other)
Right _ -> Fail "underdeclared NarSize was accepted",
-- cappedBodySource: the streaming mirror of readBodyCapped -
-- a body past the key-trusted declared size aborts mid-stream.
runTestM "cappedBodySource aborts past the cap" $ do
reader <- chunkReader ["abcdef", "ghijkl"]
source <- Subst.cappedBodySource 10 reader
firstChunk <- source
overCap <- try source :: IO (Either SomeException BS.ByteString)
pure $ case (firstChunk, overCap) of
("abcdef", Left _) -> Pass
other -> Fail ("expected abort past the cap, got: " <> T.pack (show other)),
-- withDecompressedSource: xz chunks decompress under the
-- declared bound; the support decision mirrors decompressorFor.
runTestM "withDecompressedSource xz chunked roundtrip" $
case B64.decode xzFixtureB64 of
Left err -> pure (Fail ("fixture base64 does not decode: " <> T.pack err))
Right compressed -> do
source <- chunkReader (streamChunks 7 compressed)
result <- Subst.withDecompressedSource xzFixtureSize "xz" source $ \pull ->
let go acc = do
chunk <- pull
if BS.null chunk
then pure (Right (BS.concat (reverse acc)))
else go (chunk : acc)
in go []
pure $ case result of
Right out | out == xzFixturePayload -> Pass
other -> Fail ("xz source roundtrip diverged: " <> T.pack (show (fmap BS.length other))),
runTestM "withDecompressedSource zstd chunked roundtrip" $ do
source <- chunkReader (streamChunks 7 zstdFixtureCompressed)
result <- Subst.withDecompressedSource xzFixtureSize "zstd" source $ \pull ->
let go acc = do
chunk <- pull
if BS.null chunk
then pure (Right (BS.concat (reverse acc)))
else go (chunk : acc)
in go []
pure $ case result of
Right out | out == xzFixturePayload -> Pass
other -> Fail ("zstd source roundtrip diverged: " <> T.pack (show (fmap BS.length other))),
runTestM "withDecompressedSource xz single-byte chunks" $
case B64.decode xzFixtureB64 of
Left err -> pure (Fail ("fixture base64 does not decode: " <> T.pack err))
Right compressed -> do
source <- chunkReader (streamChunks 1 compressed)
result <- Subst.withDecompressedSource xzFixtureSize "xz" source $ \pull ->
let go acc = do
chunk <- pull
if BS.null chunk
then pure (Right (BS.concat (reverse acc)))
else go (chunk : acc)
in go []
pure $ case result of
Right out | out == xzFixturePayload -> Pass
other -> Fail ("xz 1-byte roundtrip diverged: " <> T.pack (show (fmap BS.length other))),
-- The LIVE pipeline's defenses, not the strict oracle's: hostile
-- compressed input through withDecompressedSource must land in
-- the Left channel with the right retry class, never escape as
-- an exception.
runTestM "withDecompressedSource xz over-bound is fatal" $
case B64.decode xzFixtureB64 of
Left err -> pure (Fail ("fixture base64 does not decode: " <> T.pack err))
Right compressed -> do
source <- chunkReader (streamChunks 7 compressed)
result <- Subst.withDecompressedSource (xzFixtureSize - 1) "xz" source drainChunkSource
pure $ case result of
Left (Subst.FatalFailure err) | "NarSize" `T.isInfixOf` err -> Pass
other -> Fail ("expected fatal over-bound, got: " <> T.pack (show (void other))),
runTestM "withDecompressedSource xz garbage is transient" $ do
source <- chunkReader ["not an xz stream"]
result <- Subst.withDecompressedSource 64 "xz" source drainChunkSource
pure $ case result of
Left (Subst.TransientFailure _) -> Pass
other -> Fail ("expected transient stream error, got: " <> T.pack (show (void other))),
runTestM "withDecompressedSource xz truncated is transient" $
case B64.decode xzFixtureB64 of
Left err -> pure (Fail ("fixture base64 does not decode: " <> T.pack err))
Right compressed -> do
source <- chunkReader (streamChunks 7 (BS.take 40 compressed))
result <- Subst.withDecompressedSource xzFixtureSize "xz" source drainChunkSource
pure $ case result of
Left (Subst.TransientFailure _) -> Pass
other -> Fail ("expected transient truncation, got: " <> T.pack (show (void other))),
-- The failure contract of the post-download pipeline: every
-- failing materialization removes the tree it wrote, and a
-- clean one registers the verified metadata.
runTestM "materialize registers a verified tree" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-materialize-ok"
forceRemoveIfExists tmpStore
createDirectoryIfMissing True tmpStore
store <- openStore (StoreDir tmpStore)
let sp = StorePath sampleHash "stream"
destPath = storePathToFilePath (StoreDir tmpStore) sp
source <- chunkReader (streamChunks 7 streamTestNar)
result <- Subst.materializeNarFromSource store sp (streamTestNarInfo streamTestNar) streamTestDigest [] Nothing source
survived <- doesDirectoryExist destPath
closeStore store
forceRemoveIfExists tmpStore
pure $ case result of
Left err -> Fail ("materialize failed: " <> Subst.attemptFailureMessage err)
Right reg
| not survived -> Fail "verified tree missing after materialize"
| prNarSize reg /= BS.length streamTestNar -> Fail "registration NarSize diverges"
| prNarHash reg /= CHash.formatNixHash streamTestDigest -> Fail "registration NarHash diverges"
| otherwise -> Pass,
runTestM "materialize removes the tree on a digest mismatch" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-materialize-digest"
forceRemoveIfExists tmpStore
createDirectoryIfMissing True tmpStore
store <- openStore (StoreDir tmpStore)
let sp = StorePath sampleHash "stream"
destPath = storePathToFilePath (StoreDir tmpStore) sp
source <- chunkReader (streamChunks 7 streamTestNar)
result <- Subst.materializeNarFromSource store sp (streamTestNarInfo streamTestNar) (CHash.hashBytes "not the nar") [] Nothing source
survived <- doesDirectoryExist destPath
closeStore store
forceRemoveIfExists tmpStore
pure $ case result of
Right _ -> Fail "digest mismatch was accepted"
Left (Subst.TransientFailure err) -> Fail ("mismatch classified transient: " <> err)
Left (Subst.FatalFailure err)
| not ("hash mismatch" `T.isInfixOf` err) -> Fail ("unexpected failure: " <> err)
| survived -> Fail "tree survived a digest mismatch"
| otherwise -> Pass,
runTestM "materialize removes the tree on a truncated stream" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-materialize-trunc"
forceRemoveIfExists tmpStore
createDirectoryIfMissing True tmpStore
store <- openStore (StoreDir tmpStore)
let sp = StorePath sampleHash "stream"
destPath = storePathToFilePath (StoreDir tmpStore) sp
source <- chunkReader (streamChunks 7 (BS.take (BS.length streamTestNar - 10) streamTestNar))
result <- Subst.materializeNarFromSource store sp (streamTestNarInfo streamTestNar) streamTestDigest [] Nothing source
survived <- doesDirectoryExist destPath
closeStore store
forceRemoveIfExists tmpStore
pure $ case result of
Right _ -> Fail "truncated stream was accepted"
Left (Subst.FatalFailure err) -> Fail ("truncation classified fatal: " <> err)
Left (Subst.TransientFailure _)
| survived -> Fail "tree survived a truncated stream"
| otherwise -> Pass,
-- The download cap derives from the SIGNED NarSize; the unsigned
-- FileSize may only lower it, never raise it.
runTest "downloadCapFor lets FileSize lower but never raise the cap" $
let base = streamTestNarInfo streamTestNar
narSize = NarInfo.niNarSize base
ceilingCap = Subst.compressedBodyCeiling narSize
absent = Subst.downloadCapFor base {NarInfo.niFileSize = Nothing}
lowered = Subst.downloadCapFor base {NarInfo.niFileSize = Just 100}
inflated = Subst.downloadCapFor base {NarInfo.niFileSize = Just (ceilingCap * 1000)}
in case (absent, lowered, inflated) of
(Right capAbsent, Right capLowered, Right capInflated)
| toInteger capAbsent == ceilingCap
&& capLowered == 100
&& toInteger capInflated == ceilingCap ->
Pass
other -> Fail ("unexpected caps: " <> T.pack (show other)),
runTest "compressedBodyCeiling floors small and scales large" $
let smallCeiling = Subst.compressedBodyCeiling 10
largeSize = 64 * 1024 * 1024
largeCeiling = Subst.compressedBodyCeiling largeSize
in if smallCeiling == 10 + 64 * 1024 && largeCeiling == largeSize + largeSize `div` 64
then Pass
else Fail ("unexpected ceilings: " <> T.pack (show (smallCeiling, largeCeiling))),
-- The zstd mirror of the xz hostile trio: over-bound output is
-- deterministic, while a corrupt frame and a frame cut off
-- mid-way both retry - the codec judges end of input by
-- libzstd's own frame-boundary signal, so truncation refuses
-- here instead of yielding a short output.
runTestM "withDecompressedSource zstd over-bound is fatal" $ do
source <- chunkReader (streamChunks 7 zstdFixtureCompressed)
result <- Subst.withDecompressedSource (xzFixtureSize - 1) "zstd" source drainChunkSource
pure $ case result of
Left (Subst.FatalFailure err) | "NarSize" `T.isInfixOf` err -> Pass
other -> Fail ("expected fatal over-bound, got: " <> T.pack (show (void other))),
runTestM "withDecompressedSource zstd garbage is transient" $ do
source <- chunkReader ["not a zstd frame"]
result <- Subst.withDecompressedSource 64 "zstd" source drainChunkSource
pure $ case result of
Left (Subst.TransientFailure _) -> Pass
other -> Fail ("expected transient stream error, got: " <> T.pack (show (void other))),
runTestM "withDecompressedSource zstd truncated is transient" $ do
source <- chunkReader (streamChunks 7 (BS.take (BS.length zstdFixtureCompressed - 8) zstdFixtureCompressed))
result <- Subst.withDecompressedSource xzFixtureSize "zstd" source drainChunkSource
pure $ case result of
Left (Subst.TransientFailure _) -> Pass
other -> Fail ("expected transient truncation, got: " <> T.pack (show (void other))),
-- The codec refuses a truncated frame, and the whole pipeline
-- must carry that refusal into the Left channel as retryable
-- rather than let a short NAR reach the store.
runTestM "zstd truncated body fails the pipeline as transient" $ do
tmpBase <- getTemporaryDirectory
let tmpDir = tmpBase </> "nova-nix-test-zstd-trunc"
compressedNar = CZstd.compress CZstd.defaultCompressionLevel streamTestNar
forceRemoveIfExists tmpDir
createDirectoryIfMissing True tmpDir
source <- chunkReader (streamChunks 7 (BS.take (BS.length compressedNar - 8) compressedNar))
result <-
Subst.withDecompressedSource (toInteger (BS.length streamTestNar)) "zstd" source $
Subst.consumeNarStream tmpSensitivity (tmpDir </> "out") ((streamTestNarInfo streamTestNar) {NarInfo.niCompression = "zstd"}) streamTestDigest
forceRemoveIfExists tmpDir
pure $ case result of
Left (Subst.TransientFailure _) -> Pass
Left (Subst.FatalFailure err) -> Fail ("zstd truncation classified fatal: " <> err)
Right _ -> Fail "truncated zstd body was accepted",
-- The bzip2 mirror of the xz hostile trio, over a fixture the
-- bzip2 CLI produced: over-bound output is deterministic, while
-- garbage and a truncated stream retry.
runTestM "withDecompressedSource bzip2 chunked roundtrip" $
case B64.decode bzip2FixtureB64 of
Left err -> pure (Fail ("fixture base64 does not decode: " <> T.pack err))
Right compressed -> do
source <- chunkReader (streamChunks 7 compressed)
result <- Subst.withDecompressedSource xzFixtureSize "bzip2" source $ \pull ->
let go acc = do
chunk <- pull
if BS.null chunk
then pure (Right (BS.concat (reverse acc)))
else go (chunk : acc)
in go []
pure $ case result of
Right out | out == xzFixturePayload -> Pass
other -> Fail ("bzip2 source roundtrip diverged: " <> T.pack (show (fmap BS.length other))),
runTestM "withDecompressedSource bzip2 over-bound is fatal" $
case B64.decode bzip2FixtureB64 of
Left err -> pure (Fail ("fixture base64 does not decode: " <> T.pack err))
Right compressed -> do
source <- chunkReader (streamChunks 7 compressed)
result <- Subst.withDecompressedSource (xzFixtureSize - 1) "bzip2" source drainChunkSource
pure $ case result of
Left (Subst.FatalFailure err) | "NarSize" `T.isInfixOf` err -> Pass
other -> Fail ("expected fatal over-bound, got: " <> T.pack (show (void other))),
runTestM "withDecompressedSource bzip2 garbage is transient" $ do
source <- chunkReader ["not a bzip2 stream"]
result <- Subst.withDecompressedSource 64 "bzip2" source drainChunkSource
pure $ case result of
Left (Subst.TransientFailure _) -> Pass
other -> Fail ("expected transient stream error, got: " <> T.pack (show (void other))),
runTestM "withDecompressedSource bzip2 truncated is transient" $
case B64.decode bzip2FixtureB64 of
Left err -> pure (Fail ("fixture base64 does not decode: " <> T.pack err))
Right compressed -> do
source <- chunkReader (streamChunks 7 (BS.take (BS.length compressed - 8) compressed))
result <- Subst.withDecompressedSource xzFixtureSize "bzip2" source drainChunkSource
pure $ case result of
Left (Subst.TransientFailure _) -> Pass
other -> Fail ("expected transient truncation, got: " <> T.pack (show (void other))),
-- A bzip2-compressed NAR through the whole post-download
-- pipeline: the format the historical caches serve decompresses,
-- hashes, parses, and materializes in one bounded pass.
runTestM "bzip2 NAR streams through the pipeline" $
case B64.decode bzip2NarFixtureB64 of
Left err -> pure (Fail ("fixture base64 does not decode: " <> T.pack err))
Right compressed -> do
tmpBase <- getTemporaryDirectory
let tmpDir = tmpBase </> "nova-nix-test-bzip2-pipeline"
destPath = tmpDir </> "out"
forceRemoveIfExists tmpDir
createDirectoryIfMissing True tmpDir
source <- chunkReader (streamChunks 7 compressed)
result <-
Subst.withDecompressedSource (toInteger (BS.length bzip2NarFixture)) "bzip2" source $
Subst.consumeNarStream
tmpSensitivity
destPath
((streamTestNarInfo bzip2NarFixture) {NarInfo.niCompression = "bzip2"})
(CHash.hashBytes bzip2NarFixture)
materialized <- Dir.doesFileExist (destPath </> "greeting")
forceRemoveIfExists tmpDir
pure $ case result of
Left err -> Fail ("bzip2 pipeline failed: " <> Subst.attemptFailureMessage err)
Right narBytes
| narBytes /= BS.length bzip2NarFixture -> Fail "bzip2 pipeline counted the wrong NAR size"
| not materialized -> Fail "bzip2 pipeline left no tree at the destination"
| otherwise -> Pass,
runTest "streaming compression support matches the strict set" $
case (Subst.streamingDecompressionSupported "xz", Subst.streamingDecompressionSupported "zstd", Subst.streamingDecompressionSupported "bzip2", Subst.streamingDecompressionSupported "brotli") of
(Right (), Right (), Right (), Left _) -> Pass
other -> Fail ("unexpected support set: " <> T.pack (show other)),
-- The support set is encoded twice - the strict decompressor and
-- the streaming decision - so their agreement is pinned across
-- the codecs either could plausibly grow, not left to comments.
runTest "strict and streaming support sets agree" $
let agrees compression =
case (Subst.decompressorFor 1 compression, Subst.streamingDecompressionSupported compression) of
(Right _, Right ()) -> True
(Left _, Left _) -> True
_ -> False
in if all agrees ["none", "", "xz", "zstd", "bzip2", "brotli"]
then Pass
else Fail "strict and streaming compression support drifted",
-- The strict path is the streaming path's differential oracle:
-- the same NAR materialized by both must produce the same tree.
runTestM "strict and streaming unpack agree" $ do
tmpBase <- getTemporaryDirectory
let tmpDir = tmpBase </> "nova-nix-test-stream-oracle"
forceRemoveIfExists tmpDir
createDirectoryIfMissing True tmpDir
strictOutcome <- case NAR.deserialise streamTestNar of
Left err -> pure (Left (T.pack err))
Right entry -> unpackNarEntry tmpSensitivity (tmpDir </> "strict") entry
source <- chunkReader (streamChunks 11 streamTestNar)
streamOutcome <- Subst.consumeNarStream tmpSensitivity (tmpDir </> "streamed") (streamTestNarInfo streamTestNar) streamTestDigest source
strictTree <- NAR.serialiseFromPath (tmpDir </> "strict")
streamedTree <- NAR.serialiseFromPath (tmpDir </> "streamed")
forceRemoveIfExists tmpDir
pure $ case (strictOutcome, streamOutcome) of
(Right (), Right _)
| NAR.serialise strictTree == NAR.serialise streamedTree -> Pass
| otherwise -> Fail "strict and streaming trees diverge"
other -> Fail ("oracle setup failed: " <> T.pack (show other)),
-- trySubstitute: empty caches returns SubstNotFound
runTestM "trySubstitute no caches" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-subst"
createDirectoryIfMissing True tmpStore
store <- openStore (StoreDir tmpStore)
result <- Subst.trySubstitute store [] (StorePath "test" "hello")
closeStore store
removeDirectoryRecursive tmpStore
pure (assertEqual "no-caches" Subst.SubstNotFound result),
-- defaultCacheConfig has correct URL
runTest "defaultCacheConfig url" $
assertEqual "default-url" "https://cache.nixos.org" (Subst.ccUrl Subst.defaultCacheConfig),
-- defaultCacheConfig has priority 40
runTest "defaultCacheConfig priority" $
assertEqual "default-prio" 40 (Subst.ccPriority Subst.defaultCacheConfig),
-- verifyNarHash: matching NAR hash accepted (HIGH#2 integrity gate);
-- the returned digest is the declared hash, decoded.
runTest "verifyNarHash accepts matching hash" $
case Subst.verifyNarHash (sampleNarInfo sampleNarHash) sampleNarBytes of
Right declared
| CHash.formatNixHash declared == sampleNarHash -> Pass
| otherwise -> Fail "returned digest does not match the declared hash"
Left err -> Fail ("expected acceptance, got: " <> err),
-- verifyNarHash: mismatched NAR hash rejected
runTest "verifyNarHash rejects mismatched hash" $
case Subst.verifyNarHash (sampleNarInfo wrongNarHash) sampleNarBytes of
Left _ -> Pass
Right _ -> Fail "expected mismatch rejection",
-- verifyNarHash: malformed NAR hash rejected
runTest "verifyNarHash rejects malformed hash" $
case Subst.verifyNarHash (sampleNarInfo "not-a-hash") sampleNarBytes of
Left _ -> Pass
Right _ -> Fail "expected malformed-hash rejection",
-- verifyNar: the only constructor of VerifiedNar carries the bytes
-- unchanged and the declared digest decoded, so the unpack sink
-- and the registration read both from the witness.
runTest "verifyNar carries the bytes and the declared digest" $
case Subst.verifyNar (sampleNarInfo sampleNarHash) sampleNarBytes of
Right verified
| Subst.verifiedNarBytes verified /= sampleNarBytes -> Fail "verified bytes differ from the input"
| CHash.formatNixHash (Subst.verifiedNarDigest verified) /= sampleNarHash -> Fail "carried digest is not the declared hash"
| otherwise -> Pass
Left err -> Fail ("expected acceptance, got: " <> err),
-- verifyNar: either signed claim failing yields no witness at all.
runTest "verifyNar rejects a hash or size mismatch" $
let wrongHash = Subst.verifyNar (sampleNarInfo wrongNarHash) sampleNarBytes
wrongSize = Subst.verifyNar ((sampleNarInfo sampleNarHash) {NarInfo.niNarSize = toInteger (BS.length sampleNarBytes) + 1}) sampleNarBytes
in case (wrongHash, wrongSize) of
(Left _, Left _) -> Pass
other -> Fail ("expected both rejections, got: " <> T.pack (show other)),
-- narInfoMatchesPath: identity match accepted
runTest "narInfoMatchesPath accepts matching identity" $
if Subst.narInfoMatchesPath (StorePath sampleHash "hello") (sampleNarInfo sampleNarHash)
then Pass
else Fail "expected identity match",
-- narInfoMatchesPath: identity mismatch rejected
runTest "narInfoMatchesPath rejects mismatched identity" $
if Subst.narInfoMatchesPath (StorePath (T.replicate 32 "b") "hello") (sampleNarInfo sampleNarHash)
then Fail "expected identity mismatch"
else Pass,
-- tryCachesWith: the first success stops the scan (later caches
-- are never contacted)
runTestM "tryCachesWith success stops scan" $ do
calls <- newIORef (0 :: Int)
withChainLock "nova-nix-test-chain-stop" $ \lock -> do
let hit = PathRegistration (StorePath (T.replicate 32 "d") "hit") "sha256:d" 1 Nothing []
attempt cache = do
atomicModifyIORef' calls (\n -> (n + 1, ()))
pure $
if Subst.ccUrl cache == "https://b"
then Subst.SubstSuccess hit lock
else Subst.SubstNotFound
result <- Subst.tryCachesWith attempt [chainCache "https://a", chainCache "https://b", chainCache "https://c"]
made <- readIORef calls
pure $
if result == Subst.SubstSuccess hit lock && made == 2
then Pass
else Fail ("got " <> T.pack (show result) <> " after " <> T.pack (show made) <> " attempts"),
-- tryCachesWith: an already-valid path found mid-scan is terminal
-- like a success - later caches are never contacted
runTestM "tryCachesWith already-valid stops scan" $ do
calls <- newIORef (0 :: Int)
let attempt _ = do
atomicModifyIORef' calls (\n -> (n + 1, ()))
pure Subst.SubstAlreadyValid
result <- Subst.tryCachesWith attempt [chainCache "https://a", chainCache "https://b"]
made <- readIORef calls
pure $
if result == Subst.SubstAlreadyValid && made == 1
then Pass
else Fail ("got " <> T.pack (show result) <> " after " <> T.pack (show made) <> " attempts"),
-- tryCachesWith: an erroring cache falls through to a later hit
-- instead of aborting the chain
runTestM "tryCachesWith error falls through to next cache" $
withChainLock "nova-nix-test-chain-fallthrough" $ \lock -> do
let hit = PathRegistration (StorePath (T.replicate 32 "f") "hit") "sha256:f" 1 Nothing []
attempt cache
| Subst.ccUrl cache == "https://a" = pure (Subst.SubstError "transient 500")
| otherwise = pure (Subst.SubstSuccess hit lock)
result <- Subst.tryCachesWith attempt [chainCache "https://a", chainCache "https://b"]
pure (assertEqual "fallthrough" (Subst.SubstSuccess hit lock) result),
-- tryCachesWith: all misses stay SubstNotFound
runTestM "tryCachesWith all misses" $ do
result <- Subst.tryCachesWith (\_ -> pure Subst.SubstNotFound) [chainCache "https://a", chainCache "https://b"]
pure (assertEqual "misses" Subst.SubstNotFound result),
-- tryCachesWith: with no hit anywhere, the FIRST error is reported,
-- tagged with the URL of the cache that produced it
runTestM "tryCachesWith reports first error tagged with cache" $ do
let attempt cache
| Subst.ccUrl cache == "https://a" = pure Subst.SubstNotFound
| Subst.ccUrl cache == "https://b" = pure (Subst.SubstError "first")
| otherwise = pure (Subst.SubstError "second")
result <- Subst.tryCachesWith attempt [chainCache "https://a", chainCache "https://b", chainCache "https://c"]
pure $ case result of
Subst.SubstError err
| "https://b" `T.isPrefixOf` err && "first" `T.isSuffixOf` err -> Pass
other -> Fail ("expected tagged first error, got " <> T.pack (show other)),
-- catchSync (the split every attempt wraps itself in): a
-- synchronous exception folds into SubstError and the scan falls
-- through to the next cache
runTestM "catchSync folds sync exception into SubstError" $ do
let attempt cache =
Subst.catchSync
( if Subst.ccUrl cache == "https://a"
then throwIO (ErrorCall "disk full")
else pure Subst.SubstNotFound
)
(pure . Subst.SubstError . T.pack . show)
result <- Subst.tryCachesWith attempt [chainCache "https://a", chainCache "https://b"]
pure $ case result of
Subst.SubstError err
| "disk full" `T.isInfixOf` err -> Pass
other -> Fail ("expected SubstError from sync exception, got " <> T.pack (show other)),
-- catchSync: an asynchronous exception thrown mid-attempt
-- propagates out of the cache scan instead of folding into
-- SubstError - cancellation must abort substitution, never be
-- spent as fallthrough to the next cache or to a local build
runTestM "catchSync propagates async exception out of the scan" $ do
scanned <- newIORef (0 :: Int)
let attempt _ =
Subst.catchSync
( do
atomicModifyIORef' scanned (\n -> (n + 1, ()))
throwIO (asyncExceptionToException (ErrorCall "cancelled"))
)
(pure . Subst.SubstError . T.pack . show)
outcome <- try (Subst.tryCachesWith attempt [chainCache "https://a", chainCache "https://b"])
made <- readIORef scanned
pure $ case (outcome :: Either SomeException Subst.SubstResult) of
Left escaped -> case fromException escaped of
Just (SomeAsyncException _)
| made == 1 -> Pass
| otherwise -> Fail ("scan continued past the interrupt: " <> T.pack (show made) <> " attempts")
Nothing -> Fail ("wrong exception escaped: " <> T.pack (show escaped))
Right result -> Fail ("async exception folded into " <> T.pack (show result)),
-- clearStaleDestination: removes a read-only leftover tree (the
-- crash-between-unpack-and-register wedge)
runTestM "clearStaleDestination removes read-only leftovers" $ do
tmpBase <- getTemporaryDirectory
let staleRoot = tmpBase </> "nova-nix-test-stale-dest"
staleFile = staleRoot </> "bin" </> "tool"
createDirectoryIfMissing True (staleRoot </> "bin")
writeFile staleFile "leftover"
perms <- getPermissions staleFile
Dir.setPermissions staleFile (Dir.setOwnerWritable False perms)
Subst.clearStaleDestination staleRoot
gone <- Dir.doesPathExist staleRoot
pure (if gone then Fail "stale tree survived" else Pass),
-- clearStaleDestination: a missing destination is a no-op
runTestM "clearStaleDestination missing path no-op" $ do
tmpBase <- getTemporaryDirectory
outcome <- try (Subst.clearStaleDestination (tmpBase </> "nova-nix-test-no-such-dir"))
pure $ case (outcome :: Either SomeException ()) of
Right () -> Pass
Left e -> Fail ("threw: " <> T.pack (show e)),
-- unpackNarEntry: what the archive grammar refuses (traversal
-- shapes, a NUL) is refused on every host before anything is
-- written
runTestM "unpackNarEntry rejects unsafe entry names" $ do
tmpBase <- getTemporaryDirectory
let dest = tmpBase </> "nova-nix-test-unpack-unsafe"
evil name = NAR.NarDirectory [(name, NAR.NarRegular False "x")]
-- Cleared before each: the root is created exclusively, so
-- a leftover from the previous name would refuse for a
-- different reason than the one under test.
unpackFresh name = do
Subst.clearStaleDestination dest
unpackNarEntry tmpSensitivity dest (evil name)
results <- mapM unpackFresh ["..", ".", "", "a/b", "a\NULb"]
Subst.clearStaleDestination dest
pure $
if all (\case Left err -> "NAR directory entry name" `T.isInfixOf` err; Right () -> False) results
then Pass
else Fail ("accepted an unsafe name: " <> T.pack (show results)),
-- Names upstream's restore writes on POSIX as it finds them
-- (posixOnlyTree, compared against nix-store --restore 2.33.2)
-- materialize byte for byte through both unpack paths there, and
-- the tree re-serialises to the NAR it came from. Windows refuses
-- the first such name before writing any entry.
runTestM "names upstream restores on POSIX materialize as their bytes" $ do
tmpBase <- getTemporaryDirectory
let refusal = "NAR directory entry name 'COM1' is a Windows device name"
outcomes <- unpackedBothWays tmpSensitivity (tmpBase </> "nova-nix-test-unpack-posix-names") posixOnlyTree
pure $
if SI.os == "mingw32"
then assertEqual "Windows refusals (strict, streamed)" (Left refusal, Left refusal) outcomes
else assertEqual "trees read back (strict, streamed)" (Right posixOnlyTree, Right posixOnlyTree) outcomes,
-- The same tree substituted into a temp store: the strict pipeline
-- unpacks and seals it, then re-serialises the store path from disk
-- against the narinfo's hash before it registers anything, so a
-- success means the path's bytes reproduce the NAR. Windows
-- refuses it before writing.
runTestM "a store path holding names upstream restores on POSIX substitutes" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-unpack-posix-store"
sp = StorePath (T.replicate 32 "c") "posix-names"
rawNar = NAR.serialise posixOnlyTree
info = (streamTestNarInfo rawNar) {NarInfo.niStorePath = storePathToText defaultStoreDir sp}
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
result <- Subst.unpackAndVerify store sp info rawNar
onDisk <- case result of
Subst.SubstSuccess _ lock -> do
releasePathLock lock
Right <$> NAR.serialiseFromPath (storePathToFilePath (stDir store) sp)
other -> pure (Left (T.pack (show other)))
closeStore store
forceRemoveIfExists tmpStore
pure $ case onDisk of
Left shown
| SI.os == "mingw32" && "is a Windows device name" `T.isInfixOf` shown -> Pass
_ -> assertEqual "store path read back" (Right posixOnlyTree) onDisk,
-- A name and a link target with no UTF-8 reading. Linux holds
-- both as bytes, as upstream restores them; a macOS volume cannot
-- hold the name (APFS refuses it, HFS+ rewrites it) but keeps the
-- target's bytes; Windows holds neither.
runTestM "bytes with no UTF-8 reading materialize where the host holds them" $ do
tmpBase <- getTemporaryDirectory
let dest = tmpBase </> "nova-nix-test-unpack-raw-bytes"
nameTree = NAR.NarDirectory [("caf\xE9", NAR.NarDirectory [("\xFF", NAR.NarRegular True "x")])]
targetTree = NAR.NarDirectory [("link", NAR.NarSymlink "caf\xE9")]
nameRefusal reason = "NAR directory entry name \"caf\\233\" is not valid UTF-8, " <> reason
targetRefusal = "NAR symlink target \"caf\\233\" is not valid UTF-8, so it has no UTF-16 form for Windows"
both outcome = (outcome, outcome)
named <- unpackedBothWays tmpSensitivity dest nameTree
targeted <- unpackedBothWays tmpSensitivity dest targetTree
pure $ case SI.os of
"mingw32" ->
assertEqual
"Windows refusals"
(both (Left (nameRefusal "so it has no UTF-16 form for Windows")), both (Left targetRefusal))
(named, targeted)
"darwin" ->
assertEqual
"macOS refuses the name and keeps the target"
(both (Left (nameRefusal "which a macOS filesystem cannot hold")), both (Right targetTree))
(named, targeted)
_ ->
assertEqual
"Linux keeps both"
(both (Right nameTree), both (Right targetTree))
(named, targeted),
-- The bytes reach the filesystem without passing through the
-- locale's codec: under an ASCII file-system encoding (a C locale)
-- or a Latin-1 one a UTF-8 name still lands as its UTF-8 bytes.
-- Spelled through 'FilePath', the first cannot encode the name and
-- the second writes other bytes.
runTestM "names land as their bytes whatever the file-system encoding" $ do
tmpBase <- getTemporaryDirectory
let dest = tmpBase </> "nova-nix-test-unpack-codec"
tree =
NAR.NarDirectory
[ ("caf\xC3\xA9", NAR.NarRegular False "e"),
("link", NAR.NarSymlink "\xE2\x9C\x93"),
("\xE2\x9C\x93", NAR.NarRegular False "check")
]
under encodingName = do
encoding <- mkTextEncoding encodingName
bracket getFileSystemEncoding setFileSystemEncoding $ \_ -> do
setFileSystemEncoding encoding
unpackedBothWays tmpSensitivity dest tree
if SI.os == "mingw32"
then Pass <$ putStrLn " SKIP a Windows path is UTF-16 and no locale codec spells it"
else do
outcomes <- mapM under ["ASCII//ROUNDTRIP", "ISO-8859-1//ROUNDTRIP"]
pure (assertEqual "trees read back under ASCII and Latin-1 (strict, streamed)" (replicate 2 (Right tree, Right tree)) outcomes),
-- unpackNarEntry: a NAR symlink materializes as a REAL link or fails
-- loudly - never as a regular file holding the target text, which
-- would silently diverge from the signed NAR hash
runTestM "unpackNarEntry symlink is real or loud" $ do
tmpBase <- getTemporaryDirectory
let dest = tmpBase </> "nova-nix-test-unpack-symlink"
tree =
NAR.NarDirectory
[ ("real", NAR.NarRegular False "contents"),
("link", NAR.NarSymlink "real")
]
Subst.clearStaleDestination dest
result <- unpackNarEntry tmpSensitivity dest tree
outcome <- case result of
Right () -> do
isLink <- Dir.pathIsSymbolicLink (dest </> "link")
pure (if isLink then Pass else Fail "symlink materialized as a non-link")
Left _ -> do
leftBehind <- Dir.doesFileExist (dest </> "link")
pure (if leftBehind then Fail "failed loudly but left a regular file behind" else Pass)
Subst.clearStaleDestination dest
pure outcome,
-- unpackNarEntry: a directory-target symlink that sorts BEFORE its
-- target still gets the directory link flavor (second-pass typing)
runTestM "unpackNarEntry types forward dir symlink" $ do
tmpBase <- getTemporaryDirectory
let dest = tmpBase </> "nova-nix-test-unpack-dirlink"
tree =
NAR.NarDirectory
[ ("alink", NAR.NarSymlink "zdir"),
("zdir", NAR.NarDirectory [("f", NAR.NarRegular False "x")])
]
Subst.clearStaleDestination dest
result <- unpackNarEntry tmpSensitivity dest tree
outcome <- case result of
Left _ -> pure Pass -- symlinks unavailable here; the loud failure is the contract
Right () -> do
throughLink <- doesDirectoryExist (dest </> "alink")
pure (if throughLink then Pass else Fail "dir symlink not traversable (wrong flavor)")
Subst.clearStaleDestination dest
pure outcome,
-- Folding sibling names MATERIALIZE on every platform: true names
-- via the NTFS per-directory flag on Windows and on any volume the
-- probe reports sensitive (Linux, case-sensitive APFS), upstream's
-- case-hack renaming on a folding volume. The platform serialiser
-- reverses whichever branch ran, so the tree re-serialises to its
-- original NAR either way.
runTestM "folding sibling names materialize and round-trip" $ do
tmpBase <- getTemporaryDirectory
let dest = tmpBase </> "nova-nix-test-unpack-fold"
tree =
NAR.NarDirectory
[ ("Foo", NAR.NarRegular False "upper"),
("foo", NAR.NarRegular False "lower")
]
Subst.clearStaleDestination dest
result <- unpackNarEntry tmpSensitivity dest tree
outcome <- case result of
Left err -> pure (Fail ("unpack failed: " <> err))
Right () -> do
onDisk <- NAR.serialiseFromPath dest
if onDisk /= tree
then pure (Fail "materialized tree does not re-serialise to its NAR")
else
if SI.os == "mingw32" || tmpSensitivity == CaseSensitive
then do
-- True names, not the hack: both spellings hold
-- distinct contents.
upper <- BS.readFile (dest </> "Foo")
lower <- BS.readFile (dest </> "foo")
pure (assertEqual "true names" ("upper", "lower") (upper, lower))
else do
-- The hack: the later variant carries the suffix.
lower <- BS.readFile (dest </> "foo~nix~case~hack~1")
pure (assertEqual "case-hacked name" "lower" lower)
Subst.clearStaleDestination dest
pure outcome,
-- Every unpack creates exclusively, its root included, as
-- upstream's restore does: a destination that already holds an
-- entry is refused with upstream's wording and left as it was,
-- not truncated or written into. Callers clear a stale
-- destination first. Any volume answers this, so it is the
-- exclusive create's check on every platform, Windows' CREATE_NEW
-- included.
runTestM "unpack refuses a destination that already exists" $ do
tmpBase <- getTemporaryDirectory
let dest = tmpBase </> "nova-nix-test-unpack-taken"
fileTree = NAR.NarRegular False "new"
dirTree = NAR.NarDirectory [("f", NAR.NarRegular False "new")]
fileRefusal = "creating file '" <> quotedAsCxx dest <> "': File exists"
dirOverFile = "creating directory '" <> T.pack dest <> "': File exists"
dirOverDir = "path '" <> T.pack dest <> "' already exists"
streamInto tree = do
let raw = NAR.serialise tree
source <- chunkReader [raw]
outcome <- Subst.consumeNarStream tmpSensitivity dest (streamTestNarInfo raw) (CHash.hashBytes raw) source
pure (either (Left . Subst.attemptFailureMessage) (const (Right ())) outcome)
strictAndStreamed tree = (,) <$> unpackNarEntry tmpSensitivity dest tree <*> streamInto tree
Subst.clearStaleDestination dest
BS.writeFile dest "old"
fileOnFile <- strictAndStreamed fileTree
dirOnFile <- strictAndStreamed dirTree
keptFile <- BS.readFile dest
Subst.clearStaleDestination dest
createDirectoryIfMissing True dest
dirOnDir <- strictAndStreamed dirTree
wroteInto <- Dir.doesPathExist (dest </> "f")
Subst.clearStaleDestination dest
let verdict
| keptFile /= "old" = Fail "the existing file was written over"
| wroteInto = Fail "the existing directory was written into"
| otherwise =
assertEqual
"refusals, strict and streamed (a file over a file, a directory over a file, a directory over a directory)"
((Left fileRefusal, Left fileRefusal), (Left dirOverFile, Left dirOverFile), (Left dirOverDir, Left dirOverDir))
(fileOnFile, dirOnFile, dirOnDir)
pure verdict,
-- std::quoted escapes a double quote and a backslash inside the
-- path, so a name holding both pins upstream's exact text. A
-- Windows name can hold neither.
runTestM "the file refusal quotes its path as std::quoted does" $ do
tmpBase <- getTemporaryDirectory
let plain = tmpBase </> "nova-nix-test-unpack-q"
dest = plain <> "\"b\\s"
expected = "creating file '\"" <> T.pack plain <> "\\\"b\\\\s\"': File exists"
tree = NAR.NarRegular False "new"
raw = NAR.serialise tree
if SI.os == "mingw32"
then Pass <$ putStrLn " SKIP a Windows name cannot hold a double quote"
else do
Subst.clearStaleDestination dest
BS.writeFile dest "old"
strict <- unpackNarEntry tmpSensitivity dest tree
source <- chunkReader [raw]
streamed <- Subst.consumeNarStream tmpSensitivity dest (streamTestNarInfo raw) (CHash.hashBytes raw) source
Subst.clearStaleDestination dest
pure (assertEqual "refusals (strict, streamed)" (Left expected, Left expected) (strict, either (Left . Subst.attemptFailureMessage) (const (Right ())) streamed)),
-- The exclusive create reaches as far as base's own open on
-- Windows, where a raw CreateFileW stops at MAX_PATH (260
-- characters) unless the path is spelled in the file namespace.
-- Every component here is short; only the whole path is long.
runTestM "unpack writes a file whose path is past MAX_PATH" $ do
tmpBase <- getTemporaryDirectory
let dest = tmpBase </> "nova-nix-test-unpack-long"
component = replicate 60 'd'
depth = 5 :: Int
nest inner = NAR.NarDirectory [(TE.encodeUtf8 (T.pack component), inner)]
tree = foldr (const nest) (NAR.NarDirectory [("leaf", NAR.NarRegular False "deep")]) [1 .. depth]
leafPath = foldl' (</>) dest (replicate depth component) </> "leaf"
raw = NAR.serialise tree
readLeaf = either (pure . Left) (const (Right <$> BS.readFile leafPath))
Subst.clearStaleDestination dest
strict <- unpackNarEntry tmpSensitivity dest tree >>= readLeaf
Subst.clearStaleDestination dest
source <- chunkReader [raw]
streamed <-
Subst.consumeNarStream tmpSensitivity dest (streamTestNarInfo raw) (CHash.hashBytes raw) source
>>= readLeaf . either (Left . Subst.attemptFailureMessage) (const (Right ()))
Subst.clearStaleDestination dest
pure $
if length leafPath <= 260
then Fail "the fixture path is not past MAX_PATH"
else assertEqual "leaf contents (strict, streamed)" (Right "deep", Right "deep") (strict, streamed),
-- The pure case-hack naming is a function of the probed
-- sensitivity, not of the platform: on a folding volume later
-- case variants gain the reversible suffix with a per-name
-- counter, on a sensitive one every name keeps its spelling.
runTest "caseHackDiskNames renames later case variants on a folding volume" $
assertEqual
"hack naming"
[("Foo", "Foo"), ("foo", "foo~nix~case~hack~1"), ("fOO", "fOO~nix~case~hack~2"), ("bar", "bar")]
(caseHackDiskNames CaseInsensitive ["Foo", "foo", "fOO", "bar"]),
runTest "caseHackDiskNames keeps every name on a sensitive volume" $
assertEqual
"identity naming"
[("Foo", "Foo"), ("foo", "foo"), ("fOO", "fOO"), ("bar", "bar")]
(caseHackDiskNames CaseSensitive ["Foo", "foo", "fOO", "bar"]),
-- The key behind both: case variants share it exactly on a
-- folding volume.
runTest "onDiskNameKey folds case only on a folding volume" $
if onDiskNameKey CaseSensitive "Makefile" /= onDiskNameKey CaseSensitive "makefile"
&& onDiskNameKey CaseInsensitive "Makefile" == onDiskNameKey CaseInsensitive "makefile"
then Pass
else Fail "the key does not follow the probed sensitivity",
-- A name with no UTF-8 reading has no characters to fold, so it
-- keys as its bytes even on a folding volume.
runTest "onDiskNameKey keys a name with no UTF-8 reading as its bytes" $
assertEqual
"keys of a Latin-1 and a UTF-8 spelling"
("caf\xE9", "CAF\xC3\x89")
(onDiskNameKey CaseInsensitive "caf\xE9", onDiskNameKey CaseInsensitive "caf\xC3\xA9"),
-- The probe against the filesystem's own answer: two sibling
-- names differing only by case are two entries on a sensitive
-- volume and one on a folding one.
runTestM "probeCaseSensitivity agrees with the filesystem" $ do
tmpBase <- getTemporaryDirectory
let dir = tmpBase </> "nova-nix-test-case-probe"
Subst.clearStaleDestination dir
createDirectoryIfMissing True dir
BS.writeFile (dir </> "Probe") "upper"
BS.writeFile (dir </> "probe") "lower"
entries <- Dir.listDirectory dir
probed <- probeCaseSensitivity dir
Subst.clearStaleDestination dir
let observed = if length entries == 2 then CaseSensitive else CaseInsensitive
pure (assertEqual "probe against the filesystem" observed probed),
-- Where the volume's serialiser strips the suffix (a folding
-- volume), an incoming name carrying it must reject (it could
-- not round-trip); on a volume that keeps names apart such a
-- name is legitimate and materializes verbatim.
runTestM "incoming case-hack suffix names reject where the serialiser strips" $ do
tmpBase <- getTemporaryDirectory
let dest = tmpBase </> "nova-nix-test-unpack-suffix"
tree = NAR.NarDirectory [("x~nix~case~hack~1", NAR.NarRegular False "v")]
Subst.clearStaleDestination dest
result <- unpackNarEntry tmpSensitivity dest tree
outcome <- case (tmpSensitivity, result) of
(CaseInsensitive, Left _) -> pure Pass
(CaseInsensitive, Right ()) -> pure (Fail "suffix-bearing name accepted where the serialiser strips")
(CaseSensitive, Right ()) -> do
kept <- BS.readFile (dest </> "x~nix~case~hack~1")
pure (assertEqual "verbatim where names stay apart" "v" kept)
(CaseSensitive, Left err) -> pure (Fail ("a volume keeping names apart rejected a legitimate name: " <> err))
Subst.clearStaleDestination dest
pure outcome,
-- The capability probe itself: NTFS grants the per-directory flag
-- (CI runners and the dev box run NTFS temp dirs); other
-- platforms report unsupported.
runTestM "trySetCaseSensitiveDir reflects platform support" $ do
tmpBase <- getTemporaryDirectory
let dir = tmpBase </> "nova-nix-test-csdir"
Subst.clearStaleDestination dir
createDirectoryIfMissing True dir
flagged <- trySetCaseSensitiveDir dir
Subst.clearStaleDestination dir
pure (assertEqual "flag support" (SI.os == "mingw32") flagged),
-- unpackAndVerify re-serialises the materialized tree and checks it
-- against the declared hash before returning a registration: a
-- faithful round-trip passes, and the registration carries the
-- declared hash.
runTestM "unpackAndVerify accepts a tree that reproduces its hash" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-unpack-verify"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let sp = StorePath (T.replicate 32 "b") "roundtrip"
tree =
NAR.NarDirectory
[ ("data.txt", NAR.NarRegular False "verified bytes"),
("sub", NAR.NarDirectory [("inner", NAR.NarRegular False "nested")])
]
rawNar = NAR.serialise tree
narHash = CHash.formatNixHash (CHash.hashBytes rawNar)
info =
NarInfo.NarInfo
{ NarInfo.niStorePath = storePathToText defaultStoreDir sp,
NarInfo.niUrl = "nar/roundtrip.nar",
NarInfo.niCompression = "none",
NarInfo.niFileHash = Nothing,
NarInfo.niFileSize = Nothing,
NarInfo.niNarHash = narHash,
NarInfo.niNarSize = fromIntegral (BS.length rawNar),
NarInfo.niReferences = [],
NarInfo.niDeriver = Nothing,
NarInfo.niSigs = [],
NarInfo.niCA = Nothing
}
result <- Subst.unpackAndVerify store sp info rawNar
onDisk <- BS.readFile (storePathToFilePath (stDir store) sp </> "data.txt")
-- A success carries the path lock still held; release it before
-- the store teardown (Windows cannot delete a file a handle
-- holds open).
case result of
Subst.SubstSuccess _ lock -> releasePathLock lock
_ -> pure ()
closeStore store
forceRemoveIfExists tmpStore
pure $ case result of
Subst.SubstSuccess reg _ ->
if prNarHash reg == narHash && onDisk == "verified bytes"
then Pass
else Fail "registration or on-disk bytes diverge from the declared hash"
other -> Fail ("unpackAndVerify failed: " <> T.pack (show other)),
-- The verify-fails branch of the strict pipeline: bytes that do
-- not match the narinfo's signed NarHash or NarSize never reach
-- the unpack sink, so nothing is written at the store path and
-- the lock is free afterwards.
runTestM "unpackAndVerify writes nothing for a NAR that fails verification" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-unpack-unverified"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let sp = StorePath (T.replicate 32 "f") "unverified"
rawNar = NAR.serialise (NAR.NarDirectory [("data.txt", NAR.NarRegular False "untrusted bytes")])
consistent =
NarInfo.NarInfo
{ NarInfo.niStorePath = storePathToText defaultStoreDir sp,
NarInfo.niUrl = "nar/unverified.nar",
NarInfo.niCompression = "none",
NarInfo.niFileHash = Nothing,
NarInfo.niFileSize = Nothing,
NarInfo.niNarHash = CHash.formatNixHash (CHash.hashBytes rawNar),
NarInfo.niNarSize = toInteger (BS.length rawNar),
NarInfo.niReferences = [],
NarInfo.niDeriver = Nothing,
NarInfo.niSigs = [],
NarInfo.niCA = Nothing
}
wrongHash = consistent {NarInfo.niNarHash = CHash.formatNixHash (CHash.hashBytes "not the nar")}
wrongSize = consistent {NarInfo.niNarSize = toInteger (BS.length rawNar) + 1}
destPath = storePathToFilePath (stDir store) sp
hashResult <- Subst.unpackAndVerify store sp wrongHash rawNar
sizeResult <- Subst.unpackAndVerify store sp wrongSize rawNar
written <- Dir.doesPathExist destPath
reLock <- tryAcquirePathLock (StoreDir tmpStore) sp
mapM_ releasePathLock reLock
closeStore store
forceRemoveIfExists tmpStore
pure $ case (hashResult, sizeResult, reLock) of
(Subst.SubstError hashErr, Subst.SubstError sizeErr, Just _)
| written -> Fail "an unverified NAR reached the store path"
| not ("NAR hash mismatch" `T.isInfixOf` hashErr) -> Fail ("wrong hash error: " <> hashErr)
| not ("NAR size mismatch" `T.isInfixOf` sizeErr) -> Fail ("wrong size error: " <> sizeErr)
| otherwise -> Pass
(_, _, Nothing) -> Fail "lock still held after a refused NAR"
other -> Fail ("expected two SubstError results, got: " <> T.pack (show other))
]
where
chainCache url = Subst.CacheConfig url ["unused-key"] 10
-- A tree unpacked into a fresh destination through the strict and
-- the streaming path, each read back from disk, or the unpack's
-- refusal. The read-back tree carries every name and link target
-- as the bytes on disk, so equal trees serialise to the same NAR.
unpackedBothWays sensitivity dest tree = do
let raw = NAR.serialise tree
streamed = do
source <- chunkReader [raw]
outcome <- Subst.consumeNarStream sensitivity dest (streamTestNarInfo raw) (CHash.hashBytes raw) source
pure (either (Left . Subst.attemptFailureMessage) (const (Right ())) outcome)
readBack unpack = do
Subst.clearStaleDestination dest
result <- unpack
onDisk <- either (pure . Left) (const (Right <$> NAR.serialiseFromPath dest)) result
Subst.clearStaleDestination dest
pure onDisk
strict <- readBack (unpackNarEntry sensitivity dest tree)
viaStream <- readBack streamed
pure (strict, viaStream)
-- A real held lock for tests that construct 'SubstSuccess' by hand:
-- the constructor carries the path's lock, so a fabricated success
-- needs a genuine one, taken in a scratch directory.
withChainLock dirName act = do
tmpBase <- getTemporaryDirectory
let lockRoot = tmpBase </> (dirName :: FilePath)
forceRemoveIfExists lockRoot
createDirectoryIfMissing True lockRoot
lock <- acquirePathLock (StoreDir lockRoot) (StorePath (T.replicate 32 "d") "hit")
result <- act lock
releasePathLock lock
forceRemoveIfExists lockRoot
pure result
sampleNarBytes = "nova-nix nar sample bytes" :: BS.ByteString
sampleNarHash = CHash.formatNixHash (CHash.hashBytes sampleNarBytes)
wrongNarHash = CHash.formatNixHash (CHash.hashBytes ("different bytes" :: BS.ByteString))
sampleHash = T.replicate 32 "a"
sampleNarInfo narHash =
NarInfo.NarInfo
{ NarInfo.niStorePath = "/nix/store/" <> sampleHash <> "-hello",
NarInfo.niUrl = "nar/sample.nar",
NarInfo.niCompression = "none",
NarInfo.niFileHash = Just sampleNarHash,
NarInfo.niFileSize = Just 0,
NarInfo.niNarHash = narHash,
NarInfo.niNarSize = fromIntegral (BS.length sampleNarBytes),
NarInfo.niReferences = [],
NarInfo.niDeriver = Nothing,
NarInfo.niSigs = [],
NarInfo.niCA = Nothing
}
-- A real xz stream: "nova-nix xz fixture payload\n" 64 times
-- (1792 bytes) compressed with xz -9 to 112 bytes, embedded as
-- base64 so the test source stays ASCII.
xzFixturePayload = BS.concat (replicate 64 "nova-nix xz fixture payload\n")
xzFixtureSize = toInteger (BS.length xzFixturePayload)
xzFixtureB64 =
"/Td6WFoAAATm1rRGAgAhARwAAAAQz1jM4Ab/AC1dADcbyzKSinKbUBue2bMHcUt1zJQMzAec5W6XwPbK3dKJtL3q9K3rfg1KQ/ZOAAAAAAAWUPRD8XwohgABSYAOAAAA2Eg7urHEZ/sCAAAAAARZWg==" :: Text
-- cache.nixos.org narinfos recorded 2026-08-20 (nixos-25.05
-- channel), verbatim: GNU hello (references including itself,
-- deriver, production signature) and a doc output whose References
-- line is empty.
recordedHelloNarInfo =
T.unlines
[ "StorePath: /nix/store/jppkr0h8aap5z7m4xy4vg5yrwlly9h2v-hello-2.12.1",
"URL: nar/1m1sbal63vqhlvbcxzdj8yr6fhhld7dsyhxbxwip54dgvg56rjnc.nar.xz",
"Compression: xz",
"FileHash: sha256:1m1sbal63vqhlvbcxzdj8yr6fhhld7dsyhxbxwip54dgvg56rjnc",
"FileSize: 52056",
"NarHash: sha256:0s8wi24d3bc4zxyxq3hffj102zi7cjp3wqnpj6nhqrwgjsgqff81",
"NarSize: 249480",
"References: dska0s3gxxd8azbsn85pwm6xcqhivldw-glibc-2.40-66 jppkr0h8aap5z7m4xy4vg5yrwlly9h2v-hello-2.12.1",
"Deriver: a9y211d3lq3yf2mpfvb72f0qvsl0wi3s-hello-2.12.1.drv",
"Sig: cache.nixos.org-1:xV9xUvtPGHTSo6eeFWYYhaNFiH8MYSXKZzmxe0cf+acdDkIYxFPLC/MNc1CjlbsVoaUwGhcigUdr9eW2+W1UAw=="
]
recordedHelloDocNarInfo =
T.unlines
[ "StorePath: /nix/store/4xrqj3kcd89bsg5crbpnx1ppg7nxw9xp-hello-1.0.0.2-doc",
"URL: nar/1r86zzj3g8jhzyvi17vchsj3frrqk5l329viq2i24iish53x922l.nar.xz",
"Compression: xz",
"FileHash: sha256:1r86zzj3g8jhzyvi17vchsj3frrqk5l329viq2i24iish53x922l",
"FileSize: 892",
"NarHash: sha256:0amizmj17fgj5sz1gvr743kncrzwvq747lml3zhd374f14hzgd7a",
"NarSize: 2072",
"References: ",
"Deriver: 5knzybx32a3iq53jjw6xd6fn4awn2l3h-hello-1.0.0.2.drv",
"Sig: cache.nixos.org-1:jUFHex7R7zPonZZqjVy/OOTguUZZE/sityC0zvu3sb35Az8zBTROeFhUC/J/UFx8Ui8UflA7uHyLJm5Z+Ca6Bw=="
]
-- A NAR with the shapes streaming unpack must materialize:
-- nesting, an executable, a symlink, a zero-byte file, an empty
-- directory, and a sibling pair that collides on folding
-- filesystems. Entries in NAR name order.
-- Both survive a round trip through disk on every platform. The
-- executable bit does on Windows because the store keeps it in an
-- alternate data stream (#35); the nested symlink target does because
-- nova-cache 0.11.1.1 normalises a Windows reparse point's separators
-- back to the POSIX spelling at the NAR boundary (#112).
streamTestLinkTarget = "bin/tool"
streamTestNar =
NAR.serialise
( NAR.NarDirectory
[ ("Makefile", NAR.NarRegular False "all:\n"),
("bin", NAR.NarDirectory [("tool", NAR.NarRegular True "#!/bin/sh\n")]),
("empty", NAR.NarRegular False ""),
("emptydir", NAR.NarDirectory []),
("link", NAR.NarSymlink streamTestLinkTarget),
("makefile", NAR.NarRegular False "lower\n")
]
)
streamTestDigest = CHash.hashBytes streamTestNar
streamTestNarInfo rawNar =
NarInfo.NarInfo
{ NarInfo.niStorePath = "/nix/store/" <> sampleHash <> "-stream",
NarInfo.niUrl = "nar/stream.nar",
NarInfo.niCompression = "none",
NarInfo.niFileHash = Nothing,
NarInfo.niFileSize = Nothing,
NarInfo.niNarHash = CHash.formatNixHash (CHash.hashBytes rawNar),
NarInfo.niNarSize = fromIntegral (BS.length rawNar),
NarInfo.niReferences = [],
NarInfo.niDeriver = Nothing,
NarInfo.niSigs = [],
NarInfo.niCA = Nothing
}
streamChunks chunkLen bytes
| BS.null bytes = []
| otherwise = BS.take chunkLen bytes : streamChunks chunkLen (BS.drop chunkLen bytes)
-- The xz fixture's payload, compressed by nova-cache:zstandard's
-- own encoder - the exact pairing the push path ships.
zstdFixtureCompressed = CZstd.compress CZstd.defaultCompressionLevel xzFixturePayload
-- The same payload compressed by the bzip2 CLI (bzip2 -9),
-- embedded base64 so the test source stays ASCII. The reference
-- encoder is deliberately the format's own tool and not the
-- decoder's library: nova-cache:bzip2 decodes only, so a
-- self-produced fixture could not catch the two disagreeing.
bzip2FixtureB64 =
"QlpoOTFBWSZTWTop7coAAf/RgAAQQAInJddwIACQKZMTIMjAqqBkDaJtTgCQKgZA5AyBAFwNwMAeAYAgCQLgXA+AoBUCQIAkCAJAUAgCgH4u5IpwoSB0U9uU" :: Text
-- A NAR every platform materializes identically (no executable
-- bit, no separator-bearing symlink target), and the bzip2 CLI's
-- compression of exactly these bytes.
bzip2NarFixture =
NAR.serialise
(NAR.NarDirectory [("greeting", NAR.NarRegular False "nova-nix bzip2 fixture\n")])
bzip2NarFixtureB64 =
"QlpoOTFBWSZTWa3VDM4AAFJ5gG7yAIBAYjAAP+ffcCAAlIaTJM1PUnqD1DJpoHo01BkkA9I0AAAAtARwcfWQAq1WLMjpmBpVKUAJM6EA8IDQEABOzcRgdDpvigJ6ZZa760fpxZtj+ts6GDiuqt/B6UuthWIrabWmZTkFlI46C8MmbMoVmMYwEYRUCYQW/F3JFOFCQrdUMzg=" :: Text
-- ---------------------------------------------------------------------------
-- Tests: per-store-path locks (the substitution race)
-- ---------------------------------------------------------------------------
-- | Watchdog for the concurrent-substitution race: generous, because a
-- lock-protocol regression shows up as a hang, never as a fast wrong
-- answer.
raceWatchdogMicros :: Int
raceWatchdogMicros = 30 * 1000000
-- | How long a delete gets to (wrongly) finish while the path lock is
-- held elsewhere: long enough that an unlocked delete of one tiny tree
-- always completes inside it, while a correctly blocked delete waits
-- until the release that follows the probe.
deleteLockProbeMicros :: Int
deleteLockProbeMicros = 500 * 1000
-- | The executable bit's own representation, independent of any store.
--
-- Every assertion here is platform-agnostic on purpose: the module's whole
-- point is that a caller asks 'ExecBit' rather than the filesystem, so the
-- same questions must have the same answers on Windows and on Unix even
-- though the bit is kept in different places.
testExecBit :: IO [Bool]
testExecBit = do
putStrLn "store/exec-bit"
sequence
[ -- The round-trip the representation exists for: what was marked
-- reads back marked, and an unmarked sibling stays unmarked.
runTestM "exec mark round-trips through isExecutable" $ do
dir <- freshExecBitDir "roundtrip"
let marked = dir </> "tool"
plain = dir </> "data"
BS.writeFile marked "#!x"
BS.writeFile plain "hello"
ExecBit.markExecutable marked
isMarked <- ExecBit.isExecutable marked
isPlain <- ExecBit.isExecutable plain
forceRemoveIfExists dir
pure $ case (isMarked, isPlain) of
(True, False) -> Pass
(False, _) -> Fail "a marked file did not read back executable"
(_, True) -> Fail "an unmarked file read back executable",
-- copyExecMark out of a sealed store path. setReadOnly is what
-- placeInStore does, and on Windows copyFile propagates that
-- attribute to the copy, where a mark cannot be written until it is
-- cleared again. The source must also survive read-only.
runTestM "exec mark survives a copy out of a read-only source" $ do
dir <- freshExecBitDir "copy"
let src = dir </> "tool"
dest = dir </> "tool-copy"
BS.writeFile src "#!x"
ExecBit.markExecutable src
setReadOnly src
Dir.copyFile src dest
ExecBit.copyExecMark src dest
copied <- ExecBit.isExecutable dest
srcStillExec <- ExecBit.isExecutable src
-- Unseal before cleanup: a read-only file resists removal on
-- Windows the same way it resists a stream write.
Dir.getPermissions src >>= Dir.setPermissions src . Dir.setOwnerWritable True
forceRemoveIfExists dir
pure $ case (copied, srcStillExec) of
(True, True) -> Pass
(False, _) -> Fail "the copy lost its exec mark"
(_, False) -> Fail "sealing the source dropped its exec mark",
-- The serialiser reads the mark, not the file's permissions: this is
-- the flag a NAR carries, and on Windows getPermissions would answer
-- from the extension instead.
runTestM "serialiseFromPath reports the marked flag" $ do
dir <- freshExecBitDir "serialise"
let marked = dir </> "tool"
BS.writeFile marked "#!x"
BS.writeFile (dir </> "data") "hello"
ExecBit.markExecutable marked
entry <- ExecBit.serialiseFromPath processCaseHack dir
forceRemoveIfExists dir
pure $ case entry of
NAR.NarDirectory entries ->
assertEqual
"flags of (data, tool)"
[("data", False), ("tool", True)]
[(n, e) | (n, NAR.NarRegular e _) <- entries]
other -> Fail ("expected a directory entry, got: " <> T.pack (show other)),
-- The sink and the verifier must read one source of truth. A
-- substituted tree is written through markExecutable and its hash
-- rechecked on disk, so if narHashOfPath consulted the filesystem's
-- own idea of executability instead, every path holding a marked
-- file would be downloaded, rejected and deleted.
runTestM "narHashOfPath agrees with the serialiser it verifies" $ do
dir <- freshExecBitDir "hash"
let marked = dir </> "tool"
BS.writeFile marked "#!x"
BS.writeFile (dir </> "data") "hello"
ExecBit.markExecutable marked
streamed <- ExecBit.narHashOfPath processCaseHack dir
fromEntry <- NAR.narHash <$> ExecBit.serialiseFromPath processCaseHack dir
-- A control on the same axis: an unmarked tree must hash
-- differently, or agreement above would prove nothing.
unmarkedDir <- freshExecBitDir "hash-plain"
BS.writeFile (unmarkedDir </> "tool") "#!x"
BS.writeFile (unmarkedDir </> "data") "hello"
unmarked <- ExecBit.narHashOfPath processCaseHack unmarkedDir
forceRemoveIfExists dir
forceRemoveIfExists unmarkedDir
pure $
if streamed /= fromEntry
then Fail "the verifier's hash disagrees with the serialiser's"
else
if streamed == unmarked
then Fail "the exec mark did not reach the hash at all"
else Pass,
-- correct/ recurses by name, and a non-ASCII name must survive that
-- recursion: decoding it a byte at a time names a file that is not
-- there and the mark silently reads as absent.
runTestM "a non-ASCII directory name keeps its child's mark" $ do
dir <- freshExecBitDir "utf8"
let sub = dir </> "\955-dir"
marked = sub </> "\955-tool"
createDirectoryIfMissing True sub
BS.writeFile marked "#!x"
ExecBit.markExecutable marked
entry <- ExecBit.serialiseFromPath processCaseHack dir
forceRemoveIfExists dir
pure $ case entry of
NAR.NarDirectory [(_, NAR.NarDirectory [(_, NAR.NarRegular True _)])] -> Pass
other -> Fail ("expected one marked child, got: " <> T.pack (show other))
]
-- | An empty scratch directory for one 'testExecBit' case.
freshExecBitDir :: String -> IO FilePath
freshExecBitDir name = do
tmpBase <- getTemporaryDirectory
let dir = tmpBase </> ("nova-nix-test-execbit-" ++ name)
forceRemoveIfExists dir
createDirectoryIfMissing True dir
pure dir
testPathLocks :: IO [Bool]
testPathLocks = do
putStrLn "store/path-locks"
sequence
[ -- Two independent handles on one path lock exclude each other -
-- the guarantee flock and LockFileEx share, and exactly the shape
-- of two processes contending for one store path.
runTestM "path lock excludes a second handle" $ do
tmpBase <- getTemporaryDirectory
let lockRoot = tmpBase </> "nova-nix-test-lock-excl"
forceRemoveIfExists lockRoot
createDirectoryIfMissing True lockRoot
let dir = StoreDir lockRoot
sp = StorePath (T.replicate 32 "a") "lockee"
held <- acquirePathLock dir sp
second <- tryAcquirePathLock dir sp
releasePathLock held
third <- tryAcquirePathLock dir sp
mapM_ releasePathLock second
mapM_ releasePathLock third
forceRemoveIfExists lockRoot
pure $ case (second, third) of
(Nothing, Just _) -> Pass
(Just _, _) -> Fail "a second handle acquired a held lock"
(Nothing, Nothing) -> Fail "release did not free the lock",
-- The already-valid short-circuit: a registered path substitutes
-- as SubstAlreadyValid with no network and no disk writes - the
-- configured cache is unreachable, so any contact would surface
-- as an error result.
runTestM "trySubstitute adopts an already-valid path untouched" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-lock-valid"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let sp = StorePath (T.replicate 32 "c") "validpath"
destPath = storePathToFilePath (StoreDir tmpStore) sp
createDirectoryIfMissing True destPath
BS.writeFile (destPath </> "payload") "registered bytes"
reg <- registrationFor store sp Nothing []
registerPath (stDB store) reg
result <- Subst.trySubstitute store [unreachableCache] sp
survivor <- BS.readFile (destPath </> "payload")
-- The short-circuit released the lock, so the path must be
-- lockable again at once.
reLock <- tryAcquirePathLock (StoreDir tmpStore) sp
mapM_ releasePathLock reLock
closeStore store
forceRemoveIfExists tmpStore
pure $ case (result, reLock) of
(Subst.SubstAlreadyValid, Just _)
| survivor == "registered bytes" -> Pass
| otherwise -> Fail "tree touched during already-valid adoption"
(Subst.SubstAlreadyValid, Nothing) -> Fail "lock still held after already-valid return"
(other, _) -> Fail ("expected SubstAlreadyValid, got: " <> T.pack (show other)),
-- The strict pipeline honors the same short-circuit: fed a
-- DIFFERENT (self-consistent) NAR for an already-valid path, it
-- must adopt the registered tree rather than overwrite it.
runTestM "unpackAndVerify adopts an already-valid path untouched" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-lock-valid-strict"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let sp = StorePath (T.replicate 32 "d") "strictvalid"
destPath = storePathToFilePath (StoreDir tmpStore) sp
createDirectoryIfMissing True destPath
BS.writeFile (destPath </> "payload") "registered bytes"
reg <- registrationFor store sp Nothing []
registerPath (stDB store) reg
let differentNar = NAR.serialise (NAR.NarDirectory [("other", NAR.NarRegular False "different bytes")])
result <- Subst.unpackAndVerify store sp (lockTestNarInfo sp differentNar) differentNar
survivor <- BS.readFile (destPath </> "payload")
closeStore store
forceRemoveIfExists tmpStore
pure $ case result of
Subst.SubstAlreadyValid
| survivor == "registered bytes" -> Pass
| otherwise -> Fail "tree touched during already-valid adoption"
other -> Fail ("expected SubstAlreadyValid, got: " <> T.pack (show other)),
-- The race the locks exist for: two concurrent substitutions of
-- one path, independent lock handles. Exactly one materializes;
-- the other waits at the lock and adopts the winner's registered
-- path; the surviving tree is intact and registered once.
runTestM "concurrent substitutions: one materializes, one adopts" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-lock-race"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let sp = StorePath (T.replicate 32 "e") "racepath"
destPath = storePathToFilePath (StoreDir tmpStore) sp
rawNar = NAR.serialise (NAR.NarDirectory [("data", NAR.NarRegular False "race payload")])
-- The caller's contract per attempt: register under the
-- still-held lock, then release it.
attempt = do
result <- Subst.unpackAndVerify store sp (lockTestNarInfo sp rawNar) rawNar
case result of
Subst.SubstSuccess winnerReg lock -> do
registerPath (stDB store) winnerReg
releasePathLock lock
_ -> pure ()
pure result
firstDone <- newEmptyMVar
secondDone <- newEmptyMVar
_ <- forkIO ((try attempt :: IO (Either SomeException Subst.SubstResult)) >>= putMVar firstDone)
_ <- forkIO ((try attempt :: IO (Either SomeException Subst.SubstResult)) >>= putMVar secondDone)
outcomeA <- timeout raceWatchdogMicros (takeMVar firstDone)
outcomeB <- timeout raceWatchdogMicros (takeMVar secondDone)
rowCount <- length <$> queryAllValidPaths (stDB store)
onDisk <- NAR.serialiseFromPath destPath
closeStore store
forceRemoveIfExists tmpStore
pure $ case (outcomeA, outcomeB) of
(Just (Right resultA), Just (Right resultB)) ->
let outcomes = [resultA, resultB]
materialized = length [() | Subst.SubstSuccess _ _ <- outcomes]
adopted = length [() | Subst.SubstAlreadyValid <- outcomes]
in if materialized == 1 && adopted == 1 && rowCount == 1 && NAR.serialise onDisk == rawNar
then Pass
else
Fail
( "unexpected race outcome: "
<> T.pack (show outcomes)
<> ", registered rows: "
<> T.pack (show rowCount)
)
other -> Fail ("a race attempt hung or threw: " <> T.pack (show other))
]
where
-- Never contacted when the already-valid short-circuit holds; a
-- regression that reaches for the network fails loudly here.
unreachableCache = Subst.CacheConfig "http://127.0.0.1:9" ["unused-key"] 10
lockTestNarInfo sp rawNar =
NarInfo.NarInfo
{ NarInfo.niStorePath = storePathToText defaultStoreDir sp,
NarInfo.niUrl = "nar/lock-test.nar",
NarInfo.niCompression = "none",
NarInfo.niFileHash = Nothing,
NarInfo.niFileSize = Nothing,
NarInfo.niNarHash = CHash.formatNixHash (CHash.hashBytes rawNar),
NarInfo.niNarSize = fromIntegral (BS.length rawNar),
NarInfo.niReferences = [],
NarInfo.niDeriver = Nothing,
NarInfo.niSigs = [],
NarInfo.niCA = Nothing
}
-- ---------------------------------------------------------------------------
-- Tests: Build orchestrator (Phase 3, Batch 7)
-- ---------------------------------------------------------------------------
testBuildOrchestrator :: IO [Bool]
testBuildOrchestrator = do
putStrLn "build/orchestrator"
sequence
[ -- BuildConfig has caches field
runTest "defaultBuildConfig has empty caches" $
assertEqual "empty-caches" [] (bcCaches (defaultBuildConfig defaultStoreDir)),
-- Upstream's shape is a product token with the version; the comment
-- after it is ours. What bot mitigation keys on is that there is one.
runTest "the User-Agent is a nova-nix product token with a version" $
assertEqual "ua" True ("nova-nix/" `BS.isPrefixOf` userAgent && BS.length userAgent > BS.length "nova-nix/ (+https://github.com/Novavero-AI/nova-nix)"),
runTestM "withUserAgent sets exactly one User-Agent, replacing any present" $ do
request0 <- HTTP.parseRequest "http://127.0.0.1/narinfo-hashes"
let stale = request0 {HTTP.requestHeaders = [("User-Agent", "curl/0"), ("Accept", "*/*")]}
pure (assertEqual "headers" [("User-Agent", userAgent), ("Accept", "*/*")] (HTTP.requestHeaders (withUserAgent stale))),
-- The build PATH must never open with the build working directory:
-- a bare-name builder has no directory to derive.
runTest "bare-name builder derives no PATH entry" $
let entries = T.splitOn (if SI.os == "mingw32" then ";" else ":") (buildPath "bash")
in assertEqual "no-dot" False (any (\e -> e == "." || T.isPrefixOf "./" e || T.isPrefixOf ".\\" e) entries),
runTest "dot-relative builder derives no PATH entry" $
let entries = T.splitOn (if SI.os == "mingw32" then ";" else ":") (buildPath "./bash")
in assertEqual "no-dot-rel" False (any (\e -> e == "." || T.isPrefixOf "./" e || T.isPrefixOf ".\\" e) entries),
runTest "absolute builder opens PATH with its own directory" $
let path = buildPath ("/store/aaa-bootstrap/bin" </> "bash")
in assertEqual "builder-dir-first" (Just "/store/aaa-bootstrap/bin") (listToMaybe (T.splitOn (if SI.os == "mingw32" then ";" else ":") path)),
-- unionEnvs: earlier maps win; on Windows displacement is
-- case-insensitive and keeps the winner's spelling.
runTest "unionEnvs left map wins" $
assertEqual
"left-bias"
(Just "build")
(Map.lookup "A" (unionEnvs [Map.fromList [("A", "build")], Map.fromList [("A", "host")]])),
runTest "unionEnvs displaces a case variant on Windows" $
let merged = unionEnvs [Map.fromList [("PATH", "build")], Map.fromList [("Path", "host")]]
in if SI.os == "mingw32"
then assertEqual "displaced" (Map.fromList [("PATH", "build")]) merged
else assertEqual "distinct" (Map.fromList [("PATH", "build"), ("Path", "host")]) merged,
-- scrubAmbient: nothing ambient survives on Unix; on Windows only
-- the allowlist passes (keeping its ambient spelling), COMSPEC is
-- synthesized from SystemRoot, and PATHEXT is pinned.
runTest "scrubAmbient drops undeclared ambient variables" $
let ambient =
Map.fromList
[ ("SystemRoot", "C:\\WINDOWS"),
("APPDATA", "C:\\Users\\host\\AppData\\Roaming"),
("LANG", "en_US.UTF-8"),
("Path", "C:\\host\\bin")
]
scrubbed = scrubAmbient ambient
in if SI.os == "mingw32"
then
assertEqual
"allowlist-only"
( Map.fromList
[ ("SystemRoot", "C:\\WINDOWS"),
("COMSPEC", "C:\\WINDOWS\\System32\\cmd.exe"),
("PATHEXT", ".COM;.EXE;.BAT;.CMD")
]
)
scrubbed
else assertEqual "empty" Map.empty scrubbed,
runTest "scrubAmbient pins PATHEXT even without SystemRoot" $
let scrubbed = scrubAmbient Map.empty
in if SI.os == "mingw32"
then assertEqual "pinned" (Map.fromList [("PATHEXT", ".COM;.EXE;.BAT;.CMD")]) scrubbed
else assertEqual "empty" Map.empty scrubbed,
-- Build-time placeholder substitution. Upstream rewrites the whole
-- @name=value@ string (local-derivation-goal.cc:2004), so a sentinel in
-- a dynamic attribute name is substituted along with the values.
runTest "rewritePlaceholders substitutes an output sentinel" $
assertEqual
"substituted"
"/store/aaa-p/lib"
(rewritePlaceholders [("out", "/store/aaa-p")] (hashPlaceholder "out" <> "/lib")),
runTest "rewritePlaceholders leaves a foreign output's sentinel alone" $
assertEqual
"untouched"
(hashPlaceholder "dev")
(rewritePlaceholders [("out", "/store/aaa-p")] (hashPlaceholder "dev")),
runTest "rewriteEnv rewrites names as well as values" $
let rewrite = rewritePlaceholders [("out", "/store/aaa-p")]
env = Map.fromList [(hashPlaceholder "out" <> "-flag", hashPlaceholder "out" <> "/lib")]
in assertEqual
"name-and-value"
(Map.fromList [("/store/aaa-p-flag", "/store/aaa-p/lib")])
(rewriteEnv rewrite env),
-- BuildConfig with caches
runTest "BuildConfig accepts caches" $
let cache = Subst.CacheConfig "https://cache.example.com" ["key"] 10
config = (defaultBuildConfig defaultStoreDir) {bcCaches = [cache]}
in assertEqual "one-cache" 1 (length (bcCaches config)),
-- buildWithDeps on a simple derivation (no deps, builder fails but graph resolves)
runTestM "buildWithDeps single drv" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-orch"
createDirectoryIfMissing True tmpStore
store <- openStore (StoreDir tmpStore)
let drv =
Derivation
{ drvOutputs =
[ DerivationOutput
{ doName = "out",
doPath = StorePath "zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz" "test-out",
doHashAlgo = "",
doHash = ""
}
],
drvInputDrvs = Map.empty,
drvInputSrcs = [],
drvPlatform = currentPlatform,
drvBuilder = "/nonexistent-builder",
drvArgs = [],
drvEnv = Map.singleton "name" "test"
}
drvSP = StorePath "yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy" "test.drv"
-- Write .drv to store so buildWithDeps can read it
writeDrv store drv drvSP
let config = (defaultBuildConfig (StoreDir tmpStore)) {bcTmpDir = tmpBase </> "nova-nix-test-orch-tmp"}
result <- buildWithDeps config store drv drvSP
closeStore store
forceRemoveIfExists tmpStore
forceRemoveIfExists (bcTmpDir config)
-- Builder will fail (nonexistent) but the graph should resolve
-- correctly: the failure must come from SPAWNING THE BUILDER, not
-- from graph resolution or drv reading upstream of it.
pure $ case result of
BuildFailure msg _
| "nonexistent-builder" `T.isInfixOf` msg -> Pass
| otherwise -> Fail ("failed before reaching the builder: " <> msg)
BuildSuccess _ -> Fail "expected build failure for nonexistent builder",
-- buildWithDeps with cycle detection (mocked through malformed graph)
runTest "cycle detection returns failure" $
let spA = StorePath "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "a.drv"
spB = StorePath "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" "b.drv"
drvACyc =
Derivation
{ drvOutputs = [],
drvInputDrvs = Map.singleton spB ["out"],
drvInputSrcs = [],
drvPlatform = X86_64_Linux,
drvBuilder = "/bin/sh",
drvArgs = [],
drvEnv = Map.empty
}
drvBCyc =
Derivation
{ drvOutputs = [],
drvInputDrvs = Map.singleton spA ["out"],
drvInputSrcs = [],
drvPlatform = X86_64_Linux,
drvBuilder = "/bin/sh",
drvArgs = [],
drvEnv = Map.empty
}
readFn sp
| sp == spB = Right drvBCyc
| sp == spA = Right drvACyc
| otherwise = Left "unknown"
in case pureDepGraph readFn drvACyc spA of
Right graph -> case DepGraph.topoSort graph of
DepGraph.TopoCycle _ -> Pass
DepGraph.TopoSorted order -> Fail ("expected cycle, got sorted: " <> T.pack (show order))
Left err -> Fail ("expected graph to build, got: " <> err),
-- missing .drv causes failure in dep graph
runTest "missing drv in dep graph" $
let sp = StorePath "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "missing.drv"
drv =
Derivation
{ drvOutputs = [],
drvInputDrvs = Map.singleton sp ["out"],
drvInputSrcs = [],
drvPlatform = X86_64_Linux,
drvBuilder = "/bin/sh",
drvArgs = [],
drvEnv = Map.empty
}
readFn _ = Left "not found"
in case pureDepGraph readFn drv (StorePath "rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr" "root.drv") of
Left _ -> Pass
Right _ -> Fail "expected failure for missing .drv",
-- derivation with context creates populated inputDrvs. Hashing a
-- dependent derivation reads input modulo hashes from the drv-hash
-- cache, which only the IO evaluator maintains, so this runs under
-- evalNixIO (an in-session dependency hits the cache bottom-up).
runTestM "derivation context populates inputDrvs" $ do
tmpBase <- getTemporaryDirectory
result <-
evalDerivationIO tmpBase $
T.concat
[ "let dep = derivation { name = \"dep\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }; ",
"main = derivation { name = \"main\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; src = dep.outPath; }; ",
"in main"
]
pure $ assertRight "drv-ctx-inputs" result $ \drv ->
if Map.null (drvInputDrvs drv)
then Fail "expected non-empty drvInputDrvs"
else Pass,
-- drv3: a dependent derivation's drvPath is stable across evaluations
-- (the input modulo substitution is deterministic).
runTestM "dependent derivation drvPath is deterministic (IO eval)" $ do
tmpBase <- getTemporaryDirectory
let expr =
T.concat
[ "let dep = derivation { name = \"dep\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }; ",
"main = derivation { name = \"main\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; src = dep.outPath; }; ",
"in main.drvPath"
]
r1 <- evalNixIO tmpBase expr
r2 <- evalNixIO tmpBase expr
pure $ case (r1, r2) of
(Right (VStr a _), Right (VStr b _))
| a == b -> Pass
| otherwise -> Fail ("drvPath not deterministic: " <> bytesText a <> " vs " <> bytesText b)
_ -> Fail "expected main.drvPath to evaluate to a string under IO eval",
-- drv1: embedding another derivation's drvPath (an all-outputs ref) adds
-- it to inputDrvs carrying the referenced derivation's FULL
-- output-name set; the IO evaluator recovers the names in-session.
runTestM "derivation embedding a drvPath lists all its outputs in inputDrvs (IO eval)" $ do
tmpBase <- getTemporaryDirectory
let depSrc = "derivation { name = \"dep\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; outputs = [ \"out\" \"dev\" ]; }"
depPathR <- evalNixIO tmpBase ("(" <> depSrc <> ").drvPath")
result <-
evalDerivationIO tmpBase $
T.concat
[ "let dep = ",
depSrc,
"; main = derivation { name = \"main\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; ref = dep.drvPath; }; ",
"in main"
]
pure $ case (depPathR, result) of
(Right (VStr depPathBytes _), Right drv) ->
case parseStorePath defaultStoreDir (bytesText depPathBytes) of
Nothing -> Fail ("unparseable dep drvPath: " <> bytesText depPathBytes)
Just depSP -> case Map.lookup depSP (drvInputDrvs drv) of
Just outs
| Set.fromList outs == Set.fromList ["dev", "out"] -> Pass
| otherwise -> Fail ("expected the full output set [dev, out], got " <> T.pack (show outs))
Nothing -> Fail "dep .drv missing from inputDrvs despite the deep drvPath ref"
other -> Fail ("expected dep drvPath and main's derivation, got " <> T.pack (show other))
]
-- ---------------------------------------------------------------------------
-- Tests: Store.DB (Phase 2, Batch 1)
-- ---------------------------------------------------------------------------
-- | Helper: run a test with a temporary store DB, cleaning up after.
withTempStoreDB :: (StoreDir -> IO [Bool]) -> IO [Bool]
withTempStoreDB action = do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-store-db"
removeIfExists tmpStore
createDirectoryIfMissing True tmpStore
results <- action (StoreDir tmpStore)
removeIfExists tmpStore
pure results
removeIfExists :: FilePath -> IO ()
removeIfExists path = do
exists <- doesDirectoryExist path
when exists (removeDirectoryRecursive path)
-- | Names a directory on a case-sensitive volume for
-- 'testCaseSensitiveVolumeIO'. A Linux temp directory qualifies on
-- its own; on macOS a "Case-sensitive APFS" image attached with
-- hdiutil does, and the default volume does not.
caseSensitiveDirVar :: String
caseSensitiveDirVar = "NOVA_NIX_TEST_CASE_SENSITIVE_DIR"
-- | True-name materialization on a volume that does not fold: a store
-- opened there probes sensitive, and a NAR carrying @Makefile@ and
-- @makefile@ unpacks to two files under their own names through the
-- strict and the streaming substituter paths alike. A directory named
-- by 'caseSensitiveDirVar' is held to the claim: one that is missing
-- or probes folding FAILS, since the variable is how a run asserts a
-- volume (macOS CI attaches an image for it) and a typo must not read
-- as "no volume available". With the variable unset the temp
-- directory is tried, and skips where it folds.
testCaseSensitiveVolumeIO :: IO [Bool]
testCaseSensitiveVolumeIO = do
putStrLn "store/case-sensitive-volume"
named <- lookupEnv caseSensitiveDirVar
case named of
Just base -> do
verdict <- namedDirVerdict base
case verdict of
Right () -> testCaseSensitiveVolumeBody base
Left reason ->
(: []) <$> runTest (T.pack caseSensitiveDirVar <> " names a case-sensitive directory") (Fail reason)
Nothing -> do
tmpBase <- getTemporaryDirectory
sensitivity <- probeCaseSensitivity tmpBase
case sensitivity of
CaseInsensitive -> do
putStrLn (" SKIP needs a case-sensitive volume (" ++ caseSensitiveDirVar ++ " names a directory on one)")
pure []
CaseSensitive -> testCaseSensitiveVolumeBody tmpBase
where
namedDirVerdict base = do
present <- doesDirectoryExist base
if not present
then pure (Left (T.pack base <> " does not exist"))
else do
sensitivity <- probeCaseSensitivity base
pure $ case sensitivity of
CaseSensitive -> Right ()
CaseInsensitive -> Left (T.pack base <> " probes " <> T.pack (show CaseInsensitive))
testCaseSensitiveVolumeBody :: FilePath -> IO [Bool]
testCaseSensitiveVolumeBody base = do
let storeRoot = base </> "nova-nix-test-cs-store"
storeDir = StoreDir storeRoot
tree =
NAR.NarDirectory
[ ("Makefile", NAR.NarRegular False "upper"),
("makefile", NAR.NarRegular False "lower")
]
rawNar = NAR.serialise tree
digest = CHash.hashBytes rawNar
narInfoOf nar sp =
NarInfo.NarInfo
{ NarInfo.niStorePath = storePathToText defaultStoreDir sp,
NarInfo.niUrl = "nar/case.nar",
NarInfo.niCompression = "none",
NarInfo.niFileHash = Nothing,
NarInfo.niFileSize = Nothing,
NarInfo.niNarHash = CHash.formatNixHash (CHash.hashBytes nar),
NarInfo.niNarSize = fromIntegral (BS.length nar),
NarInfo.niReferences = [],
NarInfo.niDeriver = Nothing,
NarInfo.niSigs = [],
NarInfo.niCA = Nothing
}
narInfoFor = narInfoOf rawNar
-- A name carrying the case-hack suffix beside the name it would
-- strip to: read with the suffix stripped, the two collide.
suffixTree =
NAR.NarDirectory
[ ("Makefile", NAR.NarRegular False "upper"),
("Makefile~nix~case~hack~1", NAR.NarRegular False "literal")
]
suffixNar = NAR.serialise suffixTree
suffixNames sp = do
names <- sort <$> Dir.listDirectory (storePathToFilePath storeDir sp)
pure (assertEqual "on-disk names" ["Makefile", "Makefile~nix~case~hack~1"] names)
-- Both spellings present with their own contents, and nothing
-- carrying the case-hack suffix.
trueNames sp = do
let dest = storePathToFilePath storeDir sp
names <- Dir.listDirectory dest
upper <- BS.readFile (dest </> "Makefile")
lower <- BS.readFile (dest </> "makefile")
pure $
if sort names == ["Makefile", "makefile"] && upper == "upper" && lower == "lower"
then Pass
else Fail ("on disk: " <> T.pack (show names))
forceRemoveIfExists storeRoot
store <- openStore storeDir
results <-
sequence
[ runTest "the store probes its volume as case-sensitive" $
assertEqual "stCaseSensitivity" CaseSensitive (stCaseSensitivity store),
runTestM "strict substitution materializes true names" $ do
let sp = StorePath (T.replicate 32 "c") "case-strict"
result <- Subst.unpackAndVerify store sp (narInfoFor sp) rawNar
case result of
Subst.SubstSuccess _ lock -> do
releasePathLock lock
trueNames sp
other -> pure (Fail ("substitution failed: " <> T.pack (show other))),
runTestM "streaming substitution materializes true names" $ do
let sp = StorePath (T.replicate 32 "d") "case-stream"
source <- chunkReader [rawNar]
result <- Subst.materializeNarFromSource store sp (narInfoFor sp) digest [] Nothing source
case result of
Right _ -> trueNames sp
Left err -> pure (Fail ("streaming substitution failed: " <> Subst.attemptFailureMessage err)),
-- Nothing on a volume that keeps names apart is ever hacked, so
-- a name carrying the suffix is a name like any other: both
-- pipelines accept it, and their on-disk rechecks read it back
-- as spelled (#236).
runTestM "a name carrying the case-hack suffix substitutes verbatim, strict" $ do
let sp = StorePath (T.replicate 32 "e") "suffix-strict"
result <- Subst.unpackAndVerify store sp (narInfoOf suffixNar sp) suffixNar
case result of
Subst.SubstSuccess _ lock -> do
releasePathLock lock
suffixNames sp
other -> pure (Fail ("substitution failed: " <> T.pack (show other))),
runTestM "a name carrying the case-hack suffix substitutes verbatim, streaming" $ do
let sp = StorePath (T.replicate 32 "f") "suffix-stream"
source <- chunkReader [suffixNar]
result <- Subst.materializeNarFromSource store sp (narInfoOf suffixNar sp) (CHash.hashBytes suffixNar) [] Nothing source
case result of
Right _ -> suffixNames sp
Left err -> pure (Fail ("streaming substitution failed: " <> Subst.attemptFailureMessage err)),
-- A store path already on this volume is read back as spelled
-- too: an evaluation write holding the name reproduces its
-- address and registers the NAR upstream dumps for it with
-- use-case-hack off ('suffixPairNarHash').
runTestM "a store path naming a file with the case-hack suffix registers under that name" $
case makeFixedOutputPath "suffix-write" "sha256" "recursive" (sha256Digest suffixNar) of
Left err -> pure (Fail ("test store path rejected: " <> T.pack (show err)))
Right sp -> do
let dest = storePathToFilePath storeDir sp
createDirectoryIfMissing True dest
BS.writeFile (dest </> "Makefile") "upper"
BS.writeFile (dest </> "Makefile~nix~case~hack~1") "literal"
materializeEvalStoreWrites store (Map.singleton (storePathToText defaultStoreDir sp) ([], WriteRecursive))
info <- queryPathInfo (stDB store) sp
pure $ case info of
Just row -> assertEqual "registered NAR hash" suffixPairNarHash (piNarHash row)
Nothing -> Fail "not registered",
-- Evaluation reads a store path as the store does: copying one
-- holding the name hashes it as spelled, where a source read
-- would follow the process and, on macOS, strip it.
runTestM "builtins.path reads a store path under its volume's case-hack mode" $ do
let held = StorePath (T.replicate 32 "g") "suffix-read"
heldPath = storePathToFilePath storeDir held
createDirectoryIfMissing True heldPath
BS.writeFile (heldPath </> "Makefile") "upper"
BS.writeFile (heldPath </> "Makefile~nix~case~hack~1") "literal"
copied <-
evalNixIOStore
storeDir
"."
("builtins.path { path = " <> storePathToText defaultStoreDir held <> "; name = \"suffix-copy\"; }")
let expected = storePathToText defaultStoreDir <$> makeFixedOutputPath "suffix-copy" "sha256" "recursive" (sha256Digest suffixNar)
case (copied, expected) of
(Right (VStr pathBytes _), Right expectedPath)
| bytesText pathBytes /= expectedPath -> pure (Fail ("copied to " <> bytesText pathBytes <> ", expected " <> expectedPath))
| otherwise -> maybe (pure (Fail "unparseable store path")) suffixNames (parseStorePath defaultStoreDir expectedPath)
(Left err, _) -> pure (Fail ("eval failed: " <> err))
other -> pure (Fail ("unexpected result: " <> T.pack (show other))),
-- A source tree copied off this volume into one that folds the
-- sharp-s pair: the two names are distinct here and one name
-- there, so the copy refuses the second at the write rather
-- than landing it on the first (#234).
runTestM "a copy into a volume that folds a pair refuses the later name" $ do
probed <- tempFoldsSharpS
case probed of
Left reason -> Pass <$ putStrLn (" SKIP " ++ reason)
Right tmpBase -> do
let src = base </> "nova-nix-test-cs-copy-src"
dest = tmpBase </> "nova-nix-test-cs-copy-dest"
contents = Map.fromList [(T.unpack sharpSUpper, "upper"), (T.unpack sharpSLower, "lower")]
forceRemoveIfExists src
Subst.clearStaleDestination dest
createDirectoryIfMissing True src
mapM_ (\(name, bytes) -> BS.writeFile (src </> name) bytes) (Map.toList contents)
-- The copy walks the listing's order, which the volume
-- chooses, so the refused name is whichever comes second.
listed <- Dir.listDirectory src
outcome <- try (copyPathInto src dest)
landed <- traverse (\name -> (,) name <$> BS.readFile (dest </> name)) (take 1 listed)
forceRemoveIfExists src
Subst.clearStaleDestination dest
pure $ case (listed, outcome) of
([earlier, later], Left (e :: IOException))
| T.pack (ioeGetErrorString e) /= "creating file '" <> quotedAsCxx (dest </> later) <> "': File exists" ->
Fail ("unexpected refusal: " <> T.pack (show e))
| landed /= [(earlier, Map.findWithDefault "" earlier contents)] ->
Fail ("the earlier entry was overwritten: " <> T.pack (show landed))
| otherwise -> Pass
(_, Right ()) -> Fail ("the copy succeeded; on disk: " <> T.pack (show landed))
other -> Fail ("unexpected listing or outcome: " <> T.pack (show other)),
-- A source holding a case-only pair, built against a store
-- whose volume folds: evaluation names the two-file tree, and
-- the store holds it as upstream's restore does, the later
-- name case-hacked, registered under that address (#235).
runTestM "a coerced source's case-only pair is stored case-hacked on a folding store" $
caseOnlyPairBuild base canonPathValue,
runTestM "builtins.path stores a case-only pair case-hacked on a folding store" $
caseOnlyPairBuild base (\srcPath -> "builtins.path { path = " <> canonPathValue srcPath <> "; }")
]
closeStore store
forceRemoveIfExists storeRoot
pure results
-- | What upstream records for 'caseOnlyPairBuild''s source on a
-- folding volume: nix-instantiate 2.33.2 with
-- @--store 'local?root=...'@ adds it at this path, @nix-store
-- --query --hash@ and @--size@ report this NAR hash and size, and the
-- tree holds @Makefile@ and @makefile~nix~case~hack~1@.
caseOnlyPairPath :: StorePath
caseOnlyPairPath = StorePath "1rn1vqr2y9f65qg5vflbfr5gkwllmp22" "src"
caseOnlyPairNarHash :: Text
caseOnlyPairNarHash = "sha256:04z1mpa501269w2aqjr3kq5k4y85hjzbisvfc3jgmw3dnd7va9hl"
caseOnlyPairNarSize :: Int
caseOnlyPairNarSize = 480
-- | Build a derivation whose @src@ is the given expression over a
-- source directory named @src@ holding @Makefile@ and @makefile@, on a
-- case-sensitive base, against a store in the temp directory, and
-- hold the result to what upstream stores ('caseOnlyPairPath'). Skips
-- where the temp directory's volume does not fold.
caseOnlyPairBuild :: FilePath -> (Text -> Text) -> IO TestResult
caseOnlyPairBuild base srcExpr = do
tmpBase <- getTemporaryDirectory
sensitivity <- probeCaseSensitivity tmpBase
case sensitivity of
CaseSensitive -> Pass <$ putStrLn " SKIP the temp directory's volume does not fold case"
CaseInsensitive -> do
shell <- findTestShell
let srcRoot = base </> "nova-nix-test-cs-pair"
srcDir = srcRoot </> "src"
tmpStore = tmpBase </> "nova-nix-test-cs-pair-store"
nixEscape = T.concatMap (\c -> if c == '\\' then "\\\\" else if c == '"' then "\\\"" else T.singleton c)
source =
T.concat
[ "derivation { name = \"pair\"; system = builtins.currentSystem; ",
"builder = \"" <> nixEscape shell <> "\"; ",
"args = [\"-c\" \"cd $src && for f in *; do echo \\\"$f\\\"; done > $out\"]; ",
"src = " <> srcExpr (T.pack srcDir) <> "; }"
]
forceRemoveIfExists srcRoot
forceRemoveIfExists tmpStore
createDirectoryIfMissing True srcDir
BS.writeFile (srcDir </> "Makefile") "upper\n"
BS.writeFile (srcDir </> "makefile") "lower\n"
built <- evalAndBuild (StoreDir tmpStore) source
verdict <- case built of
Left err -> pure (Fail err)
Right (BuildFailure msg _, store) -> Fail msg <$ closeStore store
Right (BuildSuccess outSP, store) -> do
let stored = storePathToFilePath (stDir store) caseOnlyPairPath
names <- sort <$> Dir.listDirectory stored
contents <- traverse (BS.readFile . (stored </>)) names
info <- queryPathInfo (stDB store) caseOnlyPairPath
seen <- BS.readFile (storePathToFilePath (stDir store) outSP)
closeStore store
let hacked = ["Makefile", "makefile~nix~case~hack~1"]
pure $ case info of
Nothing -> Fail "the source path is not registered"
Just row
| names /= hacked || contents /= ["upper\n", "lower\n"] ->
Fail ("stored as " <> T.pack (show (zip names contents)))
| piNarHash row /= caseOnlyPairNarHash || piNarSize row /= caseOnlyPairNarSize ->
Fail ("registered " <> piNarHash row <> " / " <> T.pack (show (piNarSize row)))
| seen /= "Makefile\nmakefile~nix~case~hack~1\n" ->
Fail ("the builder saw " <> T.pack (show seen))
| otherwise -> Pass
forceRemoveIfExists srcRoot
forceRemoveIfExists tmpStore
pure verdict
-- | The NAR hash of a directory holding @Makefile@ (@upper@) and
-- @Makefile~nix~case~hack~1@ (@literal@): @nix-store --option
-- use-case-hack false --dump@ 2.33.2 piped to @nix-hash --flat@. With
-- the setting at its macOS default the dump strips the suffix and
-- fails on the collision.
suffixPairNarHash :: Text
suffixPairNarHash = "sha256:1x31cqjvkihkh3wbzq00z8xplwbf7i0bpk3g9vqs403lh3f5b4gs"
-- | A path as upstream's formatter streams a @std::filesystem::path@:
-- through @std::quoted@, in double quotes with a double quote or a
-- backslash inside escaped by a backslash.
quotedAsCxx :: FilePath -> Text
quotedAsCxx path = "\"" <> T.replace "\"" "\\\"" (T.replace "\\" "\\\\" (T.pack path)) <> "\""
-- | U+1E9E (capital sharp s) and U+00DF (small sharp s): a pair APFS
-- folds to one name and 'onDiskNameKey' keeps apart, since 'toUpper'
-- leaves U+00DF as it is (#234). Escaped, as the source is ASCII.
sharpSUpper, sharpSLower :: Text
sharpSUpper = "STRA\x1E9E\&E"
sharpSLower = "stra\xDF\&e"
-- | Whether the volume holding a directory folds the sharp-s pair,
-- answered by the volume itself: one spelling is created and the other
-- looked up. The store's probe says whether a volume folds case at
-- all, not which pairs its table folds.
sharpSFolds :: FilePath -> IO Bool
sharpSFolds dir = do
let probeDir = dir </> "nova-nix-test-sharp-s-probe"
Subst.clearStaleDestination probeDir
createDirectoryIfMissing True probeDir
BS.writeFile (probeDir </> T.unpack sharpSUpper) "probe"
folds <- Dir.doesFileExist (probeDir </> T.unpack sharpSLower)
Subst.clearStaleDestination probeDir
pure folds
-- | Whether the suite's temp directory folds the sharp-s pair: the
-- store's own probe first, then the volume for the pair itself.
tempFoldsSharpS :: IO (Either String FilePath)
tempFoldsSharpS = do
tmpBase <- getTemporaryDirectory
sensitivity <- probeCaseSensitivity tmpBase
case sensitivity of
CaseSensitive -> pure (Left "the temp directory's volume does not fold case")
CaseInsensitive -> do
folds <- sharpSFolds tmpBase
pure $
if folds
then Right tmpBase
else Left "the temp directory's volume folds case but keeps U+1E9E and U+00DF apart"
-- | A sibling pair the volume folds but 'onDiskNameKey' keeps apart
-- (#234). The exclusive create refuses the later entry at the write,
-- in upstream's wording and naming it, through both unpack paths, and
-- the earlier entry keeps its own content: nothing lands on it, and
-- two directories do not merge. A link needed no new exclusivity
-- (link creation never replaces a name); its refusal is pinned
-- alongside. Skips with the reason where the temp directory's volume
-- does not fold the pair.
testFoldingVolumeIO :: IO [Bool]
testFoldingVolumeIO = do
putStrLn "store/folding-volume"
probed <- tempFoldsSharpS
case probed of
Left reason -> do
putStrLn (" SKIP " ++ reason)
pure []
Right tmpBase -> testFoldingVolumeBody (tmpBase </> "nova-nix-test-folding")
testFoldingVolumeBody :: FilePath -> IO [Bool]
testFoldingVolumeBody root = do
let upperName = T.unpack sharpSUpper
lowerName = T.unpack sharpSLower
pair earlier later =
NAR.NarDirectory [(TE.encodeUtf8 sharpSUpper, earlier), (TE.encodeUtf8 sharpSLower, later)]
filePair = pair (NAR.NarRegular False "upper") (NAR.NarRegular False "lower")
linkPair = pair (NAR.NarRegular False "upper") (NAR.NarSymlink "a")
dirPair =
pair
(NAR.NarDirectory [("a", NAR.NarRegular False "upper")])
(NAR.NarDirectory [("b", NAR.NarRegular False "lower")])
dirOverFilePair = pair (NAR.NarRegular False "upper") (NAR.NarDirectory [("b", NAR.NarRegular False "lower")])
fileRefusal dest = "creating file '" <> quotedAsCxx (dest </> lowerName) <> "': File exists"
dirRefusal dest = "path '" <> T.pack (dest </> lowerName) <> "' already exists"
dirOverFileRefusal dest = "creating directory '" <> T.pack (dest </> lowerName) <> "': File exists"
linkRefusal dest = "creating symlink from '" <> T.pack (dest </> lowerName) <> "' -> 'a': File exists"
upperFileKept dest = (== "upper") <$> BS.readFile (dest </> upperName)
upperDirKept dest = (== ["a"]) <$> Dir.listDirectory (dest </> upperName)
narInfoOf raw =
NarInfo.NarInfo
{ NarInfo.niStorePath = "/nix/store/" <> T.replicate 32 "f" <> "-folding",
NarInfo.niUrl = "nar/folding.nar",
NarInfo.niCompression = "none",
NarInfo.niFileHash = Nothing,
NarInfo.niFileSize = Nothing,
NarInfo.niNarHash = CHash.formatNixHash (CHash.hashBytes raw),
NarInfo.niNarSize = fromIntegral (BS.length raw),
NarInfo.niReferences = [],
NarInfo.niDeriver = Nothing,
NarInfo.niSigs = [],
NarInfo.niCA = Nothing
}
strictly = unpackNarEntry CaseInsensitive
streamed dest tree = do
let raw = NAR.serialise tree
source <- chunkReader [raw]
outcome <- Subst.consumeNarStream CaseInsensitive dest (narInfoOf raw) (CHash.hashBytes raw) source
pure (either (Left . Subst.attemptFailureMessage) (const (Right ())) outcome)
refusedAtWrite label unpack tree refusal kept = runTestM label $ do
let dest = root </> "out"
Subst.clearStaleDestination dest
result <- unpack dest tree
earlierKept <- kept dest
Subst.clearStaleDestination dest
pure $
if earlierKept
then assertEqual "unpack outcome" (Left (refusal dest)) result
else Fail ("the earlier entry was overwritten or merged into; unpack returned " <> T.pack (show result))
forceRemoveIfExists root
createDirectoryIfMissing True root
results <-
sequence
[ refusedAtWrite "strict unpack refuses the later file of a folded pair" strictly filePair fileRefusal upperFileKept,
refusedAtWrite "streaming unpack refuses the later file of a folded pair" streamed filePair fileRefusal upperFileKept,
refusedAtWrite "strict unpack refuses the later directory of a folded pair" strictly dirPair dirRefusal upperDirKept,
refusedAtWrite "streaming unpack refuses the later directory of a folded pair" streamed dirPair dirRefusal upperDirKept,
refusedAtWrite "strict unpack refuses a directory folding onto a file" strictly dirOverFilePair dirOverFileRefusal upperFileKept,
refusedAtWrite "streaming unpack refuses a directory folding onto a file" streamed dirOverFilePair dirOverFileRefusal upperFileKept,
refusedAtWrite "a link folding onto an earlier file is refused at the link" strictly linkPair linkRefusal upperFileKept
]
forceRemoveIfExists root
pure results
testStoreDB :: IO [Bool]
testStoreDB = do
putStrLn "store/db"
withTempStoreDB $ \storeDir ->
sequence
[ -- open and close without error
runTestM "db open/close" $ do
db <- openStoreDB storeDir
closeStoreDB db
pure Pass,
-- isValidPath returns False for unknown path
runTestM "db isValidPath false for unknown" $ do
db <- openStoreDB storeDir
result <- isValidPath db (StorePath "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa1" "unknown")
closeStoreDB db
pure (assertEqual "unknown" False result),
-- register + isValidPath returns True
runTestM "db register + isValid" $ do
db <- openStoreDB storeDir
let sp = StorePath "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa2" "hello"
reg = PathRegistration sp "sha256:abc" 100 Nothing []
registerPath db reg
result <- isValidPath db sp
closeStoreDB db
pure (assertEqual "registered" True result),
-- A peer's held write transaction must be waited out, not died
-- on: SQLite's default busy timeout is zero, and registration
-- used to crash with an uncaught ErrorBusy SQLError while a
-- second process was mid-commit. Upstream waits
-- (sqlite3_busy_timeout, one hour); this pins that we do too.
runTestM "db registration waits out a busy peer" $ do
db <- openStoreDB storeDir
let dbPath = unStoreDir storeDir </> metaDirName </> dbFileName
peer <- SQL.open dbPath
SQL.execute_ peer "BEGIN IMMEDIATE"
released <- newEmptyMVar
_ <- forkIO $ do
threadDelay 300000
SQL.execute_ peer "COMMIT"
SQL.close peer
putMVar released ()
let sp = StorePath "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa3" "busywait"
registerPath db (PathRegistration sp "sha256:busy" 10 Nothing [])
takeMVar released
result <- isValidPath db sp
closeStoreDB db
pure (assertEqual "registered after the peer released" True result),
-- register with refs + query
runTestM "db register with refs + query" $ do
db <- openStoreDB storeDir
let ref1 = StorePath "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" "dep1"
ref2 = StorePath "cccccccccccccccccccccccccccccccc" "dep2"
mainSp = StorePath "dddddddddddddddddddddddddddddddd" "mainpkg"
registerPath db (PathRegistration ref1 "sha256:r1" 50 Nothing [])
registerPath db (PathRegistration ref2 "sha256:r2" 60 Nothing [])
registerPath db (PathRegistration mainSp "sha256:m1" 200 Nothing [ref1, ref2])
refs <- queryReferences db mainSp
closeStoreDB db
let ref1Path = T.pack (storePathToFilePath storeDir ref1)
ref2Path = T.pack (storePathToFilePath storeDir ref2)
hasRef1 = ref1Path `elem` refs
hasRef2 = ref2Path `elem` refs
pure $
if hasRef1 && hasRef2
then Pass
else Fail ("expected refs to contain both deps, got: " <> T.pack (show refs)),
-- Re-registration replaces the edge set: the refresh contract
-- covers references too, and a union would over-report into
-- pushed narinfos.
runTestM "db re-register replaces refs" $ do
db <- openStoreDB storeDir
let refA = StorePath "gggggggggggggggggggggggggggggggg" "refresh-a"
refB = StorePath "hhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh" "refresh-b"
sp = StorePath "iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii" "refresh-main"
registerPaths
db
[ PathRegistration refA "sha256:ra" 10 Nothing [],
PathRegistration refB "sha256:rb" 11 Nothing [],
PathRegistration sp "sha256:rm" 12 Nothing [refA, refB]
]
registerPath db (PathRegistration sp "sha256:rm" 12 Nothing [refA])
refs <- queryReferences db sp
closeStoreDB db
let refAPath = T.pack (storePathToFilePath storeDir refA)
refBPath = T.pack (storePathToFilePath storeDir refB)
pure $
if refAPath `elem` refs && refBPath `notElem` refs
then Pass
else Fail ("expected only refresh-a after re-register, got: " <> T.pack (show refs)),
-- A reference to an unregistered path is a loud error: a silently
-- dropped edge under-reports narinfos and hands a future GC
-- permission to delete a live dependency.
runTestM "db register with unregistered ref throws" $ do
db <- openStoreDB storeDir
let ghost = StorePath "jjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjj" "ghost"
sp = StorePath "kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" "orphan-edge"
outcome <- try (registerPath db (PathRegistration sp "sha256:oe" 13 Nothing [ghost]))
closeStoreDB db
pure $ case (outcome :: Either SomeException ()) of
Left _ -> Pass
Right () -> Fail "expected registration to throw on an unregistered reference",
-- queryDeriver nothing
runTestM "db queryDeriver nothing" $ do
db <- openStoreDB storeDir
let sp = StorePath "cccccccccccccccccccccccccccccccc" "noderiver"
registerPath db (PathRegistration sp "sha256:nd" 80 Nothing [])
result <- queryDeriver db sp
closeStoreDB db
pure (assertEqual "no deriver" Nothing result),
-- queryDeriver just
runTestM "db queryDeriver just" $ do
db <- openStoreDB storeDir
let sp = StorePath "ffffffffffffffffffffffffffffffff" "hasdrv"
registerPath db (PathRegistration sp "sha256:hd" 90 (Just "/nix/store/xxx.drv") [])
result <- queryDeriver db sp
closeStoreDB db
pure (assertEqual "has deriver" (Just "/nix/store/xxx.drv") result),
-- queryPathInfo
runTestM "db queryPathInfo" $ do
db <- openStoreDB storeDir
let sp = StorePath "gggggggggggggggggggggggggggggggg" "infotest"
registerPath db (PathRegistration sp "sha256:info" 150 (Just "/drv") [])
minfo <- queryPathInfo db sp
closeStoreDB db
pure $ case minfo of
Nothing -> Fail "expected PathInfo but got Nothing"
Just info ->
if piNarHash info == "sha256:info"
&& piNarSize info == 150
&& piDeriver info == Just "/drv"
then Pass
else Fail ("bad PathInfo: " <> T.pack (show info)),
-- queryPathInfo for unknown returns Nothing
runTestM "db queryPathInfo unknown" $ do
db <- openStoreDB storeDir
minfo <- queryPathInfo db (StorePath "hhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh" "nope")
closeStoreDB db
pure (assertEqual "no info" Nothing minfo),
-- double register is idempotent
runTestM "db double register idempotent" $ do
db <- openStoreDB storeDir
let sp = StorePath "iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii" "double"
reg = PathRegistration sp "sha256:dup" 120 Nothing []
registerPath db reg
registerPath db reg
result <- isValidPath db sp
closeStoreDB db
pure (assertEqual "still valid" True result),
-- multi-path reference graph
runTestM "db multi-path reference graph" $ do
db <- openStoreDB storeDir
let spA = StorePath "jjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjj" "a"
spB = StorePath "kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" "b"
spC = StorePath "llllllllllllllllllllllllllllllll" "c"
registerPath db (PathRegistration spA "sha256:a" 10 Nothing [])
registerPath db (PathRegistration spB "sha256:b" 20 Nothing [spA])
registerPath db (PathRegistration spC "sha256:c" 30 Nothing [spA, spB])
refsC <- queryReferences db spC
refsA <- queryReferences db spA
closeStoreDB db
let aPath = T.pack (storePathToFilePath storeDir spA)
bPath = T.pack (storePathToFilePath storeDir spB)
pure $
if length refsC == 2 && aPath `elem` refsC && bPath `elem` refsC && null refsA
then Pass
else Fail ("bad ref graph: c refs=" <> T.pack (show refsC) <> " a refs=" <> T.pack (show refsA))
]
-- ---------------------------------------------------------------------------
-- Tests: Store Operations + parseStorePath (Phase 2, Batch 2)
-- ---------------------------------------------------------------------------
testParseStorePath :: IO [Bool]
testParseStorePath = do
putStrLn "store/parseStorePath"
let sd = defaultStoreDir
sequence
[ runTest "parse valid store path" $
assertEqual
"valid"
(Just (StorePath "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "hello-2.12"))
(parseStorePath sd "/nix/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-hello-2.12"),
runTest "parse missing prefix" $
assertEqual "no prefix" Nothing (parseStorePath sd "/tmp/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-hello"),
runTest "parse too short hash" $
assertEqual "short hash" Nothing (parseStorePath sd "/nix/store/aaa-hello"),
runTest "parse missing dash after hash" $
assertEqual "no dash" Nothing (parseStorePath sd "/nix/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaahello"),
runTest "parse empty name" $
assertEqual "empty name" Nothing (parseStorePath sd "/nix/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-"),
runTest "parse windows store path" $
assertEqual
"windows"
(Just (StorePath "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" "pkg"))
(parseStorePath windowsStoreDir "C:\\nix\\store/bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb-pkg"),
-- The backslash separator is the form storePathToFilePath actually
-- produces on Windows (what %out% and DB rows look like there).
runTest "parse windows store path with backslash separator" $
assertEqual
"windows-backslash"
(Just (StorePath "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" "pkg"))
(parseStorePath windowsStoreDir "C:\\nix\\store\\bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb-pkg"),
-- Charset gates (upstream's parse-boundary checks): the hash slot
-- accepts only nix-base32 (no e o u t), and the name only
-- [A-Za-z0-9+._?=-] - parsed text can come from a cache, and an
-- unchecked component would later become a filesystem path.
runTest "parse rejects non-base32 hash" $
assertEqual "e-hash" Nothing (parseStorePath sd ("/nix/store/" <> T.replicate 32 "e" <> "-hello")),
runTest "parse rejects traversal text in hash slot" $
assertEqual "traversal-hash" Nothing (parseStorePath sd ("/nix/store/" <> T.replicate 16 ".\\" <> "-x")),
runTest "parse rejects separator in name" $
assertEqual "sep-name" Nothing (parseStorePath sd "/nix/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-he/llo"),
runTest "parse rejects dot-dot name" $
assertEqual "dotdot-name" Nothing (parseStorePath sd "/nix/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-.."),
runTest "parse rejects overlong name" $
assertEqual "overlong-name" Nothing (parseStorePath sd ("/nix/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-" <> T.replicate 212 "x")),
runTest "parse accepts the full name charset" $
assertEqual
"name-specials"
(Just (StorePath "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "gcc-13.2.0_pre+x?="))
(parseStorePath sd "/nix/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-gcc-13.2.0_pre+x?="),
-- The first dash-separated component of a name may not be . or ..
-- (upstream checkName): the traversal names' .- / ..- prefixed forms
-- are rejected while other dot-leading names stay valid.
runTest "parse rejects a .- first component" $
assertEqual "dot-dash" Nothing (parseStorePath sd "/nix/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-.-cfg"),
runTest "parse rejects a ..- first component" $
assertEqual "dotdot-dash" Nothing (parseStorePath sd "/nix/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-..-cfg"),
runTest "parse accepts a dot-leading name" $
assertEqual
"dot-leading"
(Just (StorePath "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" ".config-1.0"))
(parseStorePath sd "/nix/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-.config-1.0")
]
-- ---------------------------------------------------------------------------
-- Tests: Push (pure narinfo construction + closure computation)
-- ---------------------------------------------------------------------------
testPushPure :: IO [Bool]
testPushPure = do
putStrLn "push/narinfo"
let hashA = T.replicate 32 "a"
hashB = T.replicate 32 "b"
spA = StorePath hashA "hello-1.0"
spB = StorePath hashB "dep-2.0"
narHash = "sha256:0123abcdef"
narBytes = BS.replicate 1234 0x6e
artifactNone = mkPushArtifact PushNone narHash narBytes
artifactZstd = mkPushArtifact PushZstd narHash narBytes
-- References deliberately unsorted; deriver present.
ni = mkNarInfo artifactNone spA [spB, spA] (Just spB)
niZstd = mkNarInfo artifactZstd spA [spB, spA] (Just spB)
sequence
[ runTest "narinfo StorePath is canonical /nix/store" $
assertEqual "StorePath" ("/nix/store/" <> hashA <> "-hello-1.0") (NarInfo.niStorePath ni),
runTest "narinfo URL is nar/<digest>.nar" $
assertEqual "URL" "nar/0123abcdef.nar" (NarInfo.niUrl ni),
runTest "compression none mirrors NAR fields into file fields" $
assertEqual
"file fields"
("none", Just (NarInfo.niNarHash ni), Just (NarInfo.niNarSize ni))
(NarInfo.niCompression ni, NarInfo.niFileHash ni, NarInfo.niFileSize ni),
runTest "narinfo sizes carry through" $
assertEqual "NarSize" 1234 (NarInfo.niNarSize ni),
-- The zstd artifact: file fields describe the compressed object,
-- named by its own file hash, while the NAR fields stay the
-- archive's - and the substituter's strict decoder round-trips
-- the bytes under the declared NarSize bound.
runTest "zstd artifact declares the compressed object" $
assertEqual
"zstd fields"
("zstd", Just (paFileHash artifactZstd), Just (fromIntegral (paFileSize artifactZstd)), 1234)
(NarInfo.niCompression niZstd, NarInfo.niFileHash niZstd, NarInfo.niFileSize niZstd, NarInfo.niNarSize niZstd),
-- Ground truth, not field copying: the file fields must equal
-- independent computation over the artifact's actual bytes, and
-- must NOT collapse into the NAR fields (the copy-paste hazard
-- for a compressible input like this one).
runTest "zstd file fields are computed from the compressed bytes" $
let independentHash = CHash.formatNixHash (CHash.hashBytes (paBytes artifactZstd))
in if paFileHash artifactZstd == independentHash
&& paFileSize artifactZstd == BS.length (paBytes artifactZstd)
&& paFileHash artifactZstd /= narHash
&& paFileSize artifactZstd /= BS.length narBytes
then Pass
else Fail "zstd file fields do not match the compressed bytes",
runTest "none artifact IS the NAR" $
if paBytes artifactNone == narBytes
&& paFileHash artifactNone == narHash
&& paFileSize artifactNone == BS.length narBytes
then Pass
else Fail "none artifact diverges from its NAR",
runTest "zstd object is named by its independently computed file hash" $
assertEqual
"zstd URL"
("nar/" <> stripHashPrefix (CHash.formatNixHash (CHash.hashBytes (paBytes artifactZstd))) <> ".nar.zst")
(NarInfo.niUrl niZstd),
-- mkNarInfo cannot be handed NAR fields that disagree with the
-- artifact: they now come from the artifact itself.
runTest "narinfo NAR fields come from the artifact" $
assertEqual
"NAR fields"
(narHash, toInteger (BS.length narBytes))
(NarInfo.niNarHash niZstd, NarInfo.niNarSize niZstd),
runTestM "zstd artifact round-trips through the substituter decoder" $ do
out <- Subst.decompressNar 1234 "zstd" (paBytes artifactZstd)
pure (assertEqual "push-substitute roundtrip" (Right narBytes) out),
-- The CLI vocabulary is the wire vocabulary, parsed in one place.
runTest "parsePushCompression accepts the register and rejects by name" $
case (parsePushCompression "none", parsePushCompression "zstd", parsePushCompression "brotli") of
(Right PushNone, Right PushZstd, Left err)
| "none, zstd" `T.isInfixOf` err -> Pass
other -> Fail ("unexpected parse outcomes: " <> T.pack (show other)),
runTest "references are sorted basenames" $
assertEqual
"References"
[hashA <> "-hello-1.0", hashB <> "-dep-2.0"]
(NarInfo.niReferences ni),
runTest "deriver renders as a basename" $
assertEqual "Deriver" (Just (hashB <> "-dep-2.0")) (NarInfo.niDeriver ni),
runTest "no client-side signatures" $
assertEqual "Sigs" ([] :: [Text]) (NarInfo.niSigs ni),
-- The first main run of the cache job pushed a store's first valid
-- path alphabetically, a .drv, and the cache refused its narinfo:
-- a store registers recipes as valid paths, a cache serves outputs.
runTest "outputPathsOnly drops derivations and keeps everything else" $
assertEqual
"outputs"
["hello", "hello.drv.tar", "src"]
(map spName (outputPathsOnly [StorePath (T.replicate 32 "a") "hello", StorePath (T.replicate 32 "b") "hello.drv", StorePath (T.replicate 32 "c") "hello.drv.tar", StorePath (T.replicate 32 "d") "src"])),
runTest "isDerivationPath is the .drv suffix on the name, not the hash" $
assertEqual "drv" [True, False, False] (map isDerivationPath [StorePath (T.replicate 32 "a") "x.drv", StorePath (T.replicate 32 "b") "x", StorePath (T.replicate 32 "c") "drv"]),
runTest "planMissing keeps only uncached paths" $
assertEqual
"missing"
[hashB]
(map spHash (planMissing (Set.singleton hashA) [spA, spB])),
runTest "stripHashPrefix drops the algo tag" $
assertEqual "tagged" "deadbeef" (stripHashPrefix "sha256:deadbeef"),
runTest "stripHashPrefix tolerates a bare digest" $
assertEqual "bare" "deadbeef" (stripHashPrefix "deadbeef"),
runTest "storePathBasename joins hash and name" $
assertEqual "basename" (hashA <> "-hello-1.0") (storePathBasename spA),
runTest "narFileName appends .nar" $
assertEqual "file" "0123abcdef.nar" (narFileName narHash),
-- checkRecordedNarHash: the pre-upload integrity gate
runTest "push gate accepts a registered matching path" $
assertEqual
"gate ok"
(Right ())
(checkRecordedNarHash (Just (pathInfoFor narHash)) narHash spA),
runTest "push gate refuses an unregistered path" $
case checkRecordedNarHash Nothing narHash spA of
Left err
| "not registered" `T.isInfixOf` err -> Pass
| otherwise -> Fail ("wrong error: " <> err)
Right () -> Fail "unregistered path must not be publishable",
runTest "push gate refuses a changed-on-disk path" $
case checkRecordedNarHash (Just (pathInfoFor "sha256:other")) narHash spA of
Left err
| "DB recorded" `T.isInfixOf` err -> Pass
| otherwise -> Fail ("wrong error: " <> err)
Right () -> Fail "hash mismatch must not be publishable",
-- narHashMatches decodes both spellings before comparing. Today
-- parseNixHash reads only the sha256:nix-base32 spelling, so a
-- base16-recorded digest (both literals spell the empty-string
-- sha256) falls back to text equality and refuses - the safe
-- direction. When the parser learns more spellings (foreign
-- caches), this pin flips and the gate widens with it.
runTest "push gate pins the accepted hash spellings" $
if narHashMatches
"sha256:e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"
"sha256:0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73"
then Fail "base16 spelling unexpectedly matched - widen this pin"
else Pass,
runTest "push gate still refuses different digests" $
if narHashMatches
"sha256:0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73"
(Hash.formatNixHash (Hash.hashBytes "different"))
then Fail "distinct digests must not match"
else Pass
]
where
pathInfoFor recordedHash =
PathInfo
{ piPath = "/nix/store/" <> T.replicate 32 "a" <> "-hello-1.0",
piNarHash = recordedHash,
piNarSize = 1234,
piDeriver = Nothing,
piRegTime = 0
}
-- | Closure computation against a real (temp) store database.
testPushClosureIO :: IO [Bool]
testPushClosureIO = do
putStrLn "push/closure"
withTempStore $ \store -> do
let spTop = StorePath (T.replicate 32 "1") "top"
spMid = StorePath (T.replicate 32 "2") "mid"
spLeaf = StorePath (T.replicate 32 "3") "leaf"
regFor sp refs =
PathRegistration
{ prPath = sp,
prNarHash = "sha256:" <> T.replicate 52 "0",
prNarSize = 1,
prDeriver = Nothing,
prReferences = refs
}
registerPaths (stDB store) [regFor spTop [spMid], regFor spMid [spLeaf], regFor spLeaf []]
fromTop <- computeClosure store [spTop]
fromBoth <- computeClosure store [spTop, spLeaf]
sequence
[ runTest "closure walks transitive references" $
assertRight "fromTop" fromTop $ \closure ->
assertEqual
"hashes"
(Set.fromList (map spHash [spTop, spMid, spLeaf]))
(Set.fromList (map spHash closure)),
runTest "closure deduplicates across roots" $
assertRight "fromBoth" fromBoth $ \closure ->
assertEqual "count" (3 :: Int) (length closure),
-- loadApiKeyFile: keys copied through Windows editors arrive with
-- a BOM and CRLF; skipping the normalization turns every push
-- into an auth rejection with no visible cause.
runTestM "loadApiKeyFile strips BOM and CRLF" $ do
tmpBase <- getTemporaryDirectory
let keyFile = tmpBase </> "nova-nix-test-api-key"
BS.writeFile keyFile (BS.pack [0xEF, 0xBB, 0xBF] <> "the-secret-key\r\n")
loaded <- loadApiKeyFile keyFile
Dir.removeFile keyFile
pure (assertEqual "normalized key" (Right "the-secret-key") loaded),
runTestM "loadApiKeyFile rejects an effectively-empty key file" $ do
tmpBase <- getTemporaryDirectory
let keyFile = tmpBase </> "nova-nix-test-api-key-empty"
BS.writeFile keyFile (BS.pack [0xEF, 0xBB, 0xBF] <> " \r\n")
loaded <- loadApiKeyFile keyFile
Dir.removeFile keyFile
pure $ case loaded of
Left err | "empty" `T.isInfixOf` err -> Pass
other -> Fail ("expected empty-key rejection, got: " <> T.pack (show other)),
runTestM "loadApiKeyFile reports a missing file" $ do
tmpBase <- getTemporaryDirectory
loaded <- loadApiKeyFile (tmpBase </> "nova-nix-test-no-such-key-file")
pure $ case loaded of
Left err | "cannot read key file" `T.isInfixOf` err -> Pass
other -> Fail ("expected read error, got: " <> T.pack (show other))
]
-- | The case sensitivity of the suite's temp directory, so a test
-- materializing a NAR there keys sibling names the way a store on that
-- volume would.
tempCaseSensitivity :: IO CaseSensitivity
tempCaseSensitivity = getTemporaryDirectory >>= probeCaseSensitivity
-- | Helper: create a fresh temp store for IO tests.
withTempStore :: (Store -> IO [Bool]) -> IO [Bool]
withTempStore action = do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-store-ops"
forceRemoveIfExists tmpStore
createDirectoryIfMissing True tmpStore
store <- openStore (StoreDir tmpStore)
results <- action store
closeStore store
forceRemoveIfExists tmpStore
pure results
-- | Recursively restore writable permissions then remove.
-- Needed because addToStore/setReadOnly makes paths read-only.
forceRemoveIfExists :: FilePath -> IO ()
forceRemoveIfExists path = do
exists <- doesDirectoryExist path
when exists $ do
restoreWritable path
removeDirectoryRecursive path
restoreWritable :: FilePath -> IO ()
restoreWritable path = do
isDir <- doesDirectoryExist path
when isDir $ do
perms <- getPermissions path
Dir.setPermissions path (Dir.setOwnerWritable True perms)
entries <- Dir.listDirectory path
mapM_ (restoreWritable . (path </>)) entries
isFile <- Dir.doesFileExist path
when isFile $ do
perms <- getPermissions path
Dir.setPermissions path (Dir.setOwnerWritable True perms)
-- | Step 1 of the Windows-stdenv ladder: prove the Builder can run a
-- trivial derivation end-to-end natively - a recipe that writes to @$out@,
-- with the output landing in the store. No stdenv, no dependencies: just
-- the raw build path (process spawn, output capture, addToStore),
-- exercised on the host platform (@cmd.exe@ on Windows, @\/bin\/sh@ elsewhere).
testTrivialBuildIO :: IO [Bool]
testTrivialBuildIO = do
putStrLn "builder/trivial-native-build"
withTempStore $ \store -> do
let storeDir = stDir store
outPath = StorePath (T.replicate 31 "0" <> "1") "trivial"
(builder, args)
| SI.os == "mingw32" = ("cmd.exe", ["/c", "echo hi>%out%"])
| otherwise = ("/bin/sh", ["-c", "echo hi > $out"])
drv =
Derivation
{ drvOutputs =
[ DerivationOutput
{ doName = "out",
doPath = outPath,
doHashAlgo = "",
doHash = ""
}
],
drvInputDrvs = Map.empty,
drvInputSrcs = [],
drvPlatform = currentPlatform,
drvBuilder = builder,
drvArgs = args,
drvEnv = Map.empty
}
buildTmp <- (</> "nova-nix-test-trivial-build-tmp") <$> getTemporaryDirectory
forceRemoveIfExists buildTmp
createDirectoryIfMissing True buildTmp
let config = (defaultBuildConfig storeDir) {bcTmpDir = buildTmp}
result <- buildDerivation config store drv
forceRemoveIfExists buildTmp
case result of
BuildSuccess sp -> do
let outFile = storePathToFilePath storeDir sp
landed <- Dir.doesFileExist outFile
content <- if landed then TIO.readFile outFile else pure ""
narInfo <- queryPathInfo (stDB store) sp
let realNarHash = case narInfo of
Just info ->
piNarSize info > 0
&& T.isPrefixOf "sha256:" (piNarHash info)
&& T.any (/= '0') (T.drop 7 (piNarHash info))
Nothing -> False
sequence
[ runTest "trivial build succeeds" Pass,
runTest "trivial build output landed in store" $
if landed then Pass else Fail ("missing output file: " <> T.pack outFile),
runTest "trivial build actually ran the command" $
if "hi" `T.isInfixOf` content
then Pass
else Fail ("unexpected output content: " <> T.pack (show content)),
runTest "trivial build records a real NAR hash + size" $
if realNarHash
then Pass
else Fail ("NAR hash/size not real: " <> T.pack (show narInfo))
]
BuildFailure msg code ->
sequence
[ runTest "trivial build succeeds" $
Fail ("build failed (exit " <> T.pack (show code) <> "): " <> msg)
]
-- | The builder hands every build a fixed SOURCE_DATE_EPOCH (1980-01-01),
-- the reproducible-builds.org convention that determinism-aware tools
-- (ld's PE timestamp, gcc's __DATE__) honor. Proven behaviorally: a build
-- that echoes the variable into $out must see the pinned value.
testSourceDateEpochIO :: IO [Bool]
testSourceDateEpochIO = do
putStrLn "builder/source-date-epoch"
withTempStore $ \store -> do
let storeDir = stDir store
outPath = StorePath (T.replicate 31 "0" <> "5") "sde-probe"
(builder, args)
| SI.os == "mingw32" = ("cmd.exe", ["/c", "echo %SOURCE_DATE_EPOCH%>%out%"])
| otherwise = ("/bin/sh", ["-c", "echo $SOURCE_DATE_EPOCH > $out"])
drv =
Derivation
{ drvOutputs =
[ DerivationOutput
{ doName = "out",
doPath = outPath,
doHashAlgo = "",
doHash = ""
}
],
drvInputDrvs = Map.empty,
drvInputSrcs = [],
drvPlatform = currentPlatform,
drvBuilder = builder,
drvArgs = args,
drvEnv = Map.empty
}
buildTmp <- (</> "nova-nix-test-sde-build-tmp") <$> getTemporaryDirectory
forceRemoveIfExists buildTmp
createDirectoryIfMissing True buildTmp
let config = (defaultBuildConfig storeDir) {bcTmpDir = buildTmp}
result <- buildDerivation config store drv
forceRemoveIfExists buildTmp
case result of
BuildFailure msg code ->
sequence
[ runTest "SOURCE_DATE_EPOCH build succeeds" $
Fail ("build failed (exit " <> T.pack (show code) <> "): " <> msg)
]
BuildSuccess sp -> do
content <- TIO.readFile (storePathToFilePath storeDir sp)
sequence
[ runTest "builder pins SOURCE_DATE_EPOCH to 1980-01-01" $
if "315532800" `T.isInfixOf` content
then Pass
else Fail ("unexpected content: " <> T.pack (show content))
]
-- | The child's environment is the build environment plus the ambient
-- allowlist, nothing else. Proven behaviorally at both ends: an ambient
-- canary set in the test process must not reach a build, and the four
-- temp-directory names must all point at the same build-owned directory.
testScrubbedBuildEnvIO :: IO [Bool]
testScrubbedBuildEnvIO = do
putStrLn "builder/scrubbed-env"
withTempStore $ \store -> do
let storeDir = stDir store
probeDrv name suffix (builder, args) =
Derivation
{ drvOutputs =
[ DerivationOutput
{ doName = "out",
doPath = StorePath (T.replicate 31 "0" <> suffix) name,
doHashAlgo = "",
doHash = ""
}
],
drvInputDrvs = Map.empty,
drvInputSrcs = [],
drvPlatform = currentPlatform,
drvBuilder = builder,
drvArgs = args,
drvEnv = Map.empty
}
canaryDrv =
probeDrv "env-canary" "6" $
if SI.os == "mingw32"
then ("cmd.exe", ["/c", "echo %NOVA_NIX_TEST_CANARY%>%out%"])
else ("/bin/sh", ["-c", "echo \"${NOVA_NIX_TEST_CANARY-scrubbed}\" > $out"])
quartetDrv =
probeDrv "temp-quartet" "7" $
if SI.os == "mingw32"
then ("cmd.exe", ["/c", "if \"%TMPDIR%\"==\"%TEMPDIR%\" if \"%TMPDIR%\"==\"%TMP%\" if \"%TMPDIR%\"==\"%TEMP%\" if not \"%TMPDIR%\"==\"\" echo quartet-ok>%out%"])
else ("/bin/sh", ["-c", "[ -n \"$TMPDIR\" ] && [ \"$TMPDIR\" = \"$TEMPDIR\" ] && [ \"$TMPDIR\" = \"$TMP\" ] && [ \"$TMPDIR\" = \"$TEMP\" ] && echo quartet-ok > $out"])
buildTmp <- (</> "nova-nix-test-scrub-build-tmp") <$> getTemporaryDirectory
forceRemoveIfExists buildTmp
createDirectoryIfMissing True buildTmp
let config = (defaultBuildConfig storeDir) {bcTmpDir = buildTmp}
setEnv "NOVA_NIX_TEST_CANARY" "ambient-leak"
canaryResult <- buildDerivation config store canaryDrv
unsetEnv "NOVA_NIX_TEST_CANARY"
quartetResult <- buildDerivation config store quartetDrv
forceRemoveIfExists buildTmp
sequence
[ runTestM "an undeclared ambient variable does not reach a build" $
case canaryResult of
BuildFailure msg code -> pure (Fail ("build failed (exit " <> T.pack (show code) <> "): " <> msg))
BuildSuccess sp -> do
content <- TIO.readFile (storePathToFilePath storeDir sp)
pure $
if "ambient-leak" `T.isInfixOf` content
then Fail ("ambient canary leaked into the build: " <> T.pack (show content))
else Pass,
runTestM "all four temp names point at the build directory" $
case quartetResult of
BuildFailure msg code -> pure (Fail ("quartet disagreed or build failed (exit " <> T.pack (show code) <> "): " <> msg))
BuildSuccess sp -> do
content <- TIO.readFile (storePathToFilePath storeDir sp)
pure $
if "quartet-ok" `T.isInfixOf` content
then Pass
else Fail ("unexpected content: " <> T.pack (show content))
]
-- | Zstd compression level for test archives (zstd's own default).
testZstdCompressionLevel :: Int
testZstdCompressionLevel = 3
-- | Build a @.tar.zst@ archive from tar entries, MSYS2-package style.
compressArchive :: [TarEntry.Entry] -> BL.ByteString
compressArchive = ZstdL.compress testZstdCompressionLevel . Tar.write
-- | Test-setup helpers: the paths and link targets below are short literals,
-- so encoding them cannot fail; 'error' marks setup bugs, not test failures.
tarPathOrDie :: Bool -> FilePath -> TarEntry.TarPath
tarPathOrDie isDir p =
either (error . ("test tar path: " ++)) id (TarEntry.toTarPath isDir p)
linkOrDie :: FilePath -> TarEntry.LinkTarget
linkOrDie t =
fromMaybe (error ("test link target: " ++ t)) (TarEntry.toLinkTarget t)
tarDir :: FilePath -> TarEntry.Entry
tarDir p = TarEntry.directoryEntry (tarPathOrDie True p)
tarFile :: FilePath -> BL.ByteString -> TarEntry.Entry
tarFile p = TarEntry.fileEntry (tarPathOrDie False p)
tarExecFile :: FilePath -> BL.ByteString -> TarEntry.Entry
tarExecFile p content = (tarFile p content) {TarEntry.entryPermissions = 0o755}
tarHardLink :: FilePath -> FilePath -> TarEntry.Entry
tarHardLink p target =
TarEntry.simpleEntry (tarPathOrDie False p) (Tar.HardLink (linkOrDie target))
tarSymLink :: FilePath -> FilePath -> TarEntry.Entry
tarSymLink p target =
TarEntry.simpleEntry (tarPathOrDie False p) (Tar.SymbolicLink (linkOrDie target))
-- | Step 3 of the ladder: @builtin:unpack@, the stage-0 seed extractor.
-- Two zstd-compressed tar archives sharing a top-level prefix (the MSYS2
-- @mingw64\/@ shape) are extracted into ONE output: regular files, an
-- executable, a hardlink and a relative symlink (both materialized as
-- copies), with pacman metadata (@.PKGINFO@\/@.MTREE@) skipped. A second
-- build proves cross-archive file collisions fail loudly, and further builds
-- that a parent-climbing (..) entry and drive-rooted file, symlink, and
-- hardlink paths are all rejected.
testUnpackBuildIO :: IO [Bool]
testUnpackBuildIO = do
putStrLn "builder/unpack-seed-archives"
tmpBase0 <- getTemporaryDirectory
if ' ' `elem` tmpBase0
then do
-- The srcs env is space-separated by the derivation contract (store
-- paths never contain spaces), but these test archives live under
-- TEMP: a spaced TEMP would fragment the paths and fail spuriously.
putStrLn " SKIP unpack archive tests need a space-free TEMP dir"
pure []
else withTempStore $ \store -> do
let storeDir = stDir store
-- Archives live in the temp store under store-path names: the srcs
-- env is store paths by contract, and runBuiltinUnpack insists on
-- that now (#101) - each entry is parsed and rendered through the
-- build's store dir, which for these builds is the temp store.
let archiveFile name = storePathToFilePath storeDir (StorePath (T.replicate 32 "0") name)
archiveTools = archiveFile "pkg-tools.tar.zst"
archiveData = archiveFile "pkg-data.tar.zst"
archiveCollide = archiveFile "pkg-collide.tar.zst"
archiveEscape = archiveFile "pkg-escape.tar.zst"
archiveRootFile = archiveFile "pkg-root-file.tar.zst"
archiveEscapeSymlink = archiveFile "pkg-escape-symlink.tar.zst"
archiveEscapeHardlink = archiveFile "pkg-escape-hardlink.tar.zst"
archiveDirLink = archiveFile "pkg-dirlink.tar.zst"
archiveDirLinkBase = archiveFile "pkg-dirlink-base.tar.zst"
archiveDirLinkCollide = archiveFile "pkg-dirlink-collide.tar.zst"
archiveHardLinkCollide = archiveFile "pkg-hardlink-collide.tar.zst"
archiveManyEntries = archiveFile "pkg-many-entries.tar.zst"
archiveBigFile = archiveFile "pkg-big-file.tar.zst"
archiveAmplify = archiveFile "pkg-amplify.tar.zst"
BL.writeFile archiveTools $
compressArchive
[ tarDir "pkg",
tarDir "pkg/bin",
tarExecFile "pkg/bin/tool.exe" "tool-payload",
tarHardLink "pkg/bin/tool-link.exe" "pkg/bin/tool.exe",
tarSymLink "pkg/bin/sh.exe" "tool.exe",
tarFile ".PKGINFO" "pkgname = tools"
]
BL.writeFile archiveData $
compressArchive
[ tarDir "pkg",
tarDir "pkg/share",
tarFile "pkg/share/data.txt" "shared-data",
tarFile ".MTREE" "mtree-bytes"
]
BL.writeFile archiveCollide $
compressArchive [tarFile "pkg/bin/tool.exe" "conflicting"]
BL.writeFile archiveEscape $
compressArchive [tarFile "../evil.txt" "escape"]
-- A leading '/' entry: rooted at the current drive. tar stores paths with
-- '/', so this is the on-disk form even of a Windows-native "\..." name.
BL.writeFile archiveRootFile $
compressArchive [tarFile "/planted-abs.txt" "rooted-file"]
-- Escaping link targets: '..' climbs above the archive root. Unlike a
-- rooted ('/') target, this builds portably - tar's toLinkTarget accepts a
-- relative path on every host - so the real unpacker is exercised end to end.
BL.writeFile archiveEscapeSymlink $
compressArchive [tarSymLink "sneaky-link.txt" "../escape-link-target.txt"]
BL.writeFile archiveEscapeHardlink $
compressArchive [tarHardLink "sneaky-hardlink.txt" "../escape-hardlink-target.txt"]
-- A directory symlink entry with a fresh destination: materialized
-- by copying its target tree.
BL.writeFile archiveDirLink $
compressArchive
[ tarDir "realdir",
tarFile "realdir/g.txt" "dir-link-payload",
tarSymLink "dirlink" "realdir"
]
-- Collisions: the first archive already provides pkg/, and a later
-- archive's directory symlink/hardlink also lands at pkg. The
-- tree copy must hit the same collision guard as a regular entry,
-- not silently merge - the merged result would depend on entry
-- order.
BL.writeFile archiveDirLinkBase $
compressArchive [tarDir "pkg", tarFile "pkg/original.txt" "original"]
BL.writeFile archiveDirLinkCollide $
compressArchive
[ tarDir "smuggle",
tarFile "smuggle/extra.txt" "smuggled",
tarSymLink "pkg" "smuggle"
]
BL.writeFile archiveHardLinkCollide $
compressArchive
[ tarDir "smuggle",
tarFile "smuggle/extra.txt" "smuggled",
tarHardLink "pkg" "smuggle"
]
-- Budget probes, built against tiny caps injected via BuildConfig.
BL.writeFile archiveManyEntries $
compressArchive [tarFile ("e" <> show i <> ".txt") "x" | i <- [1 :: Int .. 6]]
BL.writeFile archiveBigFile $
compressArchive [tarFile "big.bin" (BL.replicate 100 55)]
-- Two directory symlinks each re-copy the 40-byte payload: the
-- copies must charge the budget like first-class content.
BL.writeFile archiveAmplify $
compressArchive
[ tarDir "base",
tarFile "base/blob.bin" (BL.replicate 40 55),
tarSymLink "dup1" "base",
tarSymLink "dup2" "base"
]
let -- srcs carries the canonical /nix/store spelling, as eval writes
-- it; the physical archives live under the temp store dir.
canonicalSrc file = case parseStorePath storeDir (T.pack file) of
Just sp -> storePathToText defaultStoreDir sp
Nothing -> T.pack file
mkUnpackDrv outP srcFiles =
Derivation
{ drvOutputs =
[ DerivationOutput
{ doName = "out",
doPath = outP,
doHashAlgo = "",
doHash = ""
}
],
drvInputDrvs = Map.empty,
drvInputSrcs = [],
drvPlatform = currentPlatform,
drvBuilder = builtinUnpackBuilder,
drvArgs = [],
drvEnv =
Map.fromList
[(envSrcs, TE.encodeUtf8 (T.intercalate " " (map canonicalSrc srcFiles)))]
}
seedOut = StorePath (T.replicate 31 "0" <> "2") "unpack-seed"
collideOut = StorePath (T.replicate 31 "0" <> "3") "unpack-collide"
escapeOut = StorePath (T.replicate 31 "0" <> "4") "unpack-escape"
rootFileOut = StorePath (T.replicate 31 "0" <> "5") "unpack-root-file"
escapeSymlinkOut = StorePath (T.replicate 31 "0" <> "6") "unpack-escape-symlink"
escapeHardlinkOut = StorePath (T.replicate 31 "0" <> "7") "unpack-escape-hardlink"
dirLinkOut = StorePath (T.replicate 31 "0" <> "8") "unpack-dirlink"
dirLinkCollideOut = StorePath (T.replicate 31 "0" <> "9") "unpack-dirlink-collide"
hardLinkCollideOut = StorePath (T.replicate 30 "0" <> "10") "unpack-hardlink-collide"
manyEntriesOut = StorePath (T.replicate 30 "0" <> "11") "unpack-entry-budget"
bigFileOut = StorePath (T.replicate 30 "0" <> "12") "unpack-size-budget"
amplifyOut = StorePath (T.replicate 30 "0" <> "13") "unpack-amplify-budget"
buildTmp <- (</> "nova-nix-test-unpack-build-tmp") <$> getTemporaryDirectory
forceRemoveIfExists buildTmp
createDirectoryIfMissing True buildTmp
let config = (defaultBuildConfig storeDir) {bcTmpDir = buildTmp}
seedResult <- buildDerivation config store (mkUnpackDrv seedOut [archiveTools, archiveData])
collideResult <- buildDerivation config store (mkUnpackDrv collideOut [archiveTools, archiveCollide])
escapeResult <- buildDerivation config store (mkUnpackDrv escapeOut [archiveEscape])
rootFileResult <- buildDerivation config store (mkUnpackDrv rootFileOut [archiveRootFile])
escapeSymlinkResult <- buildDerivation config store (mkUnpackDrv escapeSymlinkOut [archiveEscapeSymlink])
escapeHardlinkResult <- buildDerivation config store (mkUnpackDrv escapeHardlinkOut [archiveEscapeHardlink])
dirLinkResult <- buildDerivation config store (mkUnpackDrv dirLinkOut [archiveDirLink])
dirLinkCollideResult <- buildDerivation config store (mkUnpackDrv dirLinkCollideOut [archiveDirLinkBase, archiveDirLinkCollide])
hardLinkCollideResult <- buildDerivation config store (mkUnpackDrv hardLinkCollideOut [archiveDirLinkBase, archiveHardLinkCollide])
let tinyBudget bytes entries =
config {bcUnpackLimits = UnpackLimits {ulMaxBytes = bytes, ulMaxEntries = entries}}
manyEntriesResult <- buildDerivation (tinyBudget 1000000 4) store (mkUnpackDrv manyEntriesOut [archiveManyEntries])
bigFileResult <- buildDerivation (tinyBudget 64 1000) store (mkUnpackDrv bigFileOut [archiveBigFile])
amplifyResult <- buildDerivation (tinyBudget 100 1000) store (mkUnpackDrv amplifyOut [archiveAmplify])
forceRemoveIfExists buildTmp
seedChecks <- case seedResult of
BuildFailure msg code ->
sequence
[ runTest "unpack seed build succeeds" $
Fail ("build failed (exit " <> T.pack (show code) <> "): " <> msg)
]
BuildSuccess sp -> do
let outRoot = storePathToFilePath storeDir sp
readOut rel = do
let path = outRoot </> rel
exists <- Dir.doesFileExist path
if exists then Just <$> TIO.readFile path else pure Nothing
tool <- readOut ("pkg" </> "bin" </> "tool.exe")
toolLink <- readOut ("pkg" </> "bin" </> "tool-link.exe")
shLink <- readOut ("pkg" </> "bin" </> "sh.exe")
dataFile <- readOut ("pkg" </> "share" </> "data.txt")
pkgInfo <- Dir.doesFileExist (outRoot </> ".PKGINFO")
mtree <- Dir.doesFileExist (outRoot </> ".MTREE")
execBitOk <-
if SI.os == "mingw32"
then pure True -- NTFS has no exec bit; PATHEXT decides
else Dir.executable <$> getPermissions (outRoot </> "pkg" </> "bin" </> "tool.exe")
narInfo <- queryPathInfo (stDB store) sp
let realNarHash = case narInfo of
Just info ->
piNarSize info > 0 && T.isPrefixOf "sha256:" (piNarHash info)
Nothing -> False
sequence
[ runTest "unpack seed build succeeds" Pass,
runTest "unpack: file extracted with content" $
assertEqual "tool.exe" (Just "tool-payload") tool,
runTest "unpack: hardlink materialized as copy" $
assertEqual "tool-link.exe" (Just "tool-payload") toolLink,
runTest "unpack: relative symlink materialized as copy" $
assertEqual "sh.exe" (Just "tool-payload") shLink,
runTest "unpack: second archive merged into shared prefix" $
assertEqual "data.txt" (Just "shared-data") dataFile,
runTest "unpack: pacman metadata skipped" $
if pkgInfo || mtree
then Fail ".PKGINFO/.MTREE leaked into the output"
else Pass,
runTest "unpack: executable bit materialized (unix)" $
if execBitOk then Pass else Fail "tool.exe not executable",
runTest "unpack: real NAR hash registered" $
if realNarHash then Pass else Fail (T.pack (show narInfo))
]
collideChecks <-
sequence
[ runTest "unpack: cross-archive file collision fails loudly" $
case collideResult of
BuildFailure msg _
| "file collision" `T.isInfixOf` msg -> Pass
| otherwise -> Fail ("wrong failure: " <> msg)
BuildSuccess _ -> Fail "collision build unexpectedly succeeded"
]
escapeChecks <-
sequence
[ runTest "unpack: path traversal rejected" $
case escapeResult of
BuildFailure msg _
| "escapes archive root" `T.isInfixOf` msg -> Pass
| otherwise -> Fail ("wrong failure: " <> msg)
BuildSuccess _ -> Fail "escape build unexpectedly succeeded"
]
let rejectedWith needle res = case res of
BuildFailure msg _
| needle `T.isInfixOf` msg -> Pass
| otherwise -> Fail ("wrong failure: " <> msg)
BuildSuccess _ -> Fail "malicious entry unexpectedly built"
-- Integration: the real unpacker rejects a rooted entry path and an
-- escaping ('..') symlink/hardlink target, end to end.
maliciousChecks <-
sequence
[ runTest "unpack: rooted file entry rejected" $
rejectedWith "planted-abs.txt" rootFileResult,
runTest "unpack: escaping symlink target rejected" $
rejectedWith "escape-link-target.txt" escapeSymlinkResult,
runTest "unpack: escaping hardlink target rejected" $
rejectedWith "escape-hardlink-target.txt" escapeHardlinkResult
]
dirLinkChecks <- case dirLinkResult of
BuildFailure msg code ->
sequence
[ runTest "unpack: directory symlink materialized as copied tree" $
Fail ("build failed (exit " <> T.pack (show code) <> "): " <> msg)
]
BuildSuccess sp -> do
let outRoot = storePathToFilePath storeDir sp
linkedFile = outRoot </> "dirlink" </> "g.txt"
linkedExists <- Dir.doesFileExist linkedFile
outcome <-
if not linkedExists
then pure (Fail "dirlink/g.txt missing from the output")
else do
linked <- TIO.readFile linkedFile
-- The copy contract: a real directory, never a link (a
-- store link would need privilege and be machine-dependent).
isLink <- Dir.pathIsSymbolicLink (outRoot </> "dirlink")
pure $
if linked == "dir-link-payload" && not isLink
then Pass
else Fail ("content=" <> linked <> " isLink=" <> T.pack (show isLink))
sequence [runTest "unpack: directory symlink materialized as copied tree" outcome]
collisionGuardChecks <-
sequence
[ runTest "unpack: directory symlink onto existing content fails loudly" $
rejectedWith "file collision" dirLinkCollideResult,
runTest "unpack: directory hardlink onto existing content fails loudly" $
rejectedWith "file collision" hardLinkCollideResult
]
budgetChecks <-
sequence
[ runTest "unpack: entry budget breach fails loudly" $
rejectedWith "entry budget" manyEntriesResult,
runTest "unpack: size budget breach fails loudly" $
rejectedWith "size budget" bigFileResult,
runTest "unpack: directory link copies charge the budget" $
rejectedWith "size budget" amplifyResult
]
-- Unit: the rooted (drive-relative) case is the Blocker-4 Windows vuln.
-- tar's toLinkTarget refuses an absolute payload on POSIX, so exercise the
-- guard predicate directly - portable and exact on every host.
guardChecks <-
sequence
[ runTest "unpack guard: rooted entry path rejected" $
assertLeft "rooted entry" (entryComponents "/planted-abs.txt"),
runTest "unpack guard: rooted symlink target rejected" $
assertLeft "rooted symlink" (resolveLinkTarget [] "/planted-link-target.txt"),
runTest "unpack guard: rooted hardlink target rejected" $
assertLeft "rooted hardlink" (entryComponents "/planted-hardlink-target.txt")
]
pure (seedChecks ++ collideChecks ++ escapeChecks ++ maliciousChecks ++ dirLinkChecks ++ collisionGuardChecks ++ budgetChecks ++ guardChecks)
-- | Step 2 of the ladder: a dependency-aware build end-to-end. A root
-- derivation depends on a leaf; both @.drv@ files are pre-written to the store
-- (as the build driver's closure-writing does), and 'buildWithDeps' must read
-- the closure, topologically order it, build the leaf first, then the root -
-- whose 'validateInputs' requires the leaf's realized output to be valid.
--
-- This is the regression guard for the input-@.drv@-closure fix: before it, no
-- derivation with a non-empty @drvInputDrvs@ could be realized (the closure was
-- never on disk, so the dependency graph could not be read).
testDependentBuildIO :: IO [Bool]
testDependentBuildIO = do
putStrLn "builder/dependent-native-build"
withTempStore $ \store -> do
let storeDir = stDir store
depOut = StorePath (T.replicate 31 "c" <> "0") "dep"
depDrvSP = StorePath (T.replicate 31 "c" <> "1") "dep.drv"
rootOut = StorePath (T.replicate 31 "a" <> "0") "root"
rootDrvSP = StorePath (T.replicate 31 "a" <> "1") "root.drv"
mkBuilder word
| SI.os == "mingw32" = ("cmd.exe", ["/c", "echo " <> word <> ">%out%"])
| otherwise = ("/bin/sh", ["-c", "echo " <> word <> " > $out"])
(depBuilder, depArgs) = mkBuilder "leaf"
(rootBuilder, rootArgs) = mkBuilder "root"
depDrv =
Derivation
{ drvOutputs = [DerivationOutput {doName = "out", doPath = depOut, doHashAlgo = "", doHash = ""}],
drvInputDrvs = Map.empty,
drvInputSrcs = [],
drvPlatform = currentPlatform,
drvBuilder = depBuilder,
drvArgs = depArgs,
drvEnv = Map.singleton "name" "dep"
}
rootDrv =
Derivation
{ drvOutputs = [DerivationOutput {doName = "out", doPath = rootOut, doHashAlgo = "", doHash = ""}],
drvInputDrvs = Map.singleton depDrvSP ["out"],
drvInputSrcs = [],
drvPlatform = currentPlatform,
drvBuilder = rootBuilder,
drvArgs = rootArgs,
drvEnv = Map.singleton "name" "root"
}
-- The build driver writes the full .drv closure before building; emulate
-- that here by writing both recipes to the store.
writeDrv store depDrv depDrvSP
writeDrv store rootDrv rootDrvSP
buildTmp <- (</> "nova-nix-test-dep-build-tmp") <$> getTemporaryDirectory
forceRemoveIfExists buildTmp
createDirectoryIfMissing True buildTmp
let config = (defaultBuildConfig storeDir) {bcTmpDir = buildTmp}
result <- buildWithDeps config store rootDrv rootDrvSP
depValid <- isValid store depOut
rootValid <- isValid store rootOut
forceRemoveIfExists buildTmp
case result of
BuildSuccess sp ->
sequence
[ runTest "dependent build succeeds with root output" $
assertEqual "root output path" rootOut sp,
runTest "leaf dependency built and registered first" $
if depValid then Pass else Fail "leaf output not valid after build",
runTest "root output built and registered" $
if rootValid then Pass else Fail "root output not valid after build"
]
BuildFailure msg code ->
sequence
[ runTest "dependent build succeeds with root output" $
Fail ("dependency-aware build failed (exit " <> T.pack (show code) <> "): " <> msg)
]
-- | Upstream value-conformance tests: each pins exact output bytes (hash
-- decode, number formatting) that must match what upstream Nix computes for
-- the same input, because these values can reach names, derivations, and
-- hashes.
testUpstreamConformance :: IO [Bool]
testUpstreamConformance = do
putStrLn "eval/conformance"
let xmlDocument body = mkStr ("<?xml version='1.0' encoding='utf-8'?>\n<expr>\n" <> body <> "</expr>\n")
sequence
[ -- Hash decode is length-keyed per algorithm, never first-format-wins:
-- a 52-char all-hex-digit string is a nix32 sha256 hash (64 hex chars
-- after conversion), not a 26-byte hex string echoed back.
runTest "hash decode keys on nix32 length" $
assertEval
"hash-nix32-length"
"builtins.stringLength (builtins.convertHash { hash = \"0aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\"; hashAlgo = \"sha256\"; toHashFormat = \"base16\"; })"
(VInt 64),
runTest "hash hex to nix32 round-trips" $
assertEval
"hash-roundtrip"
"builtins.convertHash { hash = builtins.convertHash { hash = \"sha256:e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855\"; toHashFormat = \"nix32\"; }; hashAlgo = \"sha256\"; toHashFormat = \"base16\"; }"
(mkStr "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"),
runTest "hash base64 spelling decodes by length" $
assertEval
"hash-base64"
"builtins.convertHash { hash = \"sha256:47DEQpj8HBSa+/TImW+5JCeuQeRkm5NMpJWZG3hSuFU=\"; toHashFormat = \"base16\"; }"
(mkStr "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"),
runTest "truncated hash is rejected" $
assertEvalFail
"hash-truncated"
"builtins.convertHash { hash = \"e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b85\"; hashAlgo = \"sha256\"; toHashFormat = \"base16\"; }",
runTest "unknown hash algorithm is rejected" $
assertEvalFail
"hash-bad-algo"
"builtins.convertHash { hash = \"00\"; hashAlgo = \"sha3\"; toHashFormat = \"base16\"; }",
-- SRI digests get the same decoded-length check as every other
-- spelling (upstream checks SRI too), at all three decode sites:
-- convertHash, fixed-output outputHash, and the fetch/path pins.
runTest "valid SRI digest converts" $
assertEval
"hash-sri-valid"
"builtins.convertHash { hash = \"sha256-47DEQpj8HBSa+/TImW+5JCeuQeRkm5NMpJWZG3hSuFU=\"; toHashFormat = \"base16\"; }"
(mkStr "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"),
runTest "convertHash rejects a truncated SRI digest" $
case evalNix "builtins.convertHash { hash = \"sha256-YWJj\"; toHashFormat = \"base16\"; }" of
Left err
| "wrong length" `T.isInfixOf` err -> Pass
| otherwise -> Fail ("expected an SRI length error, got: " <> err)
Right val -> Fail ("expected failure, got: " <> T.pack (show val)),
runTest "fixed-output outputHash rejects a truncated SRI digest" $
case evalNix "(derivation { name = \"t\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; outputHash = \"sha256-YWJj\"; }).drvPath" of
Left err
| "wrong length" `T.isInfixOf` err -> Pass
| otherwise -> Fail ("expected an SRI length error, got: " <> err)
Right val -> Fail ("expected failure, got: " <> T.pack (show val)),
-- An SRI or prefixed outputHash carries its own algorithm tag; a
-- non-empty outputHashAlgo must agree with it (hash.cc parseAny
-- with an expected type), and an unknown declared algorithm is an
-- error even when the spelling carries a valid tag of its own.
runTest "fixed-output SRI algorithm must match outputHashAlgo" $
case evalNix "(derivation { name = \"t\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; outputHash = \"sha1-2jmj7l5rSw0yVb/vlWAYkK/YBwk=\"; outputHashAlgo = \"sha256\"; }).drvPath" of
Left err
| "should have type 'sha256'" `T.isInfixOf` err -> Pass
| otherwise -> Fail ("expected a hash-type error, got: " <> err)
Right val -> Fail ("expected failure, got: " <> T.pack (show val)),
runTest "fixed-output prefixed algorithm must match outputHashAlgo" $
case evalNix "(derivation { name = \"t\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; outputHash = \"md5:d41d8cd98f00b204e9800998ecf8427e\"; outputHashAlgo = \"sha256\"; }).drvPath" of
Left err
| "should have type 'sha256'" `T.isInfixOf` err -> Pass
| otherwise -> Fail ("expected a hash-type error, got: " <> err)
Right val -> Fail ("expected failure, got: " <> T.pack (show val)),
runTest "fixed-output SRI agreeing with outputHashAlgo accepted" $
case evalNix "(derivation { name = \"t\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; outputHash = \"sha256-47DEQpj8HBSa+/TImW+5JCeuQeRkm5NMpJWZG3hSuFU=\"; outputHashAlgo = \"sha256\"; }).drvPath" of
Right _ -> Pass
Left err -> Fail ("expected success, got: " <> err),
runTest "fixed-output unknown outputHashAlgo rejected despite SRI tag" $
case evalNix "(derivation { name = \"t\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; outputHash = \"sha256-47DEQpj8HBSa+/TImW+5JCeuQeRkm5NMpJWZG3hSuFU=\"; outputHashAlgo = \"sha3\"; }).drvPath" of
Left err
| "unknown hash algorithm" `T.isInfixOf` err -> Pass
| otherwise -> Fail ("expected an unknown-algorithm error, got: " <> err)
Right val -> Fail ("expected failure, got: " <> T.pack (show val)),
runTest "builtins.path pin rejects a truncated SRI digest" $
case evalNix "builtins.path { path = ./x; sha256 = \"sha256-YWJj\"; }" of
Left err
| "wrong length" `T.isInfixOf` err -> Pass
| otherwise -> Fail ("expected an SRI length error, got: " <> err)
Right val -> Fail ("expected failure, got: " <> T.pack (show val)),
runTest "builtins.path pin rejects a non-sha256 SRI digest" $
case evalNix ("builtins.path { path = ./x; sha256 = \"sha512-" <> T.replicate 86 "A" <> "==\"; }") of
Left err
| "should have type 'sha256'" `T.isInfixOf` err -> Pass
| otherwise -> Fail ("expected a hash-type error, got: " <> err)
Right val -> Fail ("expected failure, got: " <> T.pack (show val)),
-- toJSON floats: nlohmann's layout - shortest round-trip digits, .0
-- kept on integral values, scientific outside point positions (-4, 15].
runTest "toJSON float shortest digits" $
assertEval "json-float-third" "builtins.toJSON (1.0 / 3.0)" (mkStr "0.3333333333333333"),
runTest "toJSON integral float keeps .0" $
assertEval "json-float-integral" "builtins.toJSON 100.0" (mkStr "100.0"),
runTest "toJSON float plain decimal" $
assertEval "json-float-tenth" "builtins.toJSON 0.1" (mkStr "0.1"),
runTest "toJSON float zero" $
assertEval "json-float-zero" "builtins.toJSON 0.0" (mkStr "0.0"),
runTest "toJSON float widest plain integral" $
assertEval "json-float-e14" "builtins.toJSON 1.0e14" (mkStr "100000000000000.0"),
runTest "toJSON float first scientific integral" $
assertEval "json-float-e15" "builtins.toJSON 1.0e15" (mkStr "1e+15"),
runTest "toJSON float large exponent" $
assertEval "json-float-e21" "builtins.toJSON 1.0e21" (mkStr "1e+21"),
runTest "toJSON float negative exponent" $
assertEval "json-float-e-5" "builtins.toJSON 1.0e-5" (mkStr "1e-05"),
runTest "toJSON float smallest plain" $
assertEval "json-float-e-4" "builtins.toJSON 1.0e-4" (mkStr "0.0001"),
runTest "toJSON non-finite float is null" $
assertEval "json-float-inf" "builtins.toJSON (1.0e308 * 10.0)" (mkStr "null"),
-- fromJSON integers: int64 range stays int, wider falls back to float.
runTest "fromJSON promotes past-64-bit integer to float" $
assertEval "json-bigint-type" "builtins.typeOf (builtins.fromJSON \"999999999999999999999\")" (mkStr "float"),
runTest "fromJSON past-64-bit integer value" $
assertEval "json-bigint-val" "builtins.fromJSON \"999999999999999999999\" == 999999999999999999999.0" (VBool True),
runTest "fromJSON int64 max stays an int" $
assertEval "json-int64-max" "builtins.fromJSON \"9223372036854775807\"" (VInt 9223372036854775807),
-- toXML floats: C++ default ostream formatting, 6 significant digits.
runTest "toXML float 6 significant digits" $
assertEval
"xml-float-third"
"builtins.toXML (1.0 / 3.0)"
(xmlDocument " <float value=\"0.333333\" />\n"),
runTest "toXML float plain decimal" $
assertEval
"xml-float-centi"
"builtins.toXML 0.01"
(xmlDocument " <float value=\"0.01\" />\n"),
runTest "toXML integral float drops the point" $
assertEval
"xml-float-integral"
"builtins.toXML 100.0"
(xmlDocument " <float value=\"100\" />\n"),
runTest "toXML float large exponent" $
assertEval
"xml-float-e21"
"builtins.toXML 1.0e21"
(xmlDocument " <float value=\"1e+21\" />\n"),
runTest "toXML float small exponent" $
assertEval
"xml-float-e-5"
"builtins.toXML 2.5e-5"
(xmlDocument " <float value=\"2.5e-05\" />\n"),
-- The document is upstream's XMLWriter output (value-to-xml.cc and
-- xml-writer.cc at 2.24.9): every element two spaces deeper than the
-- one around it, a newline in a value written as a character
-- reference. Each expected document is nix-instantiate 2.24.9's and
-- 2.33.2's (#221).
runTest "toXML indents each element under the one around it" $
assertEval
"xml-nesting"
"builtins.toXML { s = \"a<b>&\\\"q'\\n\\tz\"; l = [ 1 { } ]; }"
( xmlDocument
( " <attrs>\n <attr name=\"l\">\n <list>\n <int value=\"1\" />\n"
<> " <attrs>\n </attrs>\n </list>\n </attr>\n"
<> " <attr name=\"s\">\n <string value=\"a<b>&"q'
\tz\" />\n"
<> " </attr>\n </attrs>\n"
)
),
runTest "toXML writes a lambda's argument pattern and leaves a primop unevaluated" $
assertEval
"xml-functions"
"builtins.toXML [ (x: x) (args@{ z, ... }: 1) ({ b, a }: a) builtins.map (builtins.map (x: x)) ]"
( xmlDocument
( " <list>\n <function>\n <varpat name=\"x\" />\n </function>\n"
<> " <function>\n <attrspat ellipsis=\"1\" name=\"args\">\n <attr name=\"z\" />\n"
<> " </attrspat>\n </function>\n"
<> " <function>\n <attrspat>\n <attr name=\"a\" />\n <attr name=\"b\" />\n"
<> " </attrspat>\n </function>\n"
<> " <unevaluated />\n <unevaluated />\n </list>\n"
)
),
runTest "toXML writes a derivation in full once and repeated after" $
assertEval
"xml-derivations"
"builtins.toXML [ { type = \"derivation\"; drvPath = \"/p\"; outPath = \"/o\"; a = 1; } { type = \"derivation\"; drvPath = \"/p\"; } { type = \"derivation\"; outPath = 2; } ]"
( xmlDocument
( " <list>\n <derivation drvPath=\"/p\" outPath=\"/o\">\n"
<> " <attr name=\"a\">\n <int value=\"1\" />\n </attr>\n"
<> " <attr name=\"drvPath\">\n <string value=\"/p\" />\n </attr>\n"
<> " <attr name=\"outPath\">\n <string value=\"/o\" />\n </attr>\n"
<> " <attr name=\"type\">\n <string value=\"derivation\" />\n </attr>\n"
<> " </derivation>\n"
<> " <derivation drvPath=\"/p\">\n <repeated />\n </derivation>\n"
<> " <derivation>\n <repeated />\n </derivation>\n </list>\n"
)
),
runTest "toXML keeps the contexts of the strings it writes" $
assertEval
"xml-context"
"let d = derivation { name = \"x\"; system = \"s\"; builder = \"b\"; }; in builtins.getContext (builtins.toXML { s = \"${d}\"; }) == builtins.getContext \"${d}\""
(VBool True),
-- fromTOML integers: 64-bit signed range enforced, no silent wrap.
runTest "fromTOML rejects past-64-bit integer" $
assertEvalFail "toml-int-overflow" "builtins.fromTOML \"v = 99999999999999999999\"",
runTest "fromTOML rejects past-64-bit hex integer" $
assertEvalFail "toml-hex-overflow" "builtins.fromTOML \"v = 0xffffffffffffffff\"",
runTest "fromTOML int64 max parses" $
assertEval "toml-int64-max" "(builtins.fromTOML \"v = 9223372036854775807\").v" (VInt 9223372036854775807),
runTest "fromTOML int64 min parses" $
assertEval "toml-int64-min" "(builtins.fromTOML \"v = -9223372036854775808\").v == (0 - 9223372036854775807 - 1)" (VBool True),
-- drv3: pure eval cannot read the store, so hashing a dependent
-- derivation fails loudly rather than emitting a guessed input hash.
runTest "dependent derivation drvPath fails loudly in pure eval" $
assertEvalFail
"drv-modulo-pure-miss"
"let dep = derivation { name = \"dep\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }; main = derivation { name = \"main\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; src = dep.outPath; }; in main.drvPath",
-- Path values canonicalize lexically (CanonPath): no dot segment or
-- doubled separator survives into a path value's text, so different
-- spellings of the same path compare equal.
runTest "path literal canonicalizes dot segments" $
assertEval "path-canon-dot" "builtins.toString ./. == builtins.toString ./x/.." (VBool True),
runTest "path literal collapses inner dot" $
assertEval "path-canon-inner" "builtins.toString ./a/./b == builtins.toString ./a/b" (VBool True),
runTest "path plus string canonicalizes" $
assertEval "path-canon-plus" "./a + \"/../b\" == ./b" (VBool True),
runTest "toPath canonicalizes" $
assertEval "path-canon-topath" "builtins.toString (builtins.toPath \"/a/../b\")" (mkStr "/b"),
runTest "toPath collapses inner dot" $
assertEval "path-canon-topath-dot" "builtins.toString (builtins.toPath \"/a/./b\")" (mkStr "/a/b"),
runTest "toPath preserves forward-slash root" $
assertEval "path-canon-topath-root" "builtins.toString (builtins.toPath \"//nix//store\")" (mkStr "/nix/store")
]
-- | Eval-fidelity regression tests: each pins a semantic where the evaluator
-- must match upstream Nix. All are parity-safe - none affects a derivation
-- or store-path hash.
testEvalFidelity :: IO [Bool]
testEvalFidelity = do
putStrLn "eval/fidelity"
sequence
[ -- builtins.match: a non-participating capture group is null, not ""
runTest "match null capture group" $
assertEval "match-null" "builtins.isNull (builtins.elemAt (builtins.match \"(a)(b)?\" \"a\") 1)" (VBool True),
runTest "match participating group value" $
assertEval "match-val" "builtins.elemAt (builtins.match \"(a)(b)\" \"ab\") 1" (mkStr "b"),
-- builtins.split: a non-participating group is null too
runTest "split null capture group" $
assertEval "split-null" "builtins.isNull (builtins.elemAt (builtins.elemAt (builtins.split \"(a)|(b)\" \"a\") 1) 1)" (VBool True),
-- builtins.match is whole-string like regex_match: top-level
-- alternation must not decay into a prefix/suffix match.
runTest "match alternation is whole-string" $
assertEval "match-alt" "builtins.match \"a|b\" \"ab\"" VNull,
runTest "match alternation positive" $
assertEval "match-alt-pos" "builtins.match \"a|b\" \"a\" == [ ]" (VBool True),
-- No multiline mode: ^/$ anchor only at the string boundaries and
-- '.' matches a newline, as POSIX ERE whole-string matching does.
runTest "match does not anchor at inner newlines" $
assertEval "match-nl" "builtins.match \"foo\" \"bar\\nfoo\"" VNull,
runTest "match dot spans newline" $
assertEval "match-dot-nl" "builtins.match \"(.*)\" \"a\\nb\" == [ \"a\\nb\" ]" (VBool True),
runTest "split dot spans newline" $
assertEval "split-dot-nl" "builtins.split \"a.b\" \"xa\\nby\" == [ \"x\" [ ] \"y\" ]" (VBool True),
-- Derivations compare by outPath alone (C++ eqValues special case) -
-- even when the rest of the attrs (or the key sets) differ.
runTest "derivation eq by outPath" $
assertEval
"drv-eq"
"{ type = \"derivation\"; outPath = \"/nix/store/a\"; f = (x: x); } == { type = \"derivation\"; outPath = \"/nix/store/a\"; f = (y: y); extra = 1; }"
(VBool True),
runTest "derivation neq by outPath" $
assertEval
"drv-neq"
"{ type = \"derivation\"; outPath = \"/a\"; } == { type = \"derivation\"; outPath = \"/b\"; }"
(VBool False),
runTest "derivation-tagged sets without outPath deep-compare" $
assertEval
"drv-no-outpath"
"{ type = \"derivation\"; n = 1; } == { type = \"derivation\"; n = 1; }"
(VBool True),
-- A throwing derivation attr fails evaluation - never a silent drop
-- (a dropped attr once produced an empty no-input .drv that "built").
runTest "derivation attr throw propagates" $
assertEvalFail "drv-throw" "(derivation { name = \"x\"; system = \"s\"; builder = \"/b\"; src = throw \"boom\"; }).drvPath",
-- __ignoreNulls drops null attrs; without it null coerces to "".
runTest "derivation ignoreNulls drops null" $
assertEval "drv-ignore-nulls" "builtins.isString (derivation { name = \"x\"; system = \"s\"; builder = \"/b\"; src = null; __ignoreNulls = true; }).drvPath" (VBool True),
runTest "derivation null coerces without ignoreNulls" $
assertEval "drv-null-empty" "builtins.isString (derivation { name = \"x\"; system = \"s\"; builder = \"/b\"; foo = null; }).drvPath" (VBool True),
-- A literal string key is static, as in upstream's parser: legal in
-- let, referenceable as a rec sibling.
runTest "let with literal string key" $
assertEval "let-string-key" "let \"x\" = 1; in x" (VInt 1),
runTest "rec string key is a referenceable sibling" $
assertEval "rec-string-key" "(rec { \"a\" = 1; b = a; }).b" (VInt 1),
-- A dynamic TOP-LEVEL key in let is a parse error upstream; nested
-- dynamic keys live in a nested attrset and stay legal.
runTest "dynamic key in let rejected" $
assertParseFail "let-dyn-key" "let k = \"y\"; in let ${k} = 1; in y",
runTest "interpolated string key in let rejected" $
assertParseFail "let-interp-key" "let k = \"y\"; in let \"${k}\" = 1; in y",
runTest "nested dynamic key in let allowed" $
assertEval "let-nested-dyn" "let k = \"q\"; in let a.${k} = 1; in a.q" (VInt 1),
-- Nested interpolated strings inside braces: the lexer's brace-depth
-- stack must restore the enclosing count when an interpolation
-- closes, or the outer attrset's '}' mislexes as TokInterpClose.
runTest "nested interpolated string inside attrset braces" $
assertEval "nested-interp" "let y = \"v\"; in \"${ { a = \"${y}\"; }.a }\"" (mkStr "v"),
runTest "nested interpolation in indented string" $
assertEval "nested-interp-ind" "let y = \"w\"; in ''pre ${ { a = ''${y}''; }.a } post''" (mkStr "pre w post"),
runTest "doubly nested interpolated strings" $
assertEval "nested-interp-2" "let y = \"z\"; in \"${ { a = \"${ { b = \"${y}\"; }.b }\"; }.a }\"" (mkStr "z"),
-- Attrpath merging (upstream parser.y addAttr): a literal set and a
-- nested path under the same key merge; genuine duplicates error.
runTest "literal set merges with attrpath (kept attr)" $
assertEval "merge-keep" "{ a = { b = 1; }; a.c = 2; }.a.b" (VInt 1),
runTest "literal set merges with attrpath (added attr)" $
assertEval "merge-add" "{ a = { b = 1; }; a.c = 2; }.a.c" (VInt 2),
runTest "duplicate plain key is a parse error" $
assertParseFail "dup-key" "{ a = 1; a = 2; }",
runTest "duplicate formal is rejected" $
assertParseFail "dup-formal" "{ a, a }: a",
runTest "duplicate formal with defaults is rejected" $
assertParseFail "dup-formal-default" "{ a ? 1, a ? 2 }: a",
runTest "duplicate inner key on merge is an error" $
assertParseFail "dup-inner" "{ a.b = 1; a = { b = 2; }; }",
runTest "inherit conflicting with a definition is an error" $
assertParseFail "dup-inherit" "let q = 1; in { inherit q; q = 2; }",
runTest "attrpath into a non-set is an error" $
assertParseFail "merge-non-set" "{ a = 1; a.b = 2; }",
-- rec markers in attrpath merging follow upstream's addAttr: the
-- existing set's marker governs the result; the new set's marker is
-- discarded.
runTest "merge into rec literal keeps rec (sibling visible)" $
assertEval "merge-rec-keep" "{ a = rec { b = 1; }; a.c = b; }.a.c" (VInt 1),
runTest "merged-in rec marker is discarded (outer binding wins)" $
assertEval "merge-rec-discard" "let d = 7; in { a = { x = 1; }; a = rec { c = d; }; }.a.c" (VInt 7),
-- Exactly upstream's unprefixed global surface: fetchurl and toFile
-- exist only under builtins.
runTest "bare fetchurl is not a global" $
assertEvalFail "no-bare-fetchurl" "fetchurl",
runTest "bare toFile is not a global" $
assertEvalFail "no-bare-tofile" "toFile",
-- Dynamic keys colliding with an existing attr are an eval error,
-- never a silent last-win merge.
runTest "dynamic key colliding with static errors" $
assertEvalFail "dyn-collide" "{ b = 1; ${\"b\"} = 2; }",
runTest "rec dynamic key colliding with static errors" $
assertEvalFail "dyn-collide-rec" "rec { b = 1; p.q = 1; ${\"b\"} = 2; }",
-- Higher-order list builtins pass elements as unforced thunks: an
-- element the function never inspects may throw without failing.
runTest "filter does not force elements" $
assertEval "filter-lazy" "builtins.length (builtins.filter (x: true) [ (builtins.throw \"never\") ])" (VInt 1),
runTest "any does not force undecided elements" $
assertEval "any-lazy" "builtins.any (x: x) [ true (builtins.throw \"never\") ]" (VBool True),
runTest "foldl' passes elements unforced" $
assertEval "foldl-lazy" "builtins.foldl' (a: b: a) 0 [ (builtins.throw \"never\") ]" (VInt 0),
-- Attrset equality stops at the first mismatch; later pairs are
-- never forced.
runTest "attrset eq short-circuits" $
assertEval "eq-short" "{ a = 1; b = builtins.throw \"never\"; } == { a = 2; b = builtins.throw \"never\"; }" (VBool False),
-- toString of a float is std::to_string's fixed 6 decimals; value
-- printing and toJSON keep the trimmed form.
runTest "toString float has fixed 6 decimals" $
assertEval "tostr-float" "builtins.toString 1.5" (mkStr "1.500000"),
runTest "toJSON float stays trimmed" $
assertEval "tojson-float" "builtins.toJSON 1.5" (mkStr "1.5"),
-- path + string-with-context is an error (a store-path reference
-- cannot survive inside a path value).
runTest "path plus string with context errors" $
assertEvalFail "path-ctx" "./x + (derivation { name = \"q\"; system = \"s\"; builder = \"/b\"; }).drvPath",
-- builtins.toJSON honors __toString, preferring it over outPath
runTest "toJSON __toString" $
assertEval "tojson-tostr" "builtins.toJSON { __toString = self: \"x\"; }" (mkStr "\"x\""),
runTest "toJSON __toString beats outPath" $
assertEval "tojson-tostr-out" "builtins.toJSON { __toString = self: \"a\"; outPath = \"/b\"; }" (mkStr "\"a\""),
runTest "toJSON outPath still works" $
assertEval "tojson-out" "builtins.toJSON { outPath = \"/b\"; }" (mkStr "\"/b\""),
-- String interpolation is strict (coerceMore = False): scalars error
runTest "interp rejects int" $
assertEvalFail "interp-int" "\"v${1}\"",
runTest "interp rejects bool" $
assertEvalFail "interp-bool" "\"${true}\"",
runTest "interp rejects null" $
assertEvalFail "interp-null" "\"${null}\"",
runTest "concatStringsSep rejects int" $
assertEvalFail "ccs-int" "builtins.concatStringsSep \",\" [ 1 2 ]",
-- builtins.toString stays permissive
runTest "toString still coerces int" $
assertEval "tostr-int" "builtins.toString 1" (mkStr "1"),
runTest "interp via toString works" $
assertEval "interp-tostr" "\"v${builtins.toString 1}\"" (mkStr "v1"),
-- builtins.substring rejects a negative start position
runTest "substring negative start errors" $
assertEvalFail "substr-neg" "builtins.substring (0 - 1) 3 \"hello\"",
-- an integer literal that overflows Int64 is a parse error, not a wrap
runTest "integer literal overflow errors" $
assertParseFail "int-overflow" "99999999999999999999",
-- float exponents and leading-dot floats lex per the Nix grammar
runTest "float exponent lexes as float" $
assertEval "float-exp-type" "builtins.typeOf 6.022e23" (mkStr "float"),
runTest "float negative exponent lexes" $
assertEval "float-negexp-type" "builtins.typeOf 1.0e-3" (mkStr "float"),
runTest "float exponent value" $
assertEval "float-exp-val" "1.5e1 == 15.0" (VBool True),
runTest "leading-dot float lexes as float" $
assertEval "leading-dot-type" "builtins.typeOf .5" (mkStr "float"),
runTest "leading-dot float value" $
assertEval "leading-dot-val" ".5 == 0.5" (VBool True),
-- PureEval tryEval must NOT catch abort - it propagates (matches C++ Nix)
runTest "tryEval does not catch abort" $
assertEvalFail "tryeval-abort" "(builtins.tryEval (builtins.abort \"x\")).success",
-- every builtin in the registry (the source of builtinNames/builtinArity)
-- is actually exposed in the builtins set - guards against builtinRegistry
-- drifting from the exposed builtins
runTest "every registered builtin is exposed" $
let missing = [n | n <- builtinNames, evalNix ("builtins ? \"" <> n <> "\"") /= Right (VBool True)]
in if null missing then Pass else Fail ("not exposed: " <> T.intercalate ", " missing)
]
-- | Pure hash decode/digest helpers shared by eval (fixed-output paths) and
-- the builder (builtin:fetchurl verification).
testHashHelpers :: IO [Bool]
testHashHelpers = do
putStrLn "hash/decode-helpers"
sequence
[ -- The incremental digest is the streaming twin of the one-shot:
-- chunked input must produce identical bytes for every algorithm.
runTest "incremental digest matches one-shot across algorithms" $
let chunks = ["nova", "-", "nix", " streams", BS.replicate 1000 55]
agrees algo = case (Hash.hashInitWithAlgo algo, Hash.rawHashWithAlgo algo (BS.concat chunks)) of
(Just ctx0, Just expected) ->
Hash.hashFinalizeBytes (foldl' Hash.hashUpdateChunk ctx0 chunks) == expected
_ -> False
in if all agrees ["sha256", "sha512", "sha1", "md5"]
then Pass
else Fail "incremental and one-shot digests disagree",
runTest "incremental digest rejects an unknown algorithm" $
case Hash.hashInitWithAlgo "blake3" of
Nothing -> Pass
Just _ -> Fail "unknown algorithm accepted",
runTest "hexToBytes empty" $ assertEqual "empty" (Just BS.empty) (Hash.hexToBytes ""),
runTest "hexToBytes deadbeef" $
assertEqual "deadbeef" (Just (BS.pack [0xde, 0xad, 0xbe, 0xef])) (Hash.hexToBytes "deadbeef"),
runTest "hexToBytes uppercase" $
assertEqual "DEADBEEF" (Just (BS.pack [0xde, 0xad, 0xbe, 0xef])) (Hash.hexToBytes "DEADBEEF"),
runTest "hexToBytes odd length rejected" $ assertEqual "odd" Nothing (Hash.hexToBytes "abc"),
runTest "hexToBytes non-hex rejected" $ assertEqual "nonhex" Nothing (Hash.hexToBytes "zz"),
runTest "rawHashWithAlgo sha256 empty == known vector" $
assertEqual
"sha256-empty"
(Hash.hexToBytes "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855")
(Hash.rawHashWithAlgo "sha256" BS.empty),
runTest "rawHashWithAlgo unknown algo rejected" $
assertEqual "unknown" Nothing (Hash.rawHashWithAlgo "sha3-256" (BS.pack [1, 2, 3])),
-- verifyFetchHash: the composed builtin:fetchurl integrity gate that
-- guards every fixed-output seed fetch
runTest "verifyFetchHash accepts a matching flat hash" $
assertEqual
"fetch-hash-ok"
(Right ())
(verifyFetchHash "https://x/f.tar.gz" (fetchOut "sha256" sha256Hello) "hello"),
runTest "verifyFetchHash rejects mismatched bytes" $
case verifyFetchHash "https://x/f.tar.gz" (fetchOut "sha256" sha256Hello) "world" of
Left (_, msg) | "hash mismatch" `T.isInfixOf` msg -> Pass
other -> Fail ("expected mismatch rejection, got: " <> T.pack (show other)),
runTest "verifyFetchHash rejects a malformed expected hash" $
case verifyFetchHash "https://x/f" (fetchOut "sha256" "zz-not-hex") "hello" of
Left (_, msg) | "malformed expected hash" `T.isInfixOf` msg -> Pass
other -> Fail ("expected malformed-hash rejection, got: " <> T.pack (show other)),
runTest "verifyFetchHash rejects an unsupported algorithm" $
case verifyFetchHash "https://x/f" (fetchOut "sha3-256" "00") "hello" of
Left (_, msg) | "unsupported hash algorithm" `T.isInfixOf` msg -> Pass
other -> Fail ("expected unsupported-algo rejection, got: " <> T.pack (show other)),
runTest "verifyFetchHash rejects recursive mode rather than comparing flat" $
case verifyFetchHash "https://x/f" (fetchOut "r:sha256" sha256Hello) "hello" of
Left (_, msg) | "recursive" `T.isInfixOf` msg -> Pass
other -> Fail ("expected recursive-mode rejection, got: " <> T.pack (show other))
]
where
-- sha256 of the ASCII bytes "hello".
sha256Hello = "2cf24dba5fb0a30e26e83b2ac5b9e29e1b161e5c1fa7425e73043362938b9824"
fetchOut algo hash =
DerivationOutput
{ doName = "out",
doPath = StorePath (T.replicate 32 "f") "fetched",
doHashAlgo = algo,
doHash = hash
}
-- ---------------------------------------------------------------------------
-- Tests: NAR and hash known-answer vectors
-- ---------------------------------------------------------------------------
-- | Encode one NAR string per the spec: little-endian u64 length, the
-- bytes, zero-padding to the next 8-byte boundary. Written here from the
-- format definition, deliberately independent of nova-cache's encoder, so
-- these vectors pin the wire layout rather than the library against
-- itself.
narSpecStr :: BS.ByteString -> BS.ByteString
narSpecStr s = lenLE <> s <> padding
where
n = BS.length s
lenLE = BS.pack [fromIntegral ((n `shiftR` (8 * i)) .&. 0xff) | i <- [0 .. 7]]
padding = BS.replicate ((8 - n `mod` 8) `mod` 8) 0
-- | Hand-encoded NAR of a directory holding an executable, a plain file,
-- and a symlink - covering entry ordering, the executable marker, content
-- padding, and all node kinds.
narSpecVector :: BS.ByteString
narSpecVector =
BS.concat $
map
narSpecStr
[ "nix-archive-1",
"(",
"type",
"directory",
"entry",
"(",
"name",
"bin",
"node",
"(",
"type",
"directory",
"entry",
"(",
"name",
"tool",
"node",
"(",
"type",
"regular",
"executable",
"",
"contents",
"#!x",
")",
")",
")",
")",
"entry",
"(",
"name",
"data.txt",
"node",
"(",
"type",
"regular",
"contents",
"hello\n",
")",
")",
"entry",
"(",
"name",
"link",
"node",
"(",
"type",
"symlink",
"target",
"data.txt",
")",
")",
")"
]
-- | The in-memory tree 'narSpecVector' encodes.
narSpecTree :: NAR.NarEntry
narSpecTree =
NAR.NarDirectory
[ ("bin", NAR.NarDirectory [("tool", NAR.NarRegular True "#!x")]),
("data.txt", NAR.NarRegular False "hello\n"),
("link", NAR.NarSymlink "data.txt")
]
-- | Hand-encoded NAR of just @data.txt@, for the on-disk addToStore vector.
-- No executable entry, so the vector stays a fixture for addToStore rather
-- than for the exec bit; 'testExecBit' covers that on both platforms.
narSpecFileVector :: BS.ByteString
narSpecFileVector =
BS.concat $
map
narSpecStr
[ "nix-archive-1",
"(",
"type",
"directory",
"entry",
"(",
"name",
"data.txt",
"node",
"(",
"type",
"regular",
"contents",
"hello\n",
")",
")",
")"
]
-- | fromTOML: multi-line values (the Cargo.lock shapes) and comment
-- placement relative to strings.
testFromTOML :: IO [Bool]
testFromTOML = do
putStrLn "eval/fromTOML"
sequence
[ -- Key splitting and logical-line joining accumulate in chunks, so
-- cost is linear in the input (per-character/per-line append was
-- quadratic). The watchdog turns a cost regression into a FAIL
-- rather than a stuck suite.
runTestM "fromTOML long key parses in linear time" $ do
let source =
"builtins.length (builtins.attrNames (builtins.fromTOML \""
<> T.replicate 200000 "k"
<> " = 1\"))"
counted = evalNix source == Right (VInt 1)
outcome <- timeout walkWatchdogMicros (evaluate counted)
pure $ case outcome of
Just True -> Pass
Just False -> Fail "wrong parse for a long key"
Nothing -> Fail "long key did not parse promptly",
runTestM "fromTOML many continued lines join in linear time" $ do
-- 4000 physical lines of 50 elements each: one ~400KB logical
-- line, one 200000-element array.
let line = T.intercalate " " (replicate 50 "1,")
body = "x = [\n" <> T.intercalate "\n" (replicate 4000 line) <> "\n]"
source = "builtins.length (builtins.fromTOML \"" <> body <> "\").x"
counted = evalNix source == Right (VInt 200000)
outcome <- timeout walkWatchdogMicros (evaluate counted)
pure $ case outcome of
Just True -> Pass
Just False -> Fail "wrong parse for continued lines"
Nothing -> Fail "continued lines did not join promptly",
runTest "multi-line array" $
assertEval
"toml-ml-array"
"builtins.concatStringsSep \",\" (builtins.fromTOML \"deps = [\\n \\\"bar\\\",\\n \\\"baz\\\",\\n]\\n\").deps"
(mkStr "bar,baz"),
runTest "Cargo.lock package shape" $
assertEval
"toml-cargo-lock"
"(builtins.elemAt (builtins.fromTOML \"[[package]]\\nname = \\\"foo\\\"\\ndependencies = [\\n \\\"bar\\\",\\n]\\n\").package 0).name"
(mkStr "foo"),
runTest "multi-line basic string" $
assertEval
"toml-ml-string"
"(builtins.fromTOML \"s = \\\"\\\"\\\"\\nline1\\nline2\\\"\\\"\\\"\").s"
(mkStr "line1\nline2"),
runTest "multi-line literal string" $
assertEval
"toml-ml-literal"
"(builtins.fromTOML \"s = '''\\nkeep'''\").s"
(mkStr "keep"),
runTest "comment inside a multi-line array" $
assertEval
"toml-ml-comment"
"builtins.concatStringsSep \",\" (builtins.fromTOML \"deps = [ # opening\\n \\\"bar\\\", # trailing\\n]\").deps"
(mkStr "bar"),
runTest "hash inside a string is content" $
assertEval
"toml-hash-content"
"(builtins.fromTOML \"s = \\\"\\\"\\\"a#b\\\"\\\"\\\"\").s"
(mkStr "a#b"),
runTest "single-line values still parse" $
assertEval
"toml-single-line"
"(builtins.fromTOML \"x = 4\\ny = \\\"z\\\" # cmt\").y"
(mkStr "z")
]
testAttrPath :: IO [Bool]
testAttrPath = do
putStrLn "\n-- Attribute paths (build -A) --"
sequence
[ runTest "a bare name is one component" $
assertEqual "single" (Right ["hello"]) (parseAttrPath "hello"),
runTest "dots separate components" $
assertEqual "dotted" (Right ["a", "b", "c"]) (parseAttrPath "a.b.c"),
runTest "a quoted component carries a dot" $
assertEqual "quoted" (Right ["a", "b.c", "d"]) (parseAttrPath "a.\"b.c\".d"),
-- Upstream's quotes concatenate rather than delimit, so a quoted run
-- glues onto whatever sits beside it instead of standing alone.
runTest "quotes concatenate onto the surrounding name" $
assertEqual
"glued"
[Right ["foobar"], Right ["foobar"]]
[parseAttrPath "\"foo\"bar", parseAttrPath "foo\"bar\""],
-- The last component is kept only when non-empty, so these three
-- select nothing at all rather than naming an empty attribute.
runTest "an empty path selects nothing" $
assertEqual
"nothing"
[Right [], Right [], Right ["a"]]
[parseAttrPath "", parseAttrPath "\"\"", parseAttrPath "a."],
-- An interior empty component survives tokenizing; selection rejects
-- it, and only after checking the type of what it would index.
runTest "an interior empty component survives tokenizing" $
assertEqual
"interior"
[Right ["", "a"], Right ["a", "", "b"]]
[parseAttrPath ".a", parseAttrPath "a..b"],
runTest "an unclosed quote is an error" $
assertEqual
"unclosed"
(Left "missing closing quote in selection path \'a.\"b\'")
(parseAttrPath "a.\"b")
]
-- | The remembered-fetch record, on its own. All three functions are pure,
-- and every property that keeps a warm cache honest is decided here: what
-- shares an entry, what round-trips, and what a torn file decodes to.
testFetchCache :: IO [Bool]
testFetchCache = do
putStrLn "eval/fetch-cache"
sequence
[ runTest "the key separates every input that decides the answer" $
let base = fetchCacheKey "https://example.com/r" "source" "abc" False False
variants =
[ fetchCacheKey "https://example.com/s" "source" "abc" False False,
fetchCacheKey "https://example.com/r" "other" "abc" False False,
fetchCacheKey "https://example.com/r" "source" "def" False False,
fetchCacheKey "https://example.com/r" "source" "abc" True False,
-- shallow decides revCount, so it cannot share an entry
-- with a full clone of the same revision.
fetchCacheKey "https://example.com/r" "source" "abc" False True
]
in assertEqual "collisions with the base key" [] (filter (== base) variants),
runTest "the same fetch keys the same both times" $
assertEqual
"repeat"
(fetchCacheKey "https://example.com/r" "source" "abc" True True)
(fetchCacheKey "https://example.com/r" "source" "abc" True True),
runTest "an entry round-trips through encode and decode" $
assertEqual "decode . encode" (Just sampleFetchCache) (decodeFetchCache (encodeFetchCache sampleFetchCache)),
runTest "a torn entry decodes to nothing" $
let whole = encodeFetchCache sampleFetchCache
-- Every prefix, so the cut lands in each field in turn. The
-- last field is the one that matters: a cut before it leaves
-- fewer than five lines and is rejected on shape alone, while
-- a cut inside narHash still leaves five.
torn = [T.take n whole | n <- [0 .. T.length whole - 1]]
in assertEqual "prefixes that decoded" [] (filter (isJust . decodeFetchCache) torn),
runTest "a non-decimal count is not an entry" $
assertEqual
"revCount"
Nothing
(decodeFetchCache (replaceCount (encodeFetchCache sampleFetchCache) "12x")),
-- The hit path itself, end to end through builtins.fetchGit. Nothing
-- here can reach the network: the stub's createScratchDir throws, so
-- a Right at all proves the fetch was skipped, and every field comes
-- from the entry rather than from git.
runTest "a warm entry answers builtins.fetchGit without fetching" $
case evalWarmFetchGit sampleFetchCache (Set.singleton (fcStorePath sampleFetchCache)) of
Left err -> Fail ("a warm cache still tried to fetch: " <> err)
Right val ->
assertEqual
"fields"
[ ("outPath", VPath (fcStorePath sampleFetchCache)),
("rev", mkStr (fcRev sampleFetchCache)),
("revCount", VInt 1234),
("narHash", mkStr ("sha256-" <> fcNarHash sampleFetchCache))
]
(fetchGitFields val ["outPath", "rev", "revCount", "narHash"]),
-- The guard on the hit, on the axis that matters. doesPathExist is
-- False throughout the stub and adoptStorePath is what decides, so a
-- hit that consulted mere existence would fail this and a hit that
-- adopts the path passes the case above. Adoption is what records
-- the store write, and a hit that skipped it would hand back an
-- outPath no derivation naming it could be built against.
runTest "an entry whose path cannot be adopted refetches" $
case evalWarmFetchGit sampleFetchCache Set.empty of
Right _ -> Fail "an unadoptable entry was served from the cache"
Left err
| "createScratchDir" `T.isInfixOf` err -> Pass
| otherwise -> Fail ("expected a refetch, got: " <> err),
runTest "a bare ref is never served from the cache" $
-- Whatever the cache holds, a ref means "wherever this branch
-- points now", so the entry must not be consulted at all.
case evalNixStubWith
(warmEnv sampleFetchCache (Set.singleton (fcStorePath sampleFetchCache)))
"builtins.fetchGit { url = \"https://example.com/r\"; ref = \"main\"; }" of
Right _ -> Fail "a bare ref was served from the cache"
Left err
| "createScratchDir" `T.isInfixOf` err -> Pass
| otherwise -> Fail ("expected a fetch, got: " <> err),
runTest "a hash that is not base64 sha256 is not an entry" $
assertEqual
"narHash"
[Nothing, Nothing, Nothing]
( map
(decodeFetchCache . encodeFetchCache)
[ sampleFetchCache {fcNarHash = T.take 43 (fcNarHash sampleFetchCache)},
sampleFetchCache {fcNarHash = T.replicate 44 "="},
sampleFetchCache {fcNarHash = T.take 43 (fcNarHash sampleFetchCache) <> "A"}
]
)
]
where
-- Swap the encoded revCount line, which encodeFetchCache cannot
-- produce: the field is an Integer on the way in.
replaceCount encoded replacement = case T.splitOn "\n" encoded of
[storePath, rev, _, lastModified, narHash] ->
T.intercalate "\n" [storePath, rev, replacement, lastModified, narHash]
_ -> encoded
-- | A stub store whose cache is warm for 'evalWarmFetchGit'\'s fetch, and
-- which will adopt exactly the given store paths.
warmEnv :: FetchCache -> Set.Set Text -> StubEnv
warmEnv fields adoptable =
(stubEnv Map.empty)
{ seFetchCache =
Map.singleton
(fetchCacheKey "https://example.com/r" "source" warmFetchGitRev False False)
(encodeFetchCache fields),
seAdoptable = adoptable
}
-- | The pinned revision 'evalWarmFetchGit' asks for.
warmFetchGitRev :: Text
warmFetchGitRev = T.replicate 40 "b"
-- | Evaluate a pinned @builtins.fetchGit@ against a warm cache.
evalWarmFetchGit :: FetchCache -> Set.Set Text -> Either Text NixValue
evalWarmFetchGit fields adoptable =
evalNixStubWith
(warmEnv fields adoptable)
("builtins.fetchGit { url = \"https://example.com/r\"; rev = \"" <> warmFetchGitRev <> "\"; }")
-- | Read the named attributes off a @fetchGit@ result, in the order asked.
fetchGitFields :: NixValue -> [Text] -> [(Text, NixValue)]
fetchGitFields val names = case val of
VAttrs attrs ->
[ (name, value)
| name <- names,
Just thunk <- [attrSetLookup name attrs],
Just value <- [readThunkValue thunk]
]
_ -> []
-- | One recorded fetch, with a real 44-character base64 sha256.
sampleFetchCache :: FetchCache
sampleFetchCache =
FetchCache
{ fcStorePath = "/nix/store/" <> T.replicate 32 "a" <> "-source",
fcRev = T.replicate 40 "b",
fcRevCount = 1234,
fcLastModified = 1700000000,
fcNarHash = T.replicate 43 "A" <> "="
}
-- | Which derivations this machine will spawn, and how.
--
-- The distinction that matters is between the two answers that used to be
-- one: a derivation for this platform needs no launcher, and a derivation
-- for another platform with no launcher configured is not the same thing.
testExecWrapper :: IO [Bool]
testExecWrapper = do
putStrLn "builder/exec-wrapper"
sequence
[ runTest "a derivation for this platform is spawned directly" $
assertEqual
"native"
SpawnNative
(execWrapperFor (wrapperConfig [(platformToText foreignPlatform, "/usr/bin/wine")]) (drvFor currentPlatform)),
runTest "a configured foreign system spawns through its launcher" $
assertEqual
"wrapped"
(SpawnThrough "/usr/bin/wine")
(execWrapperFor (wrapperConfig [(platformToText foreignPlatform, "/usr/bin/wine")]) (drvFor foreignPlatform)),
-- The finding this exists for: without a distinct answer here, a
-- foreign builder was spawned natively and failed in the loader,
-- after the whole closure had already been realized.
runTest "an unconfigured foreign system is refused, not spawned" $
assertEqual
"unsupported"
(SpawnUnsupported (platformToText foreignPlatform))
(execWrapperFor (wrapperConfig []) (drvFor foreignPlatform)),
-- A 32-bit derivation on a 64-bit host of the same OS is native, as
-- upstream's extra-platforms makes it, launcher or no launcher; on
-- any other host it is as foreign as anything else.
runTest "an i686 derivation spawns natively on its x86_64 host, whatever is configured" $
assertEqual
"wow64"
[SpawnNative, SpawnNative, SpawnNative, SpawnNative]
[ spawnFor X86_64_Windows (wrapperConfig []) (drvFor I686_Windows),
spawnFor X86_64_Windows (wrapperConfig [("i686-windows", "/usr/bin/wine")]) (drvFor I686_Windows),
spawnFor X86_64_Linux (wrapperConfig []) (drvFor I686_Linux),
spawnFor X86_64_Linux (wrapperConfig [("i686-linux", "/opt/qemu")]) (drvFor I686_Linux)
],
runTest "an i686 derivation elsewhere is refused or launched like any foreign system" $
assertEqual
"elsewhere"
[SpawnUnsupported "i686-windows", SpawnThrough "/usr/bin/wine", SpawnUnsupported "i686-linux"]
[ spawnFor X86_64_Linux (wrapperConfig []) (drvFor I686_Windows),
spawnFor X86_64_Linux (wrapperConfig [("i686-windows", "/usr/bin/wine")]) (drvFor I686_Windows),
spawnFor Aarch64_Darwin (wrapperConfig []) (drvFor I686_Linux)
],
-- The system string is the derivation's own spelling, matched
-- exactly. The documentation once named a different one, which
-- parsed, stored, and then never matched anything.
runTest "SYSTEM=PATH splits at the first separator" $
assertEqual
"specs"
(Right (Map.fromList [("x86_64-windows", "/usr/bin/wine"), ("aarch64-linux", "/opt/qemu=static/qemu")]))
(execWrapperConfig ["x86_64-windows=/usr/bin/wine", "aarch64-linux=/opt/qemu=static/qemu"]),
runTest "no specs is an empty map, not an error" $
assertEqual "empty" (Right Map.empty) (execWrapperConfig []),
runTest "a spec missing either half is rejected" $
assertEqual
"malformed"
(replicate 4 True)
(map (either (const True) (const False) . execWrapperConfig . pure) ["wine", "=wine", "x86_64-windows=", ""]),
-- Last-one-wins would run a build through a launcher the operator
-- did not think they had asked for.
runTest "naming one system twice is rejected" $
assertEqual
"duplicate"
(Left "--exec-wrapper names x86_64-windows twice")
(execWrapperConfig ["x86_64-windows=/usr/bin/wine", "x86_64-windows=/usr/bin/wine64"]),
runTest "a launcher keyed on any other spelling does not match" $
assertEqual
"near-miss keys"
(replicate 3 (SpawnUnsupported (platformToText foreignPlatform)))
( [ execWrapperFor (wrapperConfig [(key, "/usr/bin/wine")]) (drvFor foreignPlatform)
| key <- ["x86-windows", "windows", T.toUpper (platformToText foreignPlatform)]
]
)
]
where
-- Some platform this test is not running on, so "foreign" is foreign
-- whichever host runs the suite.
foreignPlatform =
if currentPlatform == X86_64_Windows then X86_64_Linux else X86_64_Windows
wrapperConfig entries =
(defaultBuildConfig (StoreDir "/nix/store")) {bcExecWrappers = Map.fromList entries}
drvFor platform =
Derivation
{ drvOutputs = [DerivationOutput "out" (StorePath (T.replicate 32 "a") "spawn") "" ""],
drvInputDrvs = Map.empty,
drvInputSrcs = [],
drvPlatform = platform,
drvBuilder = "/bin/sh",
drvArgs = [],
drvEnv = Map.empty
}
testFetchMirrors :: IO [Bool]
testFetchMirrors = do
putStrLn "builder/fetch-mirrors"
sequence
[ runTest "fetch URLs preserve the legacy single URL" $
assertEqual
"url"
(Right ("https://a/file%20name" :| []))
(fetchUrlsFromEnv (Map.singleton "url" "https://a/file%20name")),
runTest "fetch URLs prefer the explicit ordered list" $
assertEqual
"urls"
(Right ("https://a" :| ["https://b"]))
(fetchUrlsFromEnv (Map.fromList [("url", "https://ignored"), ("urls", " https://a\t https://b\n")])),
runTest "fetch URLs preserve non-ASCII whitespace within a URL" $
let url = "https://a/has\xA0space"
in assertEqual
"non-ASCII URL"
(Right (url :| ["https://b"]))
(fetchUrlsFromEnv (Map.singleton "urls" (TE.encodeUtf8 (url <> " https://b")))),
runTest "fetch URLs reject missing, empty and invalid UTF-8 inputs" $
assertEqual
"invalid"
(replicate 5 True)
( map
(either (const True) (const False) . fetchUrlsFromEnv)
[Map.empty, Map.singleton "url" "", Map.fromList [("urls", " "), ("url", "https://ignored")], Map.singleton "url" (BS.pack [255]), Map.singleton "urls" (BS.pack [255])]
),
runTestM "mirror policy retries timeout and hash failures in order" $ do
calls <- newIORef []
let attempt url = do
atomicModifyIORef' calls (\seen -> (seen ++ [url], ()))
pure $ case url of
"slow" -> Left "download timeout"
"corrupt" -> Left "hash mismatch"
_ -> Right ("verified" :: Text)
result <- tryFetchUrlsWith attempt ("slow" :| ["corrupt", "good", "unused"])
seen <- readIORef calls
pure (assertEqual "ordered attempts" (Right "verified", ["slow", "corrupt", "good"]) (result, seen)),
runTestM "mirror policy returns every failure in order" $ do
result <- tryFetchUrlsWith (pure . Left) ("first failure" :| ["second failure"])
pure (assertEqual "failures" (Left "first failure\nsecond failure" :: Either Text ()) result),
runTestM "mirror policy does not evaluate candidates after success" $ do
let attempt "good" = pure (Right "good")
attempt _ = fail "unused mirror attempted"
result <- tryFetchUrlsWith attempt ("good" :| ["unused"])
pure (assertEqual "first success" (Right "good" :: Either Text Text) result),
-- The per-URL retry policy, with its effects injected: upstream's five
-- attempts and doubling delay from 250 ms, spent on transient failures
-- only.
runTest "retry delay is upstream's 250 ms doubling, with jitter on the exponent" $
assertEqual
"delays"
([250, 500, 1000, 2000], 353, 2828)
( map (\retry -> retryDelayMs defaultFetchRetryPolicy retry 0) [1 .. 4],
retryDelayMs defaultFetchRetryPolicy 1 0.5,
retryDelayMs defaultFetchRetryPolicy 4 0.5
),
runTestM "retry policy retries a transient failure with backoff until it succeeds" $ do
calls <- newIORef (0 :: Int)
sleeps <- newIORef []
warnings <- newIORef []
let effects =
RetryEffects
{ reSleepMs = \ms -> atomicModifyIORef' sleeps (\seen -> (seen ++ [ms], ())),
reJitter = pure 0,
reWarn = \msg -> atomicModifyIORef' warnings (\seen -> (seen ++ [msg], ()))
}
attempt = do
n <- atomicModifyIORef' calls (\c -> (c + 1, c + 1))
pure (if n < 3 then Left (Subst.TransientFailure "HTTP 503 fetching u") else Right ("verified" :: Text))
result <- retryTransient defaultFetchRetryPolicy effects attempt
seenSleeps <- readIORef sleeps
seenWarnings <- readIORef warnings
pure
( assertEqual
"two retries"
(Right "verified", [250, 500], ["HTTP 503 fetching u; retrying in 250 ms", "HTTP 503 fetching u; retrying in 500 ms"])
(result, seenSleeps, seenWarnings)
),
runTestM "retry policy gives up after five attempts" $ do
calls <- newIORef (0 :: Int)
sleeps <- newIORef []
let effects = RetryEffects {reSleepMs = \ms -> atomicModifyIORef' sleeps (\seen -> (seen ++ [ms], ())), reJitter = pure 0, reWarn = \_ -> pure ()}
attempt = atomicModifyIORef' calls (\c -> (c + 1, ())) >> pure (Left (Subst.TransientFailure "timeout") :: Either Subst.AttemptFailure ())
result <- retryTransient defaultFetchRetryPolicy effects attempt
seenCalls <- readIORef calls
seenSleeps <- readIORef sleeps
pure (assertEqual "spent" (Left (Subst.TransientFailure "timeout"), 5, [250, 500, 1000, 2000]) (result, seenCalls, seenSleeps)),
runTestM "retry policy does not retry a fatal failure" $ do
calls <- newIORef (0 :: Int)
let effects = RetryEffects {reSleepMs = \_ -> fail "slept on a fatal failure", reJitter = pure 0, reWarn = \_ -> fail "warned on a fatal failure"}
attempt = atomicModifyIORef' calls (\c -> (c + 1, ())) >> pure (Left (Subst.FatalFailure "HTTP 404") :: Either Subst.AttemptFailure ())
result <- retryTransient defaultFetchRetryPolicy effects attempt
seenCalls <- readIORef calls
pure (assertEqual "once" (Left (Subst.FatalFailure "HTTP 404"), 1) (result, seenCalls)),
-- The classification tables, against upstream's (filetransfer.cc at
-- 2.24.9): which statuses and which client failures a retry can outlive.
runTest "status classification matches upstream's transfer layer" $
let transient status = case fetchStatusFailure "u" status of
Subst.TransientFailure _ -> True
Subst.FatalFailure _ -> False
in assertEqual
"classes"
(replicate 6 True, replicate 10 False)
( map transient [HTTP.status408, HTTP.status429, HTTP.status500, HTTP.status502, HTTP.status503, HTTP.status504],
map transient [HTTP.status404, HTTP.status410, HTTP.status401, HTTP.status403, HTTP.status407, HTTP.status400, HTTP.status418, HTTP.status501, HTTP.status505, HTTP.status511]
),
runTest "status verdicts follow upstream's FileTransfer::Error, in its order" $
assertEqual
"verdicts"
(replicate 2 NotFound ++ replicate 3 Forbidden ++ replicate 5 Misc ++ replicate 6 Transient)
( map
statusError
[ HTTP.status404,
HTTP.status410,
HTTP.status401,
HTTP.status403,
HTTP.status407,
HTTP.status400,
HTTP.status418,
HTTP.status501,
HTTP.status505,
HTTP.status511,
HTTP.status408,
HTTP.status429,
HTTP.status500,
HTTP.status502,
HTTP.status503,
HTTP.status504
]
),
runTest "exception classification retries transport failures only" $
let transient err = case fetchExceptionFailure "u" err of
Subst.TransientFailure _ -> True
Subst.FatalFailure _ -> False
request = HTTP.defaultRequest
in assertEqual
"classes"
(replicate 4 True, replicate 4 False)
( map
transient
[ HTTP.HttpExceptionRequest request HTTP.ConnectionTimeout,
HTTP.HttpExceptionRequest request (HTTP.ResponseBodyTooShort 100 5),
HTTP.HttpExceptionRequest request HTTP.ResponseTimeout,
HTTP.HttpExceptionRequest request (HTTP.InternalException (toException connectionReset))
],
map
transient
[ HTTP.InvalidUrlException "ftp://x" "Invalid scheme",
HTTP.HttpExceptionRequest request (HTTP.InvalidDestinationHost ""),
HTTP.HttpExceptionRequest request HTTP.TlsNotSupported,
HTTP.HttpExceptionRequest request (HTTP.TooManyRedirects [])
]
),
-- The attempt boundary: an IOException there is a failure writing
-- the output, and an asynchronous exception is never caught.
runTestM "a failure writing the download is fatal" $ do
outcome <- throwIO (userError "disk full") `catches` transferFailureHandlers "u" :: IO (Either Subst.AttemptFailure ())
pure $ case outcome of
Left (Subst.FatalFailure _) -> Pass
other -> Fail ("expected a fatal failure, got: " <> T.pack (show other)),
runTestM "an interrupt passes through the attempt boundary untouched" $ do
outcome <- try (throwIO ThreadKilled `catches` transferFailureHandlers "u" :: IO (Either Subst.AttemptFailure ()))
pure $ case outcome of
Left err | fromException err == Just ThreadKilled -> Pass
other -> Fail ("expected ThreadKilled to propagate, got: " <> T.pack (show other)),
-- The body reader: the HTTP client wraps a failure opening the
-- response but not one reading its body, where a reset mid-body
-- arrives as a bare IOException. Read through transferBodyReader it
-- is a transport failure, retried like any other.
runTestM "a connection reset mid-body is a transport failure, not a failed write" $ do
let reader = transferBodyReader HTTP.defaultRequest (throwIO connectionReset)
outcome <- (Right <$> reader) `catches` transferFailureHandlers "u"
pure $ case outcome of
Left (Subst.TransientFailure _) -> Pass
other -> Fail ("expected a transient failure, got: " <> T.pack (show other)),
runTestM "the body reader passes the client's own failures and an interrupt through unchanged" $ do
let tooShort = HTTP.HttpExceptionRequest HTTP.defaultRequest (HTTP.ResponseBodyTooShort 100 5)
clientFailure <- try (transferBodyReader HTTP.defaultRequest (throwIO tooShort))
interrupt <- try (transferBodyReader HTTP.defaultRequest (throwIO ThreadKilled))
chunk <- transferBodyReader HTTP.defaultRequest (pure "bytes")
pure $ case (clientFailure, interrupt) of
(Left (HTTP.HttpExceptionRequest _ (HTTP.ResponseBodyTooShort 100 5)), Left ThreadKilled)
| chunk == "bytes" -> Pass
other -> Fail ("unexpected body reader outcomes: " <> T.pack (show (other, chunk))),
-- End to end against the loopback fixture, under a policy with a 1 ms
-- base delay: a torn transfer and a server error spend all five
-- attempts before the next mirror; a 404 and a hash mismatch spend one.
runTestM "HTTP mirrors retry a torn transfer, skip a missing or corrupt one, and stop on success" $
httpCase "fallback" False ["/missing", "/bad", "/partial", "/good", "/unused"] True (["/missing", "/bad"] ++ replicate 5 "/partial" ++ ["/good"]),
runTestM "HTTP fetch retains single-url compatibility" $
httpCase "legacy" True ["/good"] True ["/good"],
runTestM "a server error is retried five times before the next mirror" $
httpCase "retried" False ["/error", "/good"] True (replicate 5 "/error" ++ ["/good"]),
runTestM "HTTP failure leaves no output or registration" $
httpCase "errors" False ["/error", "/missing"] False (replicate 5 "/error" ++ ["/missing"]),
runTestM "hash failure leaves no corrupt output or registration" $
httpCase "corrupt" False ["/bad", "/partial"] False ("/bad" : replicate 5 "/partial"),
runTestM "cancelling a download releases its lock and does not try another mirror" $
withFetchurlServer $ \base requests requested ->
withStore "cancel" $ \store config sp -> do
let drv = fixtureDrv sp (Map.singleton "urls" (TE.encodeUtf8 (base <> "/slow " <> base <> "/good")))
outcome <- timeout 10000000 $
withAsync (buildDerivation config store drv) $ \worker -> do
requested
cancel worker
waitCatch worker
seen <- requests
valid <- isValid store sp
present <- Dir.doesPathExist (storePathToFilePath (stDir store) sp)
lock <- tryAcquirePathLock (stDir store) sp
mapM_ releasePathLock lock
pure $ case outcome of
Just (Left _) | seen == ["/slow"] && not valid && not present && isJust lock -> Pass
_ -> Fail ("cancellation failed: " <> T.pack (show (outcome, seen, valid, present, isJust lock)))
]
where
hash = "2cf24dba5fb0a30e26e83b2ac5b9e29e1b161e5c1fa7425e73043362938b9824"
-- What http-client 0.7's body reader raises when the server resets
-- the connection mid-body.
connectionReset = mkIOError resourceVanishedErrorType "Network.Socket.recvBuf" Nothing Nothing
withStore label action = do
tmpBase <- getTemporaryDirectory
let root = tmpBase </> ("nova-nix-test-mirrors-" ++ label)
dir = StoreDir (root </> "store")
config = (defaultBuildConfig dir) {bcTmpDir = root </> "build", bcFetchRetry = defaultFetchRetryPolicy {frpBaseDelayMs = 1}}
sp <- either (fail . show) pure (makeFixedOutputPath "mirrors" "sha256" "flat" (sha256Digest "hello"))
bracket_ (forceRemoveIfExists root) (forceRemoveIfExists root) $
bracket (openStore dir) closeStore $
\store -> action store config sp
fixtureDrv sp env =
Derivation
{ drvOutputs = [DerivationOutput "out" sp "sha256" hash],
drvInputDrvs = Map.empty,
drvInputSrcs = [],
drvPlatform = currentPlatform,
drvBuilder = "builtin:fetchurl",
drvArgs = [],
drvEnv = env
}
httpCase label legacy paths succeeds expectedRequests =
withFetchurlServer $ \base requests _ ->
withStore label $ \store config sp -> do
let urls = T.unwords (map (base <>) paths)
env = Map.singleton (if legacy then "url" else "urls") (TE.encodeUtf8 urls)
result <- buildDerivation config store (fixtureDrv sp env)
seen <- requests
valid <- isValid store sp
present <- Dir.doesPathExist (storePathToFilePath (stDir store) sp)
case result of
BuildSuccess _
| succeeds && valid && present && seen == expectedRequests ->
assertEqual "verified output" "hello" <$> BS.readFile (storePathToFilePath (stDir store) sp)
BuildFailure msg _ | not succeeds && not valid && not present && seen == expectedRequests && not (T.null msg) -> pure Pass
_ -> pure (Fail (T.pack (show (result, seen, valid, present))))
-- | The substituter's narinfo and NAR requests under the transfer
-- layer's retry policy, against a loopback cache. The policy's effects
-- are recorded rather than slept, so each case states the requests the
-- cache saw and the backoff the policy chose.
testSubstituterRetry :: IO [Bool]
testSubstituterRetry = do
putStrLn "substituter/retry"
case signedNarInfo of
Left err -> (: []) <$> runTest "substituter retry setup" (Fail (T.pack err))
Right (publicKey, narInfoText) ->
let narInfoOk = Send (httpResponse "200 OK" (TE.encodeUtf8 narInfoText))
narOk = Send (httpResponse "200 OK" nar)
unavailable = Send (httpResponse "503 Service Unavailable" "")
substitute label narInfoReply narReply =
withHttpServer (route narInfoReply narReply) $ \base requests _ -> do
tmpBase <- getTemporaryDirectory
sleeps <- newIORef []
warnings <- newIORef []
let root = tmpBase </> ("nova-nix-test-subst-retry-" ++ label)
cache = Subst.CacheConfig base [publicKey] 40
effects =
RetryEffects
{ reSleepMs = \ms -> atomicModifyIORef' sleeps (\seen -> (seen ++ [ms], ())),
reJitter = pure 0,
reWarn = \msg -> atomicModifyIORef' warnings (\seen -> (seen ++ [msg], ()))
}
bracket_ (forceRemoveIfExists root) (forceRemoveIfExists root) $
bracket (openStore (StoreDir root)) closeStore $ \store -> do
result <- Subst.trySubstituteWith defaultFetchRetryPolicy effects store [cache] sp
outcome <- case result of
Subst.SubstSuccess _ lock -> do
releasePathLock lock
Right <$> BS.readFile (storePathToFilePath (stDir store) sp </> "data")
other -> pure (Left other)
(,,,,) base outcome <$> requests <*> readIORef sleeps <*> readIORef warnings
in sequence $
[ runTestM "a narinfo that fails once with a 503 is fetched on the retry" $ do
(base, outcome, seen, sleeps, warnings) <-
substitute "narinfo-503" (\earlier -> if earlier == 0 then unavailable else narInfoOk) (const narOk)
pure
( assertEqual
"substituted after one retry"
(Right payload, [narInfoPath, narInfoPath, narPath], [250], ["HTTP 503 fetching " <> base <> "/" <> hash <> ".narinfo; retrying in 250 ms"])
(outcome, seen, sleeps, warnings)
),
runTestM "a narinfo that keeps failing spends upstream's five attempts and doubling delay" $ do
(_, outcome, seen, sleeps, _) <- substitute "narinfo-down" (const unavailable) (const narOk)
pure $ case outcome of
Left (Subst.SubstError _) -> assertEqual "attempts" (replicate 5 narInfoPath, [250, 500, 1000, 2000]) (seen, sleeps)
other -> Fail ("expected a substitution error, got: " <> T.pack (show other)),
runTestM "a NAR download answering 501 stops after one request" $ do
(_, outcome, seen, sleeps, _) <-
substitute "nar-501" (const narInfoOk) (const (Send (httpResponse "501 Not Implemented" "")))
pure $ case outcome of
Left (Subst.SubstError err)
| "HTTP 501" `T.isInfixOf` err -> assertEqual "one request" ([narInfoPath, narPath], []) (seen, sleeps)
other -> Fail ("expected an HTTP 501 substitution error, got: " <> T.pack (show other)),
-- One attempt follows the client's redirect limit, then stops.
runTestM "a NAR redirect loop stops after one attempt" $ do
(_, outcome, seen, sleeps, _) <-
substitute "nar-redirect" (const narInfoOk) (const (Send "HTTP/1.1 302 Found\r\nLocation: /nar/retry.nar\r\nContent-Length: 0\r\nConnection: close\r\n\r\n"))
pure $ case outcome of
Left (Subst.SubstError err)
| "too many redirects" `T.isInfixOf` err ->
assertEqual "one attempt" (narInfoPath : replicate (HTTP.redirectCount HTTP.defaultRequest + 1) narPath, []) (seen, sleeps)
other -> Fail ("expected a redirect-loop substitution error, got: " <> T.pack (show other)),
runTestM "a torn NAR transfer is retried from its first byte" $ do
let torn = "HTTP/1.1 200 OK\r\nContent-Length: " <> TE.encodeUtf8 (T.pack (show (BS.length nar))) <> "\r\nConnection: close\r\n\r\n" <> BS.take 10 nar
(base, outcome, seen, sleeps, warnings) <-
substitute "nar-torn" (const narInfoOk) (\earlier -> if earlier == 0 then Send torn else narOk)
let warnedTorn = case warnings of
[warning] -> ("download error fetching " <> base <> "/nar/retry.nar: ResponseBodyTooShort") `T.isPrefixOf` warning
_ -> False
pure $
if warnedTorn
then assertEqual "substituted after one retry" (Right payload, [narInfoPath, narPath, narPath], [250]) (outcome, seen, sleeps)
else Fail ("unexpected warnings: " <> T.pack (show warnings))
]
-- Upstream's NotFound and Forbidden: a binary cache store
-- reads both as the file not being in that cache.
++ [ runTestM ("a narinfo answered " <> status <> " is a miss, not retried") $ do
(_, outcome, seen, sleeps, _) <-
substitute ("narinfo-" ++ statusCode status) (const (Send (httpResponse (TE.encodeUtf8 status) ""))) (const narOk)
pure (assertEqual "miss" (Left Subst.SubstNotFound, [narInfoPath], []) (outcome, seen, sleeps))
| status <- notInCache
]
-- A NAR the narinfo named and the cache no longer holds is
-- upstream's SubstituteGone: one request, never retried.
++ [ runTestM ("a NAR answered " <> status <> " stops after one request") $ do
(_, outcome, seen, sleeps, _) <-
substitute ("nar-" ++ statusCode status) (const narInfoOk) (const (Send (httpResponse (TE.encodeUtf8 status) "")))
pure $ case outcome of
Left (Subst.SubstError _) -> assertEqual "one request" ([narInfoPath, narPath], []) (seen, sleeps)
other -> Fail ("expected a substitution error, got: " <> T.pack (show other))
| status <- notInCache
]
where
notInCache :: [Text]
notInCache = ["404 Not Found", "410 Gone", "401 Unauthorized", "403 Forbidden", "407 Proxy Authentication Required"]
statusCode = T.unpack . T.take 3
hash = T.replicate 32 "b"
sp = StorePath hash "retry"
narInfoPath = "/" <> TE.encodeUtf8 hash <> ".narinfo"
narPath = "/nar/retry.nar"
payload = "retried payload\n"
nar = NAR.serialise (NAR.NarDirectory [("data", NAR.NarRegular False payload)])
unsigned =
NarInfo.NarInfo
{ NarInfo.niStorePath = "/nix/store/" <> hash <> "-retry",
NarInfo.niUrl = "nar/retry.nar",
NarInfo.niCompression = "none",
NarInfo.niFileHash = Nothing,
NarInfo.niFileSize = Nothing,
NarInfo.niNarHash = CHash.formatNixHash (CHash.hashBytes nar),
NarInfo.niNarSize = fromIntegral (BS.length nar),
NarInfo.niReferences = [],
NarInfo.niDeriver = Nothing,
NarInfo.niSigs = [],
NarInfo.niCA = Nothing
}
signedNarInfo = do
secretKey <- Signing.parseSecretKey sigTestKeyText
publicKey <- Signing.toPublicKey secretKey
sig <- Signing.sign secretKey unsigned
pure (Signing.renderPublicKey publicKey, NarInfo.renderNarInfo unsigned {NarInfo.niSigs = [sig]})
route narInfoReply narReply path earlier
| path == narInfoPath = narInfoReply earlier
| path == narPath = narReply earlier
| otherwise = Send (httpResponse "500 Internal Server Error" "unexpected request")
-- | @pkgs/windows/fetchurl.nix@ evaluated from the checkout. The
-- @mirror://@ expansion is what a source derivation records, so a
-- mirrors.nix refresh or a regex edit moves every drvPath built on it;
-- these pin the list against nixpkgs' order and the eval-time errors.
testPkgsFetchurl :: IO [Bool]
testPkgsFetchurl = do
putStrLn "pkgs/fetchurl"
cwd <- Dir.getCurrentDirectory
let fetchurl = "(import " <> nixQuotedPath (cwd </> "pkgs" </> "windows" </> "fetchurl.nix") <> ")"
urlsOf source = "builtins.concatStringsSep \"\\n\" (" <> fetchurl <> " { " <> source <> " sha256 = \"" <> hash <> "\"; }).urls"
failsWith expected result = case result of
Left err
| expected `T.isInfixOf` err -> Pass
| otherwise -> Fail ("expected an error naming " <> expected <> ", got: " <> err)
Right val -> Fail ("expected an eval error, got: " <> T.pack (show val))
sequence
[ runTestIO
"mirror://gnu expands to the https hosts of mirrors.nix, in nixpkgs' order"
cwd
(urlsOf "url = \"mirror://gnu/hello/hello-2.12.3.tar.gz\";")
(mkStr (T.intercalate "\n" (map (<> "hello/hello-2.12.3.tar.gz") gnuHosts))),
runTestIO
"a plain URL in urls passes through beside an expanded one"
cwd
(urlsOf "urls = [ \"https://example.invalid/sed-4.10.tar.xz\" \"mirror://gnu/sed/sed-4.10.tar.xz\" ];")
(mkStr (T.intercalate "\n" ("https://example.invalid/sed-4.10.tar.xz" : map (<> "sed/sed-4.10.tar.xz") gnuHosts))),
runTestM "an unknown mirror site is an eval error naming the recipe's URL" $
failsWith "fetchurl: unknown mirror site 'nope' in 'mirror://nope/x'" <$> evalNixIO cwd (urlsOf "url = \"mirror://nope/x\";"),
runTestM "a mirror URL with no path is an eval error" $
failsWith "fetchurl: malformed mirror URL 'mirror://gnu'" <$> evalNixIO cwd (urlsOf "url = \"mirror://gnu\";")
]
where
hash :: Text
hash = "0d5f60154382fee10b114a1c34e785d8b1f492073ae2d3a6f7b147687b366aa0"
-- The gnu set of pkgs/windows/mirrors.nix without its ftp:// host.
gnuHosts :: [Text]
gnuHosts =
[ "https://ftpmirror.gnu.org/",
"https://ftp.nluug.nl/pub/gnu/",
"https://mirrors.kernel.org/gnu/",
"https://mirror.ibcp.fr/pub/gnu/",
"https://mirror.dogado.de/gnu/",
"https://mirror.tochlab.net/pub/gnu/",
"https://ftp.gnu.org/pub/gnu/"
]
testFetchGitTransport :: IO [Bool]
testFetchGitTransport = do
putStrLn "eval/fetchgit-transport"
sequence
[ runTest "allowed schemes pass" $
assertEqual
"schemes"
[ Right "https://example.com/repo.git",
Right "http://example.com/repo.git",
Right "ssh://git@example.com/repo.git",
Right "git://example.com/repo.git",
Right "file:///srv/repo"
]
( map
checkGitUrl
[ "https://example.com/repo.git",
"http://example.com/repo.git",
"ssh://git@example.com/repo.git",
"git://example.com/repo.git",
"file:///srv/repo"
]
),
runTest "scheme match is case-insensitive" $
assertEqual "upper" (Right "HTTPS://example.com/r") (checkGitUrl "HTTPS://example.com/r"),
runTest "scp-like remotes and local paths pass" $
assertEqual
"plain"
[ Right "git@github.com:owner/repo.git",
Right "user@[::1]:repo",
Right "/srv/repo",
Right "./repo",
Right "C:\\src\\repo"
]
( map
checkGitUrl
[ "git@github.com:owner/repo.git",
"user@[::1]:repo",
"/srv/repo",
"./repo",
"C:\\src\\repo"
]
),
runTest "helper transports are rejected" $
let rejected = ["ext::sh -c 'printf x'", "fd::17", "my-helper_2::payload", "::payload"]
in case [url | url <- rejected, either (const False) (const True) (checkGitUrl url)] of
[] -> Pass
slipped -> Fail ("helper urls accepted: " <> T.pack (show slipped)),
runTest "an unknown explicit scheme is rejected" $
assertLeft "hg scheme" (checkGitUrl "hg://example.com/repo"),
runTest "the empty url is rejected" $
assertLeft "empty" (checkGitUrl ""),
runTestM "fetchGit refuses a helper transport at eval time" $ do
outcome <- evalNixIO "." "builtins.fetchGit { url = \"ext::printf x\"; }"
pure $ case outcome of
Left err
| "transport" `T.isInfixOf` err -> Pass
| otherwise -> Fail ("wrong error: " <> err)
Right _ -> Fail "helper transport url evaluated",
-- A ref reaching git as an option is command execution: git parses
-- options after the remote name, and --upload-pack names the
-- transport command. The leading-character class is what stops it.
runTest "a ref that git would read as an option is rejected" $
let rejected =
[ "--upload-pack=touch /tmp/pwned",
"-o",
"--exec=sh",
"",
"branch with spaces",
"semi;colon",
"back\\slash"
]
in case [ref | ref <- rejected, either (const False) (const True) (checkGitRef ref)] of
[] -> Pass
slipped -> Fail ("refs accepted: " <> T.pack (show slipped)),
runTest "ordinary ref names are accepted" $
let accepted = ["main", "HEAD", "release/1.0", "v2.3.4", "user/topic-1", "@", "a+b"]
in case [ref | ref <- accepted, either (const True) (const False) (checkGitRef ref)] of
[] -> Pass
refused -> Fail ("refs refused: " <> T.pack (show refused)),
runTest "a rev must be a full SHA-1" $
let rejected =
[ "--upload-pack=touch /tmp/pwned",
"dcb93b58",
"v1.0",
"main",
"",
T.replicate 40 "g",
T.replicate 41 "a"
]
in case [rev | rev <- rejected, either (const False) (const True) (checkGitRev rev)] of
[] -> Pass
slipped -> Fail ("revs accepted: " <> T.pack (show slipped)),
runTest "a full SHA-1 is accepted in either case" $
let accepted = [T.replicate 40 "a", T.replicate 40 "F", "dcb93b58bd982ab64323bac2a8c11b138d6b55e5"]
in case [rev | rev <- accepted, either (const True) (const False) (checkGitRev rev)] of
[] -> Pass
refused -> Fail ("revs refused: " <> T.pack (show refused)),
runTestM "fetchGit refuses an option-shaped ref at eval time" $ do
outcome <- evalNixIO "." "builtins.fetchGit { url = \"/srv/repo\"; ref = \"--upload-pack=id\"; }"
pure $ case outcome of
Left err
| "ref is not a valid git ref name" `T.isInfixOf` err -> Pass
| otherwise -> Fail ("wrong error: " <> err)
Right _ -> Fail "option-shaped ref evaluated"
]
-- ---------------------------------------------------------------------------
-- builtins.fetchGit against a real repository
-- ---------------------------------------------------------------------------
-- | One git command against a fixture repository, identity and signing
-- pinned so no host configuration participates. Nonzero exit throws
-- with git's stderr, failing the calling test loudly.
fixtureGit :: FilePath -> [String] -> IO Text
fixtureGit dir args = do
(code, out, errOut) <-
Proc.readCreateProcessWithExitCode
(Proc.proc "git" (["-C", dir, "-c", "user.name=nova-nix-test", "-c", "user.email=test@nova-nix.invalid", "-c", "commit.gpgsign=false", "-c", "core.autocrlf=false"] ++ args))
""
case code of
ExitSuccess -> pure (T.strip (T.pack out))
ExitFailure n -> fail ("fixture git " ++ unwords args ++ " exited " ++ show n ++ ": " ++ errOut)
-- | A repository whose history is one commit per given file, oldest
-- first; returns the commit SHAs in that order. SHA wants are enabled
-- up front: a pinned rev that is no branch tip is only fetchable when
-- the serving side allows it, the same opt-in real servers use.
makeGitFixture :: FilePath -> [(FilePath, Text)] -> IO [Text]
makeGitFixture dir files = do
Dir.createDirectoryIfMissing True dir
_ <- fixtureGit dir ["init", "--quiet"]
_ <- fixtureGit dir ["config", "uploadpack.allowAnySHA1InWant", "true"]
mapM commitOne files
where
commitOne (name, contents) = do
BS.writeFile (dir </> name) (TE.encodeUtf8 contents)
_ <- fixtureGit dir ["add", "-A"]
_ <- fixtureGit dir ["commit", "--quiet", "-m", name]
fixtureGit dir ["rev-parse", "HEAD"]
-- | 'evalNixIO' against an explicit store directory, for expressions
-- whose evaluation writes store objects.
evalNixIOStore :: StoreDir -> FilePath -> Text -> IO (Either Text NixValue)
evalNixIOStore storeDir baseDir source = case parseNix baseDir "<test>" source of
Left err -> pure (Left (T.pack (show err)))
Right expr -> do
st <- newEvalState storeDir baseDir
runEvalIO st (eval (builtinEnv unrestrictedPolicy (esTimestamp st) (esSearchPaths st)) expr)
testFetchGitShallow :: IO [Bool]
testFetchGitShallow = do
tmpBase <- getTemporaryDirectory
let repoDir = tmpBase </> "nova-nix-test-fetchgit-repo"
tmpStore = tmpBase </> "nova-nix-test-fetchgit-store"
cacheHome = tmpBase </> "nova-nix-test-fetchgit-cache"
nixEscape = T.concatMap (\c -> if c == '\\' then "\\\\" else if c == '"' then "\\\"" else T.singleton c)
urlAttr = "url = \"" <> nixEscape (T.pack repoDir) <> "\"; "
evalFetch extra = evalNixIOStore (StoreDir tmpStore) "." ("builtins.fetchGit { " <> urlAttr <> extra <> "}")
forceRemoveIfExists repoDir
forceRemoveIfExists tmpStore
forceRemoveIfExists cacheHome
-- The fetch cache writes under XdgCache; point it at the scratch area
-- for the duration so the suite never touches the developer's cache.
savedCacheHome <- lookupEnv "XDG_CACHE_HOME"
setEnv "XDG_CACHE_HOME" cacheHome
shas <- makeGitFixture repoDir [("first.txt", "one\n"), ("second.txt", "two\n"), ("third.txt", "three\n")]
results <-
sequence
[ -- Upstream reports revCount 0 under shallow, not an absent
-- attribute and not the fetch depth: observed from
-- nix-instantiate 2.33.2, where '.revCount or "ABSENT"' is 0.
-- The tree itself is depth-independent, so both fetches must
-- agree on narHash and outPath.
runTestM "a shallow fetch reports revCount 0 for the same tree" $ do
fullOutcome <- evalFetch ""
shallowOutcome <- evalFetch "shallow = true; "
pure $ case (fullOutcome, shallowOutcome) of
(Left err, _) -> Fail ("full fetch failed: " <> err)
(_, Left err) -> Fail ("shallow fetch failed: " <> err)
(Right fullVal, Right shallowVal) ->
let fullFields = fetchGitFields fullVal ["revCount", "narHash", "outPath"]
shallowFields = fetchGitFields shallowVal ["revCount", "narHash", "outPath"]
in case (fullFields, shallowFields) of
([("revCount", VInt 3), ("narHash", fullHash), ("outPath", fullPath)], [("revCount", VInt 0), ("narHash", shallowHash), ("outPath", shallowPath)])
| fullHash == shallowHash && fullPath == shallowPath -> Pass
| otherwise -> Fail "shallow and full fetches disagree about the tree"
_ -> Fail (T.pack (show (fullFields, shallowFields))),
-- The rev itself is the refspec, so a depth-1 fetch of a rev
-- that is not the branch tip still lands on exactly that rev.
runTestM "a shallow fetch of a pinned rev checks out that rev" $ case shas of
(firstSha : _) -> do
outcome <- evalFetch ("shallow = true; rev = \"" <> firstSha <> "\"; ")
case outcome of
Left err -> pure (Fail err)
Right val -> case fetchGitFields val ["rev", "revCount", "outPath"] of
[("rev", revVal), ("revCount", VInt 0), ("outPath", VPath outText)]
| revVal == mkStr firstSha -> do
let outDir = storeTextToFilePath (StoreDir tmpStore) outText
firstThere <- Dir.doesFileExist (outDir </> "first.txt")
thirdThere <- Dir.doesFileExist (outDir </> "third.txt")
pure $
if firstThere && not thirdThere
then Pass
else Fail "outPath does not hold the pinned rev's tree"
fields -> pure (Fail (T.pack (show fields)))
[] -> pure (Fail "fixture returned no commits"),
-- Pinned and unpinned differ in where counting starts: from the
-- rev, the root commit counts 1 (upstream 2.33.2 agrees), not
-- the branch's 3.
runTestM "a pinned rev fetch counts from the rev" $ case shas of
(firstSha : _) -> do
outcome <- evalFetch ("rev = \"" <> firstSha <> "\"; ")
pure $ case outcome of
Left err -> Fail err
Right val -> case fetchGitFields val ["rev", "revCount"] of
[("rev", revVal), ("revCount", VInt 1)]
| revVal == mkStr firstSha -> Pass
fields -> Fail (T.pack (show fields))
[] -> pure (Fail "fixture returned no commits")
]
maybe (unsetEnv "XDG_CACHE_HOME") (setEnv "XDG_CACHE_HOME") savedCacheHome
forceRemoveIfExists repoDir
forceRemoveIfExists tmpStore
forceRemoveIfExists cacheHome
pure results
-- | The fetchGit completeness remainder (#77): unsupported attributes
-- refuse, a declared narHash pins the tree on hit and fresh paths
-- alike, allRefs widens the fetch, and a failing fetch leaves no
-- scratch clone behind.
testFetchGitPins :: IO [Bool]
testFetchGitPins = do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-pins-store"
repoDir = tmpBase </> "nova-nix-test-pins-repo"
cacheHome = tmpBase </> "nova-nix-test-pins-cache"
urlText = T.concatMap (\c -> if c == '\\' then "\\\\" else T.singleton c) (T.pack repoDir)
evalHere = evalNixIOStore (StoreDir tmpStore) "."
fetchWith extra = evalHere ("builtins.fetchGit { url = \"" <> urlText <> "\"; " <> extra <> "}")
forceRemoveIfExists tmpStore
forceRemoveIfExists repoDir
forceRemoveIfExists cacheHome
savedCacheHome <- lookupEnv "XDG_CACHE_HOME"
setEnv "XDG_CACHE_HOME" cacheHome
shas <- makeGitFixture repoDir [("a.txt", "one\n")]
baseBranch <- fixtureGit repoDir ["rev-parse", "--abbrev-ref", "HEAD"]
_ <- fixtureGit repoDir ["checkout", "-q", "-b", "side"]
BS.writeFile (repoDir </> "side.txt") (TE.encodeUtf8 "side\n")
_ <- fixtureGit repoDir ["add", "-A"]
_ <- fixtureGit repoDir ["commit", "--quiet", "-m", "side"]
sideSha <- fixtureGit repoDir ["rev-parse", "HEAD"]
_ <- fixtureGit repoDir ["checkout", "-q", T.unpack baseBranch]
results <-
sequence
[ runTestM "an unsupported fetchGit attribute is refused" $ do
outcome <- fetchWith "bogus = 1; "
pure $ case outcome of
Left err
| "attribute 'bogus' not supported" `T.isInfixOf` err -> Pass
| otherwise -> Fail ("wrong error: " <> err)
Right _ -> Fail "an unsupported attribute was silently dropped",
runTestM "a mismatched narHash pin is an error" $ case shas of
(sha : _) -> do
outcome <- fetchWith ("rev = \"" <> sha <> "\"; narHash = \"sha256-" <> T.replicate 43 "A" <> "=\"; ")
pure $ case outcome of
Left err
| "NAR hash mismatch" `T.isInfixOf` err -> Pass
| otherwise -> Fail ("wrong error: " <> err)
Right _ -> Fail "a bogus narHash pin was silently ignored"
[] -> pure (Fail "fixture returned no commits"),
-- The second fetch of the same rev is a cache hit, so a matching
-- pin passing here proves the check runs on the hit path too.
runTestM "a matching narHash pin passes, including on a cache hit" $ case shas of
(sha : _) -> do
first <- fetchWith ("rev = \"" <> sha <> "\"; ")
case first of
Left err -> pure (Fail err)
Right val -> case fetchGitFields val ["narHash"] of
[("narHash", VStr hashBytes _)] -> do
let hash = TE.decodeUtf8Lenient hashBytes
second <- fetchWith ("rev = \"" <> sha <> "\"; narHash = \"" <> hash <> "\"; ")
pure $ case second of
Right _ -> Pass
Left err -> Fail ("a correct pin was refused: " <> err)
other -> pure (Fail (T.pack (show other)))
[] -> pure (Fail "fixture returned no commits"),
runTestM "allRefs finds a rev on an unfetched branch" $ do
outcome <- fetchWith ("rev = \"" <> sideSha <> "\"; allRefs = true; ")
pure $ case outcome of
Left err -> Fail err
Right val -> case fetchGitFields val ["rev"] of
[("rev", revVal)] | revVal == mkStr sideSha -> Pass
other -> Fail (T.pack (show other)),
runTestM "a failing fetch leaves no scratch clone behind" $ do
before <- filter ("nova-nix-fetchgit-" `T.isPrefixOf`) . map T.pack <$> Dir.listDirectory tmpBase
outcome <- evalHere ("builtins.fetchGit { url = \"" <> urlText <> "-no-such-repo\"; }")
after <- filter ("nova-nix-fetchgit-" `T.isPrefixOf`) . map T.pack <$> Dir.listDirectory tmpBase
pure $ case outcome of
Right _ -> Fail "a fetch of a missing repo succeeded"
Left _
| length after == length before -> Pass
| otherwise -> Fail ("scratch clones leaked: " <> T.pack (show (length after - length before)))
]
maybe (unsetEnv "XDG_CACHE_HOME") (setEnv "XDG_CACHE_HOME") savedCacheHome
forceRemoveIfExists tmpStore
forceRemoveIfExists repoDir
forceRemoveIfExists cacheHome
pure results
-- | String interpolation inside path literals (#178), the construct
-- nixpkgs uses 89 times on modern trees. Every rule here is pinned to
-- nix-instantiate 2.33.2's observed behavior: the result is a path,
-- pieces concatenate with no separator and canonicalize textually, a
-- path segment coerces without a store copy, context is refused, and
-- a trailing slash is a parse error.
testPathInterp :: IO [Bool]
testPathInterp = do
tmpBase <- getTemporaryDirectory
let fixtureDir = tmpBase </> "nova-nix-test-path-interp"
tmpStore = tmpBase </> "nova-nix-test-path-interp-store"
forceRemoveIfExists fixtureDir
forceRemoveIfExists tmpStore
Dir.createDirectoryIfMissing True (fixtureDir </> "sub")
BS.writeFile (fixtureDir </> "sub" </> "f.nix") (TE.encodeUtf8 "42")
let evalHere = evalNixIO fixtureDir
baseText = canonPathValue (T.pack fixtureDir)
results <-
sequence
[ runTestM "an interpolated path literal is a path" $ do
outcome <- evalHere "let v = \"sub\"; in builtins.typeOf ./${v}"
pure (assertRightValue outcome (mkStr "path")),
runTestM "a runtime dot-dot canonicalizes textually" $ do
outcome <- evalHere "let v = \"sub/..\"; in toString ./${v}"
pure (assertRightValue outcome (mkStr baseText)),
runTestM "pieces concatenate with no separator, mid-segment included" $ do
outcome <- evalHere "let v = \"a\"; in toString ./pre${v}${v}post"
pure (assertRightValue outcome (mkStr (baseText <> "/preaapost"))),
runTestM "an empty segment after the root is the root" $ do
outcome <- evalHere "toString /${\"\"}"
pure (assertRightValue outcome (mkStr "/")),
runTestM "a dotless relative literal interpolates" $ do
outcome <- evalHere "let v = \"f.nix\"; in toString sub/${v}"
pure (assertRightValue outcome (mkStr (baseText <> "/sub/f.nix"))),
runTestM "a path segment must coerce to a string" $ do
outcome <- evalHere "./${1}"
pure $ case outcome of
Left err
| "cannot coerce an integer to a string" `T.isInfixOf` err -> Pass
| otherwise -> Fail ("wrong error: " <> err)
Right _ -> Fail "an integer segment was accepted",
-- A path INSIDE a path interpolation appends its absolute text
-- with no store copy (string interpolation would copy) -
-- upstream's exact, odd, observable behavior. The expected text
-- goes through the canonicalizer because the separator between
-- the two halves is platform-shaped: on POSIX the inner path's
-- own leading slash serves, on Windows (C:...) the head's slash
-- survives instead.
runTestM "a path segment appends textually without a store copy" $ do
outcome <- evalHere "toString ./${./sub}"
pure (assertRightValue outcome (mkStr (canonPathValue (baseText <> "/" <> baseText <> "/sub")))),
runTestM "a context-carrying segment is refused" $ do
outcome <- evalNixIOStore (StoreDir tmpStore) fixtureDir "./${builtins.toFile \"n\" \"x\"}"
pure $ case outcome of
Left err
| "cannot be appended to a path" `T.isInfixOf` err -> Pass
| otherwise -> Fail ("wrong error: " <> err)
Right _ -> Fail "a store-path segment was accepted",
runTestM "a trailing slash is a parse error" $ do
outcome <- evalHere "let v = \"a\"; in ./sub/${v}/"
pure $ case outcome of
Left err
| "path has a trailing slash" `T.isInfixOf` err -> Pass
| otherwise -> Fail ("wrong error: " <> err)
Right _ -> Fail "a trailing slash parsed",
runTestM "a plain trailing-slash literal is a parse error" $ do
outcome <- evalHere "./sub/"
pure $ case outcome of
Left err
| "path has a trailing slash" `T.isInfixOf` err -> Pass
| otherwise -> Fail ("wrong error: " <> err)
Right _ -> Fail "a trailing slash parsed",
runTestM "import resolves an interpolated dot-dot path" $ do
outcome <- evalHere "let v = \"sub\"; in import ./${v}/../sub/f.nix"
pure (assertRightValue outcome (VInt 42)),
-- An spath followed by /${...} is NOT one literal: it parses as
-- application of the search path to a path, which fails at
-- eval - upstream's exact shape.
runTestM "a search path does not absorb an interpolation" $ do
outcome <- evalHere "let v = \"a\"; in <nixpkgs>/${v}"
pure $ case outcome of
Left _ -> Pass
Right val -> Fail ("spath absorbed the interpolation: " <> T.pack (show val))
]
forceRemoveIfExists fixtureDir
forceRemoveIfExists tmpStore
pure results
where
assertRightValue outcome expected = case outcome of
Right val | val == expected -> Pass
other -> Fail (T.pack (show other))
-- | A path reached through an attrset's @outPath@ (or a @__toString@
-- result) coerces exactly as the same path written directly: copied to
-- the store, with the store path in the string context. The broken
-- shape rendered the raw filesystem path with no copy and no context,
-- so @src = builtins.fetchGit { ... }@ produced empty inputSrcs and a
-- drvPath diverging from upstream, while the @.outPath@ spelling
-- worked. Verified against nix-instantiate 2.33.2: the attrset form's
-- drvPath now matches upstream byte for byte.
testOutPathCoercion :: IO [Bool]
testOutPathCoercion = do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-outpath-store"
srcDir = tmpBase </> "nova-nix-test-outpath-src"
cacheHome = tmpBase </> "nova-nix-test-outpath-cache"
repoDir = tmpBase </> "nova-nix-test-outpath-repo"
-- A RELATIVE path literal resolved against the eval's base dir: an
-- absolute Windows path (C:/...) is not a path literal at all - it
-- matches the URI rule (scheme:rest) and lexes as a string, which
-- correctly never copies. Relative spelling lexes as a path on
-- every platform.
srcLiteral = "./nova-nix-test-outpath-src" :: Text
drvPathWith srcExpr =
"(derivation { name = \"ctx-probe\"; system = \"x86_64-linux\"; "
<> "builder = \"/bin/sh\"; args = [\"-c\" \"echo ok > $out\"]; "
<> "src = "
<> srcExpr
<> "; }).drvPath"
evalHere = evalNixIOStore (StoreDir tmpStore) tmpBase
storeStr result = case result of
Right (VStr s _) -> Just (TE.decodeUtf8Lenient s)
_ -> Nothing
forceRemoveIfExists tmpStore
forceRemoveIfExists srcDir
forceRemoveIfExists cacheHome
forceRemoveIfExists repoDir
Dir.createDirectoryIfMissing True srcDir
BS.writeFile (srcDir </> "f.txt") (TE.encodeUtf8 "content\n")
savedCacheHome <- lookupEnv "XDG_CACHE_HOME"
setEnv "XDG_CACHE_HOME" cacheHome
gitShas <- makeGitFixture repoDir [("g.txt", "tracked\n")]
results <-
sequence
[ runTestM "an outPath attrset src derives the same drv as its path" $ do
attrForm <- evalHere (drvPathWith ("{ outPath = " <> srcLiteral <> "; }"))
pathForm <- evalHere (drvPathWith srcLiteral)
pure $ case (attrForm, pathForm) of
(Right a, Right b)
| a == b -> Pass
| otherwise -> Fail (T.pack (show (a, b)))
other -> Fail (T.pack (show other)),
runTestM "a fetchGit src derives the same drv as its outPath" $ case gitShas of
(sha : _) -> do
let fetch = "builtins.fetchGit { url = \"" <> T.concatMap (\c -> if c == '\\' then "\\\\" else T.singleton c) (T.pack repoDir) <> "\"; rev = \"" <> sha <> "\"; }"
attrForm <- evalHere (drvPathWith fetch)
outPathForm <- evalHere (drvPathWith ("(" <> fetch <> ").outPath"))
pure $ case (attrForm, outPathForm) of
(Right a, Right b)
| a == b -> Pass
| otherwise -> Fail (T.pack (show (a, b)))
other -> Fail (T.pack (show other))
[] -> pure (Fail "fixture returned no commits"),
-- Text-only assertions here and below: a source copy is
-- materialized by the build driver, not by a bare eval, so the
-- observable at eval time is the store-path spelling. The two
-- drvPath tests above cover the context end (an uncontexted src
-- would derive a different drv).
runTestM "interpolating an outPath attrset coerces to its store path" $ do
outcome <- evalHere ("\"${ { outPath = " <> srcLiteral <> "; } }\"")
pure $ case storeStr outcome of
Just text | isCanonicalStoreText text -> Pass
_ -> Fail (T.pack (show outcome)),
runTestM "a __toString path result coerces to its store path" $ do
outcome <- evalHere ("\"${ { __toString = self: " <> srcLiteral <> "; } }\"")
pure $ case storeStr outcome of
Just text | isCanonicalStoreText text -> Pass
_ -> Fail (T.pack (show outcome)),
runTestM "adding an outPath attrset to a string coerces to its store path" $ do
outcome <- evalHere ("\"src: \" + { outPath = " <> srcLiteral <> "; }")
pure $ case storeStr outcome of
Just text | Just rest <- T.stripPrefix "src: " text, isCanonicalStoreText rest -> Pass
_ -> Fail (T.pack (show outcome)),
runTestM "toJSON of an outPath attrset is its store path" $ do
outcome <- evalHere ("builtins.toJSON { outPath = " <> srcLiteral <> "; }")
pure $ case storeStr outcome of
Just text
| Just inner <- T.stripPrefix "\"" text >>= T.stripSuffix "\"",
isCanonicalStoreText inner ->
Pass
_ -> Fail (T.pack (show outcome))
]
maybe (unsetEnv "XDG_CACHE_HOME") (setEnv "XDG_CACHE_HOME") savedCacheHome
forceRemoveIfExists tmpStore
forceRemoveIfExists srcDir
forceRemoveIfExists cacheHome
forceRemoveIfExists repoDir
pure results
testScratchDirs :: IO [Bool]
testScratchDirs = do
putStrLn "eval/scratch-dirs"
st <- newEvalState platformStoreDir "."
sequence
[ runTestM "scratch dirs are distinct, real, and removable" $ do
createdA <- runEvalIO st (createScratchDir "nova-nix-test-scratch-")
createdB <- runEvalIO st (createScratchDir "nova-nix-test-scratch-")
case (createdA, createdB) of
(Right dirA, Right dirB)
| dirA == dirB -> pure (Fail "two scratch dirs share a name")
| otherwise -> do
existedA <- Dir.doesDirectoryExist (T.unpack dirA)
existedB <- Dir.doesDirectoryExist (T.unpack dirB)
removed <- runEvalIO st (removeScratchDir dirA >> removeScratchDir dirB)
goneA <- not <$> Dir.doesDirectoryExist (T.unpack dirA)
goneB <- not <$> Dir.doesDirectoryExist (T.unpack dirB)
pure $ case removed of
Left err -> Fail ("removeScratchDir failed: " <> err)
Right ()
| existedA && existedB && goneA && goneB -> Pass
| otherwise -> Fail "scratch dir lifecycle out of order"
(Left err, _) -> pure (Fail ("createScratchDir failed: " <> err))
(_, Left err) -> pure (Fail ("createScratchDir failed: " <> err)),
runTestM "scratch names carry the requested prefix" $ do
created <- runEvalIO st (createScratchDir "nova-nix-test-scratch-")
case created of
Left err -> pure (Fail ("createScratchDir failed: " <> err))
Right dir -> do
removed <- runEvalIO st (removeScratchDir dir)
pure $ case removed of
Left err -> Fail ("removeScratchDir failed: " <> err)
Right ()
| "nova-nix-test-scratch-" `T.isInfixOf` dir -> Pass
| otherwise -> Fail ("prefix missing from: " <> dir)
]
testNarKnownAnswer :: IO [Bool]
testNarKnownAnswer = do
putStrLn "nar/known-answer"
sequence
[ runTest "serialise matches the hand-written spec vector" $
if NAR.serialise narSpecTree == narSpecVector
then Pass
else Fail "NAR encoder no longer matches the spec byte layout",
runTest "deserialise reads the spec vector back" $
case NAR.deserialise narSpecVector of
Right entry
| NAR.serialise entry == narSpecVector -> Pass
| otherwise -> Fail "spec vector round-trips to different bytes"
Left err -> Fail ("spec vector rejected: " <> T.pack err),
-- The empty-input SHA-256 in nix-base32: pins digest, alphabet, and
-- bit order against the value real Nix computes.
runTest "sha256 empty formats to the known nix-base32 vector" $
assertEqual
"nix32-empty"
"sha256:0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73"
(CHash.formatNixHash (CHash.hashBytes BS.empty)),
-- addToStore must record exactly the hash of the spec bytes for the
-- same tree, or interop with every real cache silently breaks.
runTestM "addToStore records the externally-computed NAR hash" $ do
tmpBase <- getTemporaryDirectory
let srcDir = tmpBase </> "nova-nix-test-nar-vector-src"
tmpStore = tmpBase </> "nova-nix-test-nar-vector-store"
forceRemoveIfExists srcDir
forceRemoveIfExists tmpStore
createDirectoryIfMissing True srcDir
createDirectoryIfMissing True tmpStore
BS.writeFile (srcDir </> "data.txt") "hello\n"
store <- openStore (StoreDir tmpStore)
let sp = StorePath (T.replicate 32 "e") "nar-vector"
addToStore store srcDir sp Nothing []
recorded <- queryPathInfo (stDB store) sp
closeStore store
forceRemoveIfExists tmpStore
let expected = CHash.formatNixHash (CHash.hashBytes narSpecFileVector)
pure $ case recorded of
Just info -> assertEqual "recorded NarHash" expected (piNarHash info)
Nothing -> Fail "path not registered"
]
-- | store delete: row-and-tree removal with referrer refusal. The raw
-- basename channel exists for rows the current name rules reject; the
-- legacy-row case plants one over SQL exactly as a pre-name-rules store
-- carries it.
testStoreDelete :: IO [Bool]
testStoreDelete = do
putStrLn "store/delete"
withTempStore $ \store -> do
let sd = stDir store
basenameOf sp = spHash sp <> "-" <> spName sp
dep = StorePath (T.replicate 32 "a") "del-dep"
user = StorePath (T.replicate 32 "b") "del-user"
sequence
[ runTestM "referenced path is refused with its referrers listed" $ do
registerPaths
(stDB store)
[ PathRegistration dep "sha256:d" 1 Nothing [],
PathRegistration user "sha256:u" 1 Nothing [dep]
]
outcome <- deleteStorePathRaw store (basenameOf dep)
stillValid <- isValid store dep
pure $ case outcome of
Left err
| "referenced by" `T.isInfixOf` err,
T.pack (storePathToFilePath sd user) `T.isInfixOf` err,
stillValid ->
Pass
| otherwise -> Fail ("wrong refusal: " <> err)
Right removed -> Fail ("deleted a referenced path: " <> T.pack (show removed)),
runTestM "a reference chain deletes leaf-first" $ do
userGone <- deleteStorePathRaw store (basenameOf user)
depGone <- deleteStorePathRaw store (basenameOf dep)
depValid <- isValid store dep
userValid <- isValid store user
pure $ case (userGone, depGone) of
(Right _, Right _)
| not depValid && not userValid -> Pass
| otherwise -> Fail "rows survived deletion"
other -> Fail ("chain deletion failed: " <> T.pack (show other)),
runTestM "a registered row without a tree deletes (repair case)" $ do
let ghost = StorePath (T.replicate 32 "c") "del-ghost"
registerPath (stDB store) (PathRegistration ghost "sha256:g" 1 Nothing [])
outcome <- deleteStorePathRaw store (basenameOf ghost)
pure $ case outcome of
Right removed
| doRowRemoved removed && not (doTreeRemoved removed) -> Pass
| otherwise -> Fail ("wrong outcome: " <> T.pack (show removed))
Left err -> Fail err,
runTestM "an unregistered tree deletes (repair case)" $ do
let strayBase = T.replicate 32 "d" <> "-del-stray"
treePath = unStoreDir sd </> T.unpack strayBase
createDirectoryIfMissing True treePath
TIO.writeFile (treePath </> "junk.txt") "stray"
outcome <- deleteStorePathRaw store strayBase
gone <- not <$> Dir.doesPathExist treePath
pure $ case outcome of
Right removed
| not (doRowRemoved removed), doTreeRemoved removed, gone -> Pass
| otherwise -> Fail ("wrong outcome: " <> T.pack (show removed))
Left err -> Fail err,
runTestM "a read-only registered tree deletes fully" $ do
let solid = StorePath (T.replicate 32 "e") "del-solid"
treePath = storePathToFilePath sd solid
registerPath (stDB store) (PathRegistration solid "sha256:s" 1 Nothing [])
createDirectoryIfMissing True treePath
TIO.writeFile (treePath </> "data.txt") "content"
setReadOnly treePath
outcome <- deleteStorePathRaw store (basenameOf solid)
gone <- not <$> Dir.doesPathExist treePath
stillValid <- isValid store solid
pure $ case outcome of
Right removed
| doRowRemoved removed, doTreeRemoved removed, gone, not stillValid -> Pass
| otherwise -> Fail ("wrong outcome: " <> T.pack (show removed))
Left err -> Fail err,
runTestM "a self-referencing path deletes" $ do
let selfp = StorePath (T.replicate 32 "f") "del-self"
registerPath (stDB store) (PathRegistration selfp "sha256:f" 1 Nothing [selfp])
outcome <- deleteStorePathRaw store (basenameOf selfp)
pure (assertEqual "self delete" (Right (DeleteOutcome True False)) outcome),
runTestM "a target with neither row nor tree is an error" $ do
outcome <- deleteStorePathRaw store (T.replicate 32 "9" <> "-del-nothing")
pure $ case outcome of
Left err | "not in this store" `T.isInfixOf` err -> Pass
other -> Fail ("expected not-in-store, got: " <> T.pack (show other)),
runTestM "a legacy row the validator rejects deletes by raw text" $ do
let legacyBase = T.replicate 32 "g" <> "-old~marker"
treePath = unStoreDir sd </> T.unpack legacyBase
legacyPathText = T.pack treePath
conn <- SQL.open (unStoreDir sd </> metaDirName </> dbFileName)
SQL.execute
conn
"INSERT INTO ValidPaths (path, hash, registrationTime, deriver, narSize) VALUES (?, ?, 0, NULL, 0)"
(legacyPathText, "sha256:legacy" :: T.Text)
SQL.close conn
createDirectoryIfMissing True treePath
TIO.writeFile (treePath </> "seed.txt") "epoch"
let resolved = resolveDeleteTarget sd legacyPathText
outcome <- either (pure . Left) (deleteStorePathRaw store) resolved
remaining <- queryAllValidPaths (stDB store)
gone <- not <$> Dir.doesPathExist treePath
pure $ case outcome of
Right removed
| doRowRemoved removed, doTreeRemoved removed, gone, legacyPathText `notElem` remaining -> Pass
| otherwise -> Fail ("wrong outcome: " <> T.pack (show removed))
Left err -> Fail err,
runTest "resolveDeleteTarget accepts bare, store-dir, platform, and canonical spellings" $
let nameBase = T.replicate 32 "h" <> "-name"
spellings =
[ nameBase,
T.pack (unStoreDir sd </> T.unpack nameBase),
T.pack (unStoreDir platformStoreDir) <> "\\" <> nameBase,
defaultStoreDirText <> "/" <> nameBase
]
in assertEqual "all resolve" (replicate 4 (Right nameBase)) (map (resolveDeleteTarget sd) spellings),
runTest "resolveDeleteTarget refuses traversal shapes" $
let refused =
[ ".nova-nix",
"..",
".",
"",
T.pack (unStoreDir sd) <> "/",
"/somewhere/else/" <> T.replicate 32 "h" <> "-name",
T.replicate 32 "h" <> "-na:me"
]
in case [t | t <- refused, either (const False) (const True) (resolveDeleteTarget sd t)] of
[] -> Pass
accepted -> Fail ("accepted: " <> T.pack (show accepted)),
-- Lock files are never deleted (the Nix.Store.Lock design), but
-- names like flake.lock are legal store-path names, so only the
-- registration rows can tell a lock file from a store object:
-- an unregistered lock-shaped file refuses, a registered object
-- of the same shape deletes, and lock-shaped junk whose
-- stripped prefix is not a store basename deletes as junk.
runTestM "delete refuses an unregistered lock file by name" $ do
let guarded = StorePath (T.replicate 32 "j") "del-guard"
lockBase = basenameOf guarded <> ".lock"
lockPath = storePathToFilePath sd guarded <> ".lock"
TIO.writeFile lockPath ""
outcome <- deleteStorePathRaw store lockBase
survived <- Dir.doesPathExist lockPath
pure $ case outcome of
Left err
| "never deleted" `T.isInfixOf` err ->
if survived then Pass else Fail "lock file removed despite refusal"
| otherwise -> Fail ("wrong refusal: " <> err)
Right _ -> Fail "unregistered lock file was deleted",
runTestM "delete removes a registered store object named like a lock file" $ do
let object = StorePath (T.replicate 32 "k") "flake.lock"
objectPath = storePathToFilePath sd object
registerPath (stDB store) (PathRegistration object "sha256:m" 1 Nothing [])
TIO.writeFile objectPath "pinned inputs"
outcome <- deleteStorePathRaw store (basenameOf object)
gone <- not <$> Dir.doesPathExist objectPath
pure $ case outcome of
Right removed
| doRowRemoved removed, doTreeRemoved removed, gone -> Pass
| otherwise -> Fail ("wrong outcome: " <> T.pack (show removed))
Left err -> Fail ("registered .lock-named object refused: " <> err),
runTestM "delete removes lock-shaped junk with no store-shaped prefix" $ do
let junkName = "not-a-store-path.lock"
junkPath = unStoreDir sd </> T.unpack junkName
TIO.writeFile junkPath "debris"
outcome <- deleteStorePathRaw store junkName
gone <- not <$> Dir.doesPathExist junkPath
pure $ case outcome of
Right removed
| doTreeRemoved removed, gone -> Pass
| otherwise -> Fail ("wrong outcome: " <> T.pack (show removed))
Left err -> Fail ("lock-shaped junk refused: " <> err),
-- Deletion and substitution contend on one per-path lock: a
-- delete must wait while another handle holds the path's lock -
-- otherwise it can tear a tree out between a substituter's
-- on-disk recheck and its registration commit - and proceed
-- once the holder releases.
runTestM "delete waits for a held path lock and proceeds on release" $ do
let guarded = StorePath (T.replicate 32 "i") "del-locked"
treePath = storePathToFilePath sd guarded
registerPath (stDB store) (PathRegistration guarded "sha256:l" 1 Nothing [])
createDirectoryIfMissing True treePath
TIO.writeFile (treePath </> "data.txt") "guarded"
holder <- acquirePathLock sd guarded
done <- newEmptyMVar
_ <- forkIO (deleteStorePathRaw store (basenameOf guarded) >>= putMVar done)
early <- timeout deleteLockProbeMicros (takeMVar done)
releasePathLock holder
outcome <- timeout raceWatchdogMicros (takeMVar done)
gone <- not <$> Dir.doesPathExist treePath
pure $ case (early, outcome) of
(Just finished, _) ->
Fail ("delete ignored the held lock: " <> T.pack (show finished))
(Nothing, Just (Right removed))
| doRowRemoved removed, doTreeRemoved removed, gone -> Pass
| otherwise -> Fail ("wrong outcome after release: " <> T.pack (show removed))
(Nothing, other) ->
Fail ("delete never completed after release: " <> T.pack (show other)),
-- The eval-side materializer joins the same protocol (#21): its
-- check-then-act must wait while another handle holds the
-- path's lock - unlocked, the loser's removePathForcibly could
-- delete the tree the winner had just registered - and proceed
-- once the holder releases.
runTestM "materializeEvalSources waits for a held path lock" $ do
srcDir <- (</> "nova-nix-test-mat-lock-src") <$> getTemporaryDirectory
forceRemoveIfExists srcDir
createDirectoryIfMissing True srcDir
TIO.writeFile (srcDir </> "f.txt") "locked source"
-- The address the source's content derives, as evaluation
-- would name it: a restore refuses any other.
entry <- NAR.serialiseFromPath srcDir
case makeFixedOutputPath "mat-locked" "sha256" "recursive" (sha256Digest (NAR.serialise entry)) of
Left err -> pure (Fail ("test store path rejected: " <> T.pack (show err)))
Right guarded -> do
let spText = storePathToText defaultStoreDir guarded
holder <- acquirePathLock sd guarded
done <- newEmptyMVar
_ <- forkIO (materializeEvalSources store (Map.singleton (T.pack srcDir) spText) >>= putMVar done)
early <- timeout deleteLockProbeMicros (takeMVar done)
releasePathLock holder
outcome <- timeout raceWatchdogMicros (takeMVar done)
registered <- isValid store guarded
forceRemoveIfExists srcDir
pure $ case (early, outcome) of
(Just _, _) -> Fail "materialize ignored the held lock"
(Nothing, Just ())
| registered -> Pass
| otherwise -> Fail "proceeded after release but never registered"
(Nothing, Nothing) -> Fail "materialize never completed after release"
]
-- | The collector's pure core: the reachability walk over the references
-- map, and the sweep plan over the valid set, the live set, and the store
-- directory's entries. No store is opened.
testGcPure :: IO [Bool]
testGcPure = do
putStrLn "store/gc-pure"
let sd = StoreDir "/s"
at name = T.pack (unStoreDir sd </> name)
refs = referencesMap [(at "a", at "b"), (at "b", at "c"), (at "d", at "c"), (at "e", at "e")]
hashOf c = T.unpack (T.replicate 32 c)
liveName = hashOf "a" <> "-gc-live"
deadOnDisk = hashOf "b" <> "-gc-dead"
deadNoTree = hashOf "c" <> "-gc-ghost"
stale = hashOf "d" <> "-gc-stale"
nix32Alphabet = "0123456789abcdfghijklmnpqrsvwxyz" :: String
sequence
[ runTest "reachableFrom closes over references transitively" $
assertEqual "closure" (Set.fromList [at "a", at "b", at "c"]) (reachableFrom refs [at "a"]),
runTest "reachableFrom leaves paths the roots do not reach out" $
assertEqual "d alone" (Set.fromList [at "c", at "d"]) (reachableFrom refs [at "d"]),
runTest "reachableFrom terminates on a cycle and a self-reference" $
assertEqual
"cycle, self"
(Set.fromList [at "x", at "y"], Set.singleton (at "e"))
(reachableFrom (referencesMap [(at "x", at "y"), (at "y", at "x")]) [at "x"], reachableFrom refs [at "e"]),
runTest "reachableFrom keeps a root the map does not know as a dead end" $
assertEqual "unknown root" (Set.singleton (at "z")) (reachableFrom refs [at "z"]),
runTest "reachableFrom of no roots is empty" $
assertEqual "no roots" Set.empty (reachableFrom refs []),
-- Dead rows go whether or not a tree exists; every directory entry
-- that is not live goes too (a dead tree, a stale build, junk, a
-- dead path's lock file), while the live path, its lock file and
-- the metadata directory stay.
runTest "sweepPlan unregisters dead rows and removes every entry that is not live, keeping a live path's lock file" $
let valid = Set.fromList [at liveName, at deadOnDisk, at deadNoTree]
live = Set.fromList [at liveName]
entries = map T.pack [liveName, liveName <> ".lock", deadOnDisk, deadOnDisk <> ".lock", metaDirName, stale, stale <> ".lock", "junk-file"]
in assertEqual
"plan"
SweepPlan
{ spDeadRows = sort [at deadOnDisk, at deadNoTree],
spTrees = sort [at deadOnDisk, at (deadOnDisk <> ".lock"), at stale, at (stale <> ".lock"), at "junk-file"]
}
(sweepPlan sd valid live entries),
runTest "sweepPlan removes a dead registered object named like a live path's lock file" $
let lockNamed = liveName <> ".lock"
valid = Set.fromList [at liveName, at lockNamed]
live = Set.fromList [at liveName]
in assertEqual
"plan"
SweepPlan {spDeadRows = [at lockNamed], spTrees = [at lockNamed]}
(sweepPlan sd valid live (map T.pack [liveName, lockNamed])),
runTest "parseStorePathPrefix names the path for itself, a trailing separator and anything beneath, and nothing outside" $
let sp = StorePath (T.replicate 32 "a") "gc-live"
dirText = T.pack (unStoreDir sd)
named = map (parseStorePathPrefix sd) [at liveName, at liveName <> "/", at liveName <> "/bin/tool", at liveName <> "\\bin"]
unnamed = map (parseStorePathPrefix sd) [dirText, dirText <> "/", "/elsewhere/" <> T.pack liveName, dirText <> "/not-a-store-path"]
in assertEqual "prefixes" (replicate 4 (Just sp), replicate 4 Nothing) (named, unnamed),
runTest "showFreedBytes renders upstream's two-place MiB" $
assertEqual "MiB" ["0.00 MiB", "1.00 MiB", "1.50 MiB"] (map showFreedBytes [0, 1048576, 1572864]),
runTest "gcSummaryLine is upstream's PrintFreed line" $
assertEqual "summary" "2 store paths deleted, 1.00 MiB freed" (gcSummaryLine (GcResults [at "a", at "b"] 1048576)),
runTest "indirectRootRecordName is a nix-base32 digest keyed by the link path" $
let name = indirectRootRecordName "/home/u/result"
in if length name == 52 && all (`elem` nix32Alphabet) name && name /= indirectRootRecordName "/home/u/result-2"
then Pass
else Fail ("unexpected record name: " <> T.pack name)
]
-- | Garbage collection end to end against a temp store: a rooted closure
-- survives and the orphan goes, the rooted path and what it reaches
-- cannot be deleted, one directory keys one store however it is
-- spelled while a foreign spelling is refused, a removed root lets the
-- closure go, a dead cycle sweeps, a dead path's lock file goes with it,
-- a second open handle holds the collector off, a failed lease renewal
-- leaves a closable handle, and an out-link root behaves as nix-build's
-- result link does.
testStoreGC :: IO [Bool]
testStoreGC = do
putStrLn "store/gc"
canLink <- symlinksAvailable
tmpBase <- getTemporaryDirectory
let linkDir = tmpBase </> "nova-nix-test-gc-links"
outLink = linkDir </> "result"
Dir.removePathForcibly linkDir
createDirectoryIfMissing True linkDir
withTempStore $ \store -> do
let sd = stDir store
basenameOf sp = spHash sp <> "-" <> spName sp
pathText sp = T.pack (storePathToFilePath sd sp)
lockOf sp = storePathToFilePath sd sp <> ".lock"
plant sp bytes = do
let tree = storePathToFilePath sd sp
createDirectoryIfMissing True tree
BS.writeFile (tree </> "data") bytes
dep = StorePath (T.replicate 32 "a") "gc-dep"
top = StorePath (T.replicate 32 "b") "gc-top"
orphan = StorePath (T.replicate 32 "c") "gc-orphan"
rootFile = gcRootsDir sd </> T.unpack (basenameOf top)
registerTrio = do
mapM_ (uncurry plant) [(dep, "dep"), (top, "top!"), (orphan, "orphan bytes")]
registerPaths
(stDB store)
[ PathRegistration dep "sha256:d" 1 Nothing [],
PathRegistration top "sha256:t" 1 Nothing [dep],
PathRegistration orphan "sha256:o" 1 Nothing []
]
-- A refused collection is a failure of the test, not a result.
collect = collectGarbage store >>= either (throwIO . userError . T.unpack) pure
permanent <-
sequence
[ -- A regular file named like the path, under gcroots: upstream's
-- own permanent-root form, the one that needs no symlink.
runTestM "a permanent root keeps its closure and the orphan is swept" $ do
registerTrio
createDirectoryIfMissing True (gcRootsDir sd)
BS.writeFile rootFile ""
results <- collect
validity <- mapM (isValid store) [dep, top, orphan]
orphanGone <- not <$> Dir.doesPathExist (storePathToFilePath sd orphan)
topKept <- Dir.doesPathExist (storePathToFilePath sd top </> "data")
pure $
if results == GcResults [pathText orphan] 12 && validity == [True, True, False] && orphanGone && topKept
then Pass
else Fail ("wrong sweep: " <> T.pack (show (results, validity, orphanGone, topKept))),
runTestM "delete refuses the rooted path with upstream's words" $ do
outcome <- deleteStorePathRaw store (basenameOf top)
stillValid <- isValid store top
pure $ case outcome of
Left err
| "since it is still alive" `T.isInfixOf` err, pathText top `T.isInfixOf` err, stillValid -> Pass
| otherwise -> Fail ("wrong refusal: " <> err)
Right removed -> Fail ("deleted a rooted path: " <> T.pack (show removed)),
runTestM "delete refuses a path the root reaches through references" $ do
outcome <- deleteStorePathRaw store (basenameOf dep)
pure $ case outcome of
Left err | "since it is still alive" `T.isInfixOf` err -> Pass
other -> Fail ("expected the liveness refusal, got: " <> T.pack (show other)),
runTestM "findRoots reports the permanent root under its own path" $ do
roots <- findRoots store
pure (assertEqual "roots" [GcRoot rootFile (pathText top)] roots),
-- One directory keys one set of rows however it is spelled: the
-- handle canonicalises the spelling at open, so a second handle
-- opened through '.', '..' and a trailing separator (and, when
-- the temp store shares the working directory's drive, through
-- a relative path) is the same store with the same root.
runTestM "openStore keys the store by one spelling of its directory" $ do
cwd <- Dir.getCurrentDirectory
let dotted = unStoreDir sd </> "." </> "zig" </> ".." <> [pathSeparator]
relative =
[ joinPath (replicate (length (splitDirectories cwd) - 1) "..") </> dropDrive (unStoreDir sd)
| takeDrive cwd == takeDrive (unStoreDir sd)
]
spellings = dotted : relative
inspect spelling = do
other <- openStore (StoreDir spelling)
roots <- findRoots other
closeStore other
pure (stDir other, roots)
outcomes <- mapM inspect spellings
pure (assertEqual "spellings" (map (const (sd, [GcRoot rootFile (pathText top)])) spellings) outcomes),
-- A row keyed under another spelling of the directory would
-- compare as dead; the collector and the checked delete refuse
-- instead of sweeping, and nothing changes.
runTestM "a collection and a checked delete refuse a database keyed under another spelling" $ do
let foreignRow = "/elsewhere/" <> T.replicate 32 "z" <> "-gc-foreign"
conn <- SQL.open (unStoreDir sd </> metaDirName </> dbFileName)
SQL.execute
conn
"INSERT INTO ValidPaths (path, hash, registrationTime, deriver, narSize) VALUES (?, ?, 0, NULL, 0)"
(foreignRow, "sha256:z" :: T.Text)
collected <- collectGarbage store
deleted <- deleteStorePathRaw store (basenameOf dep)
SQL.execute conn "DELETE FROM ValidPaths WHERE path = ?" (SQL.Only foreignRow)
SQL.close conn
validity <- mapM (isValid store) [dep, top, orphan]
topKept <- Dir.doesPathExist (storePathToFilePath sd top </> "data")
pure $ case (collected, deleted) of
(Left gcErr, Left delErr)
| "another spelling" `T.isInfixOf` gcErr,
"another spelling" `T.isInfixOf` delErr,
validity == [True, True, False],
topKept ->
Pass
other -> Fail ("expected both refusals, got: " <> T.pack (show (other, validity, topKept))),
-- Upstream reports an entry it cannot read and carries on; a
-- directory with no permissions is the reproducible case, and
-- one that lists anyway (root, or Windows, where permissions
-- do not forbid a listing) proves nothing and is skipped.
runTestM "an unreadable entry under gcroots is reported and skipped" $ do
let locked = gcRootsDir sd </> "locked"
unlock = do
Dir.setPermissions locked (Dir.setOwnerReadable True (Dir.setOwnerSearchable True (Dir.setOwnerWritable True Dir.emptyPermissions)))
Dir.removePathForcibly locked
createDirectoryIfMissing True locked
Dir.setPermissions locked Dir.emptyPermissions
readable <- try (Dir.listDirectory locked) :: IO (Either SomeException [FilePath])
-- Restored on every exit: a walk that throws here would
-- otherwise leave the directory unreadable for every later
-- root walk in the group.
roots <- findRoots store `finally` unlock
case readable of
Right _ -> Pass <$ putStrLn " SKIP an empty-permission directory is readable here"
Left _ -> pure (assertEqual "roots" [GcRoot rootFile (pathText top)] roots),
runTestM "removing the root lets the closure go in one sweep" $ do
Dir.removeFile rootFile
results <- collect
remaining <- queryAllValidPaths (stDB store)
depGone <- not <$> Dir.doesPathExist (storePathToFilePath sd dep)
pure $
if gcrDeleted results == [pathText dep, pathText top] && null remaining && depGone
then Pass
else Fail ("closure survived: " <> T.pack (show (results, remaining, depGone))),
-- Cross-output references run both ways between the outputs of
-- one derivation, and no order of one-row deletes gets through
-- that; the batch delete does.
runTestM "a dead reference cycle is swept" $ do
let out = StorePath (T.replicate 32 "d") "gc-cycle-out"
dev = StorePath (T.replicate 32 "e") "gc-cycle-dev"
mapM_ (uncurry plant) [(out, "o"), (dev, "d")]
registerPaths
(stDB store)
[ PathRegistration out "sha256:x" 1 Nothing [dev],
PathRegistration dev "sha256:y" 1 Nothing [out]
]
results <- collect
remaining <- queryAllValidPaths (stDB store)
pure (assertEqual "swept" ([pathText out, pathText dev], []) (gcrDeleted results, remaining)),
-- Every entry that is not live goes, a dead path's lock file
-- with it; a live path's lock file is the one lock file the
-- protocol keeps, and it goes once the path does.
runTestM "a dead path's lock file is swept with it and a live path's stays until the path goes" $ do
registerTrio
BS.writeFile rootFile ""
let stale = StorePath (T.replicate 32 "f") "gc-stale"
plant stale "stale"
BS.writeFile (lockOf stale) ""
BS.writeFile (lockOf top) ""
first <- collect
staleGone <- not <$> Dir.doesPathExist (storePathToFilePath sd stale)
staleLockGone <- not <$> Dir.doesPathExist (lockOf stale)
topLockKept <- Dir.doesPathExist (lockOf top)
Dir.removeFile rootFile
second <- collect
topLockGone <- not <$> Dir.doesPathExist (lockOf top)
remaining <- queryAllValidPaths (stDB store)
pure $
if gcrDeleted first == sort [pathText orphan, pathText stale, T.pack (lockOf stale)]
&& staleGone
&& staleLockGone
&& topLockKept
&& gcrDeleted second == sort [pathText dep, pathText top, T.pack (lockOf top)]
&& topLockGone
&& null remaining
then Pass
else Fail ("wrong sweep: " <> T.pack (show (first, staleGone, staleLockGone, topLockKept, second, topLockGone, remaining))),
-- Every open handle holds the collector lock shared; the
-- collector needs it exclusive, so it waits for the other
-- handle to close and runs the moment it does.
runTestM "collectGarbage waits for another open handle to close" $ do
other <- openStore sd
done <- newEmptyMVar
_ <- forkIO (collect >>= putMVar done)
early <- timeout deleteLockProbeMicros (takeMVar done)
closeStore other
outcome <- timeout raceWatchdogMicros (takeMVar done)
pure $ case (early, outcome) of
(Just _, _) -> Fail "collector ignored the other handle's lease"
(Nothing, Just _) -> Pass
(Nothing, Nothing) -> Fail "collector never ran after the other handle closed",
-- A renewal that fails must not leave the handle without a
-- lease slot, or closeStore waits forever. The lock file is
-- replaced by a directory while the exclusive lock is held, so
-- the shared re-acquire cannot open it; Windows forbids
-- replacing a held file, so the case is POSIX-only.
runTestM "withCollectorLock leaves a closable handle when the lease cannot be renewed" $
if SI.os == "mingw32"
then Pass <$ putStrLn " SKIP a held lock file cannot be replaced on Windows"
else do
let renewalStore = tmpBase </> "nova-nix-test-gc-renewal"
Dir.removePathForcibly renewalStore
other <- openStore (StoreDir renewalStore)
let lockPath = gcLockFilePath (stDir other)
swapped <- try (withCollectorLock other (Dir.removeFile lockPath >> Dir.createDirectory lockPath))
closed <- timeout raceWatchdogMicros (closeStore other)
Dir.removePathForcibly renewalStore
pure $ case (swapped :: Either SomeException (), closed) of
(Left _, Just ()) -> Pass
(Right (), _) -> Fail "renewal succeeded against a directory"
(Left _, Nothing) -> Fail "closeStore hung after a failed renewal"
]
linked <-
if not canLink
then do
putStrLn " SKIP out-link roots need symlink privilege"
pure []
else
sequence
[ runTestM "an out-link root keeps the closure until the link is removed" $ do
registerTrio
rooted <- addOutLinkRoot store outLink top
case rooted of
Left err -> pure (Fail err)
Right link -> do
let record = autoRootsDir sd </> indirectRootRecordName link
recordThere <- Dir.doesFileExist record
roots <- findRoots store
first <- collect
Dir.removePathForcibly link
second <- collect
recordGone <- not <$> Dir.doesFileExist record
remaining <- queryAllValidPaths (stDB store)
pure $
if roots == [GcRoot link (pathText top)]
&& recordThere
&& gcrDeleted first == [pathText orphan]
&& gcrDeleted second == [pathText dep, pathText top]
&& recordGone
&& null remaining
then Pass
else Fail ("out-link root misbehaved: " <> T.pack (show (roots, recordThere, first, second, recordGone, remaining))),
-- upstream's findRoots takes toStorePath of the target, so a
-- link into a store path's subtree, or to the path with a
-- trailing separator, roots the path.
runTestM "a symlink root into a store path's subtree or with a trailing separator roots the path" $ do
plant top "top"
registerPath (stDB store) (PathRegistration top "sha256:t" 1 Nothing [])
let subLink = gcRootsDir sd </> "sub"
slashLink = gcRootsDir sd </> "slash"
Dir.createFileLink (storePathToFilePath sd top </> "data") subLink
Dir.createDirectoryLink (storePathToFilePath sd top <> [pathSeparator]) slashLink
roots <- findRoots store
mapM_ Dir.removePathForcibly [subLink, slashLink]
pure (assertEqual "roots" [GcRoot slashLink (pathText top), GcRoot subLink (pathText top)] roots),
-- upstream dedups through a set keyed by (link, path); an
-- operator's symlink to the out-link and the out-link's own
-- record name the same root.
runTestM "findRoots lists one link once when two records name it" $ do
rooted <- addOutLinkRoot store outLink top
case rooted of
Left err -> pure (Fail err)
Right link -> do
let mine = gcRootsDir sd </> "mine"
Dir.createFileLink link mine
roots <- findRoots store
mapM_ Dir.removePathForcibly [mine, link]
pure (assertEqual "roots" [GcRoot link (pathText top)] roots),
-- upstream's addPermRoot canonPaths the link and makeSymlink
-- creates its parents; a '..' that lands inside the store is
-- refused as inside.
runTestM "addOutLinkRoot collapses .. and creates missing parents, and .. cannot spell a link into the store" $ do
let expectedLink = T.unpack (canonPath (T.pack (linkDir </> "deep" </> "result")))
dotted = linkDir </> "deep" </> "down" </> ".." </> "result"
insideViaDotDot = takeDirectory (unStoreDir sd) </> takeFileName linkDir </> ".." </> takeFileName (unStoreDir sd) </> "result"
collapsed <- addOutLinkRoot store dotted top
target <- Dir.getSymbolicLinkTarget expectedLink
recorded <- BS.readFile (autoRootsDir sd </> indirectRootRecordName expectedLink)
inside <- addOutLinkRoot store insideViaDotDot top
pure $ case (collapsed, inside) of
(Right link, Left insideErr)
| link == expectedLink,
target == storePathToFilePath sd top,
recorded == TE.encodeUtf8 (T.pack link),
"in the Nix store is forbidden" `T.isInfixOf` insideErr ->
Pass
other -> Fail ("wrong outcomes: " <> T.pack (show (other, target, recorded))),
-- upstream's addPermRoot: an existing store link is replaced,
-- anything else at the name is refused, and a link inside
-- the store is refused.
runTestM "addOutLinkRoot replaces a store link and refuses a file or a link inside the store" $ do
let replaceLink = linkDir </> "replace"
plainFile = linkDir </> "plain"
Dir.createFileLink (storePathToFilePath sd orphan) replaceLink
replaced <- addOutLinkRoot store replaceLink top
target <- Dir.getSymbolicLinkTarget replaceLink
BS.writeFile plainFile "not a link"
clobber <- addOutLinkRoot store plainFile top
inside <- addOutLinkRoot store (unStoreDir sd </> "result") top
pure $ case (replaced, clobber, inside) of
(Right _, Left clobberErr, Left insideErr)
| target == storePathToFilePath sd top,
"already exists" `T.isInfixOf` clobberErr,
"in the Nix store is forbidden" `T.isInfixOf` insideErr ->
Pass
other -> Fail ("wrong outcomes: " <> T.pack (show (other, target)))
]
Dir.removePathForcibly linkDir
pure (permanent ++ linked)
testStoreOps :: IO [Bool]
testStoreOps = do
putStrLn "store/ops"
withTempStore $ \store -> do
let sd = stDir store
sequence
[ -- computeClosure emits references before referrers (deps-first):
-- phase-2 narinfo publication then never announces a path whose
-- references are not yet visible. The dep is shared by both
-- roots and must precede both.
runTestM "computeClosure orders references first" $ do
let dep = StorePath "llllllllllllllllllllllllllllllll" "cl-dep"
p1 = StorePath "mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm" "cl-p1"
p2 = StorePath "nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn" "cl-p2"
registerPaths
(stDB store)
[ PathRegistration dep "sha256:cd" 1 Nothing [],
PathRegistration p1 "sha256:c1" 2 Nothing [dep],
PathRegistration p2 "sha256:c2" 3 Nothing [dep]
]
result <- computeClosure store [p1, p2]
pure (assertEqual "closure order" (Right [dep, p1, p2]) result),
-- materializeEvalSources adoption is verified: a partial tree left
-- at the destination by an interrupted restore must be cleared
-- and restored again, never registered as-is.
runTestM "materializeEvalSources restores over a mismatched tree" $ do
tmpBase <- getTemporaryDirectory
let srcDir = tmpBase </> "nova-nix-test-adopt-src"
removeIfExists srcDir
createDirectoryIfMissing True srcDir
TIO.writeFile (srcDir </> "data.txt") "real content"
entry <- NAR.serialiseFromPath srcDir
case makeFixedOutputPath "nova-nix-test-adopt-src" "sha256" "recursive" (sha256Digest (NAR.serialise entry)) of
Left err -> pure (Fail ("test store path rejected: " <> T.pack (show err)))
Right sp -> do
let spText = storePathToText defaultStoreDir sp
dest = storePathToFilePath (stDir store) sp
-- Fake an interrupted earlier copy: wrong partial content.
removeIfExists dest
createDirectoryIfMissing True dest
TIO.writeFile (dest </> "data.txt") "partial garbage"
materializeEvalSources store (Map.fromList [(T.pack srcDir, spText)])
adopted <- TIO.readFile (dest </> "data.txt")
registered <- isValid store sp
removeIfExists srcDir
pure $
if adopted == "real content" && registered
then Pass
else Fail ("expected re-copied content, got: " <> adopted),
-- Evaluation hashes a source well before the build driver
-- restores it. A source edited in between no longer reproduces
-- the address evaluation gave it, so it is refused and nothing
-- is left at the path, rather than its new bytes being sealed
-- and registered under the old address (#235).
runTestM "materializeEvalSources refuses a source changed since evaluation" $ do
tmpBase <- getTemporaryDirectory
let srcDir = tmpBase </> "nova-nix-test-changed-src"
removeIfExists srcDir
createDirectoryIfMissing True srcDir
TIO.writeFile (srcDir </> "data.txt") "evaluated content"
entry <- NAR.serialiseFromPath srcDir
case makeFixedOutputPath "nova-nix-test-changed-src" "sha256" "recursive" (sha256Digest (NAR.serialise entry)) of
Left err -> pure (Fail ("test store path rejected: " <> T.pack (show err)))
Right sp -> do
let spText = storePathToText defaultStoreDir sp
dest = storePathToFilePath (stDir store) sp
forceRemoveIfExists dest
TIO.writeFile (srcDir </> "data.txt") "edited after evaluation"
outcome <- try (materializeEvalSources store (Map.fromList [(T.pack srcDir, spText)]))
registered <- isValid store sp
leftBehind <- Dir.doesPathExist dest
removeIfExists srcDir
pure $ case outcome of
Right () -> Fail "registered a source that changed after evaluation"
Left (e :: IOException)
| not ("changed after evaluation hashed it" `T.isInfixOf` T.pack (ioeGetErrorString e)) ->
Fail ("unexpected refusal: " <> T.pack (show e))
| registered || leftBehind ->
Fail ("refused, but registered " <> T.pack (show registered) <> ", tree left " <> T.pack (show leftBehind))
| otherwise -> Pass,
-- The registrar's half of the eval-write pair: content that does
-- not re-derive its store path under the recorded scheme must be
-- refused loudly, never registered valid under a hash its bytes
-- do not have and then sealed read-only.
runTestM "materializeEvalStoreWrites refuses content that does not reproduce its path" $ do
let goodBytes = TE.encodeUtf8 "the full flat content"
case makeFixedOutputPath "flat-verify" "sha256" "flat" (sha256Digest goodBytes) of
Left err -> pure (Fail ("test store path rejected: " <> T.pack (show err)))
Right sp -> do
let spText = storePathToText defaultStoreDir sp
dest = storePathToFilePath (stDir store) sp
removeIfExists dest
BS.writeFile dest (TE.encodeUtf8 "the full")
outcome <- try (materializeEvalStoreWrites store (Map.fromList [(spText, ([], WriteFlat))]))
stillInvalid <- not <$> isValid store sp
removeIfExists dest
pure $ case (outcome :: Either SomeException ()) of
Left _ | stillInvalid -> Pass
Left _ -> Fail "refused but registered anyway"
Right () -> Fail "registered a truncated write as valid",
runTestM "materializeEvalStoreWrites registers content that reproduces its path" $ do
let goodBytes = TE.encodeUtf8 "registered text content"
refs = []
case makeTextPath "text-verify" (sha256Digest goodBytes) refs of
Left err -> pure (Fail ("test store path rejected: " <> T.pack (show err)))
Right sp -> do
let spText = storePathToText defaultStoreDir sp
dest = storePathToFilePath (stDir store) sp
removeIfExists dest
BS.writeFile dest goodBytes
materializeEvalStoreWrites store (Map.fromList [(spText, (refs, WriteText))])
registered <- isValid store sp
pure (assertEqual "registered" True registered),
-- A tree that DOES reproduce its store path is adopted untouched.
-- The source is deleted before the call: adoption never reads it,
-- so a wrongful re-copy attempt throws and fails the test.
runTestM "materializeEvalSources adopts a matching tree untouched" $ do
tmpBase <- getTemporaryDirectory
let srcDir = tmpBase </> "nova-nix-test-adopt-ok"
removeIfExists srcDir
createDirectoryIfMissing True srcDir
TIO.writeFile (srcDir </> "data.txt") "same bytes"
entry <- NAR.serialiseFromPath srcDir
case makeFixedOutputPath "nova-nix-test-adopt-ok" "sha256" "recursive" (sha256Digest (NAR.serialise entry)) of
Left err -> pure (Fail ("test store path rejected: " <> T.pack (show err)))
Right sp -> do
let spText = storePathToText defaultStoreDir sp
dest = storePathToFilePath (stDir store) sp
removeIfExists dest
createDirectoryIfMissing True dest
TIO.writeFile (dest </> "data.txt") "same bytes"
removeIfExists srcDir
materializeEvalSources store (Map.fromList [(T.pack srcDir, spText)])
registered <- isValid store sp
pure (if registered then Pass else Fail "matching tree was not adopted and registered"),
-- scanReferences finds the canonical /nix/store text eval injects
-- into builder envs, independent of the platform store dir (the
-- bare hash is the needle, matching upstream Nix).
runTestM "scanReferences finds canonical ref" $ do
tmpBase <- getTemporaryDirectory
let scanDir = tmpBase </> "nova-nix-test-scan"
removeIfExists scanDir
createDirectoryIfMissing True scanDir
let candidate = StorePath "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "dep1"
refString = "/nix/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-dep1"
BS.writeFile (scanDir </> "output.txt") (TE.encodeUtf8 (T.pack ("hello " <> refString <> " world")))
refs <- scanReferences [candidate] scanDir
removeIfExists scanDir
pure $
if candidate `elem` refs
then Pass
else Fail ("expected to find ref, got: " <> T.pack (show refs)),
-- scanReferences finds a Windows-form embedding too
runTestM "scanReferences finds windows-form ref" $ do
tmpBase <- getTemporaryDirectory
let scanDir = tmpBase </> "nova-nix-test-scan-win"
removeIfExists scanDir
createDirectoryIfMissing True scanDir
let candidate = StorePath "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "dep1"
refString = "C:\\nix\\store\\aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-dep1"
BS.writeFile (scanDir </> "output.txt") (TE.encodeUtf8 (T.pack ("exec " <> refString)))
refs <- scanReferences [candidate] scanDir
removeIfExists scanDir
pure $
if candidate `elem` refs
then Pass
else Fail ("expected to find ref, got: " <> T.pack (show refs)),
-- scanReferences misses non-matching
runTestM "scanReferences misses non-match" $ do
tmpBase <- getTemporaryDirectory
let scanDir = tmpBase </> "nova-nix-test-scan2"
removeIfExists scanDir
createDirectoryIfMissing True scanDir
let candidate = StorePath "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "dep1"
BS.writeFile (scanDir </> "output.txt") "no store paths here"
refs <- scanReferences [candidate] scanDir
removeIfExists scanDir
pure (assertEqual "no refs" [] refs),
-- scanReferences ignores partial match
runTestM "scanReferences ignores partial" $ do
tmpBase <- getTemporaryDirectory
let scanDir = tmpBase </> "nova-nix-test-scan3"
removeIfExists scanDir
createDirectoryIfMissing True scanDir
let candidate = StorePath "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "dep1"
-- Only 20 chars of hash - should not match the 32-char needle
partialRef = "/nix/store/aaaaaaaaaaaaaaaaaaaa"
BS.writeFile (scanDir </> "output.txt") (TE.encodeUtf8 (T.pack partialRef))
refs <- scanReferences [candidate] scanDir
removeIfExists scanDir
pure (assertEqual "no partial refs" [] refs),
-- scanTempReferences records the self/cross-output edges that the
-- store-prefix scan cannot see (outputs embedding their TEMP path)
runTestM "scanTempReferences finds temp-dir embedding" $ do
tmpBase <- getTemporaryDirectory
let scanDir = tmpBase </> "nova-nix-test-scan-temp"
fakeTempOut = tmpBase </> "nova-nix-build" </> "fake-out"
removeIfExists scanDir
createDirectoryIfMissing True scanDir
let selfSp = StorePath "cccccccccccccccccccccccccccccccc" "self"
BS.writeFile
(scanDir </> "wrapper.sh")
(TE.encodeUtf8 (T.pack ("exec " <> fakeTempOut <> "/bin/tool")))
found <- scanTempReferences [(fakeTempOut, selfSp)] scanDir
removeIfExists scanDir
pure (assertEqual "self-ref found" [selfSp] found),
runTestM "scanTempReferences negative" $ do
tmpBase <- getTemporaryDirectory
let scanDir = tmpBase </> "nova-nix-test-scan-temp-neg"
removeIfExists scanDir
createDirectoryIfMissing True scanDir
let selfSp = StorePath "cccccccccccccccccccccccccccccccc" "self"
BS.writeFile (scanDir </> "clean.txt") "no temp paths embedded here"
found <- scanTempReferences [(tmpBase </> "nova-nix-build" </> "fake-out", selfSp)] scanDir
removeIfExists scanDir
pure (assertEqual "no refs" [] found),
-- addToStore moves dir + registers in DB
runTestM "addToStore moves + registers" $ do
tmpBase <- getTemporaryDirectory
let srcDir = tmpBase </> "nova-nix-test-add-src"
removeIfExists srcDir
createDirectoryIfMissing True srcDir
writeFile (srcDir </> "hello.txt") "hello world"
let sp = StorePath "zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz" "addtest"
addToStore store srcDir sp Nothing []
valid <- isValid store sp
exists <- pathExists store sp
pure $
if valid && exists
then Pass
else Fail ("valid=" <> T.pack (show valid) <> " exists=" <> T.pack (show exists)),
-- addToStore sets read-only
runTestM "addToStore sets read-only" $ do
tmpBase <- getTemporaryDirectory
let srcDir = tmpBase </> "nova-nix-test-add-ro"
removeIfExists srcDir
createDirectoryIfMissing True srcDir
writeFile (srcDir </> "data.txt") "data"
let sp = StorePath "yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy" "rotest"
addToStore store srcDir sp Nothing []
let destFile = storePathToFilePath sd sp </> "data.txt"
perms <- getPermissions destFile
pure $
if not (writable perms)
then Pass
else Fail "expected read-only but file is writable",
-- setReadOnly works on a plain directory
runTestM "setReadOnly makes dir read-only" $ do
tmpBase <- getTemporaryDirectory
let roDir = tmpBase </> "nova-nix-test-readonly"
removeIfExists roDir
createDirectoryIfMissing True roDir
writeFile (roDir </> "f.txt") "content"
setReadOnly roDir
dirPerms <- getPermissions roDir
filePerms <- getPermissions (roDir </> "f.txt")
-- Cleanup: restore writable so removeIfExists works
Dir.setPermissions roDir (Dir.setOwnerWritable True dirPerms)
Dir.setPermissions (roDir </> "f.txt") (Dir.setOwnerWritable True filePerms)
removeIfExists roDir
pure $
if not (writable dirPerms) && not (writable filePerms)
then Pass
else
Fail
( "dir writable="
<> T.pack (show (writable dirPerms))
<> " file writable="
<> T.pack (show (writable filePerms))
),
-- pathExists true after addToStore
runTestM "pathExists after addToStore" $ do
tmpBase <- getTemporaryDirectory
let srcDir = tmpBase </> "nova-nix-test-exists"
removeIfExists srcDir
createDirectoryIfMissing True srcDir
writeFile (srcDir </> "x.txt") "x"
let sp = StorePath "wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww" "existstest"
addToStore store srcDir sp Nothing []
exists <- pathExists store sp
pure (assertEqual "exists" True exists)
]
-- | Store walks treat a symlink as a leaf. Each fixture plants a link
-- the walk must not follow - out of the tree or back into it (a cycle) -
-- and asserts the walk neither reads nor mutates through the link, and
-- still terminates.
testSymlinkWalksIO :: IO [Bool]
testSymlinkWalksIO = do
putStrLn "store/symlink-walks"
canLink <- symlinksAvailable
if not canLink
then do
putStrLn " SKIP cannot create symlinks here (Windows needs Developer Mode or elevation)"
pure []
else
sequence
[ -- A link out of the tree must not have the read-only bit
-- pushed through to its target.
runTestM "setReadOnly does not mark link targets outside the tree" $ do
tmpBase <- getTemporaryDirectory
let base = tmpBase </> "nova-nix-test-ro-links"
outside = base </> "outside"
tree = base </> "tree"
Dir.removePathForcibly base
createDirectoryIfMissing True outside
createDirectoryIfMissing True tree
BS.writeFile (outside </> "victim.txt") "victim"
BS.writeFile (tree </> "inside.txt") "inside"
Dir.createFileLink (outside </> "victim.txt") (tree </> "file-link")
Dir.createDirectoryLink outside (tree </> "dir-link")
setReadOnly tree
victimWritable <- writable <$> getPermissions (outside </> "victim.txt")
insideWritable <- writable <$> getPermissions (tree </> "inside.txt")
Dir.removePathForcibly base
pure $
if victimWritable && not insideWritable
then Pass
else
Fail
( "victim writable="
<> T.pack (show victimWritable)
<> " inside writable="
<> T.pack (show insideWritable)
),
-- A link cycle must not recurse the walk forever.
runTestM "setReadOnly terminates on a link cycle" $ do
tmpBase <- getTemporaryDirectory
let tree = tmpBase </> "nova-nix-test-ro-cycle"
Dir.removePathForcibly tree
createDirectoryIfMissing True (tree </> "sub")
BS.writeFile (tree </> "sub" </> "f.txt") "f"
Dir.createDirectoryLink tree (tree </> "sub" </> "loop")
outcome <- timeout walkWatchdogMicros (setReadOnly tree)
marked <- writable <$> getPermissions (tree </> "sub" </> "f.txt")
Dir.removePathForcibly tree
pure $ case outcome of
Nothing -> Fail "walk did not terminate on a link cycle"
Just ()
| marked -> Fail "regular file next to the cycle link was not marked read-only"
| otherwise -> Pass,
-- The reference scan reads a link's TARGET STRING (the NAR
-- carries it) and never the bytes behind the link.
runTestM "scanReferences scans link targets, not linked bytes" $ do
tmpBase <- getTemporaryDirectory
let base = tmpBase </> "nova-nix-test-scan-links"
outside = base </> "outside"
scanDir = base </> "tree"
inTargetHash = T.replicate 32 "a"
outsideHash = T.replicate 32 "b"
inTarget = StorePath inTargetHash "dep1"
outsideOnly = StorePath outsideHash "dep2"
Dir.removePathForcibly base
createDirectoryIfMissing True outside
createDirectoryIfMissing True scanDir
-- outsideOnly's hash exists only in file bytes OUTSIDE the
-- tree, reachable through a link; inTarget's exists only in
-- a link's target string.
BS.writeFile
(outside </> "secret.txt")
(TE.encodeUtf8 ("/nix/store/" <> outsideHash <> "-dep2"))
Dir.createFileLink (outside </> "secret.txt") (scanDir </> "spy-link")
Dir.createFileLink
("/nix/store/" <> T.unpack inTargetHash <> "-dep1/bin/tool")
(scanDir </> "dep-link")
Dir.createDirectoryLink scanDir (scanDir </> "loop")
found <- timeout walkWatchdogMicros (scanReferences [inTarget, outsideOnly] scanDir)
Dir.removePathForcibly base
pure $ case found of
Nothing -> Fail "scan did not terminate on a link cycle"
Just refs -> assertEqual "scanned refs" [inTarget] refs,
-- copyPathInto replicates every link kind, so the NAR bytes -
-- and the hash a cache signs - are identical whether an output
-- was renamed or copied across volumes.
runTestM "copyPathInto replicates links and preserves NAR bytes" $ do
tmpBase <- getTemporaryDirectory
let base = tmpBase </> "nova-nix-test-copy-links"
src = base </> "src"
dest = base </> "dest"
Dir.removePathForcibly base
createDirectoryIfMissing True (src </> "subdir")
BS.writeFile (src </> "file.txt") "payload"
BS.writeFile (src </> "subdir" </> "inner.txt") "inner"
Dir.createFileLink "file.txt" (src </> "rel-link")
Dir.createDirectoryLink "subdir" (src </> "dir-link")
Dir.createFileLink "missing.txt" (src </> "dangling")
copyPathInto src dest
relIsLink <- Dir.pathIsSymbolicLink (dest </> "rel-link")
relTarget <- Dir.getSymbolicLinkTarget (dest </> "rel-link")
dirIsLink <- Dir.pathIsSymbolicLink (dest </> "dir-link")
danglingIsLink <- Dir.pathIsSymbolicLink (dest </> "dangling")
srcNarHash <- CHash.formatNixHash . CHash.hashBytes . NAR.serialise <$> NAR.serialiseFromPath src
destNarHash <- CHash.formatNixHash . CHash.hashBytes . NAR.serialise <$> NAR.serialiseFromPath dest
Dir.removePathForcibly base
pure $
if relIsLink && dirIsLink && danglingIsLink && relTarget == "file.txt"
then assertEqual "copied NAR hash" srcNarHash destNarHash
else
Fail
( "rel-link/dir-link/dangling as links: "
<> T.pack (show (relIsLink, dirIsLink, danglingIsLink))
<> ", rel target: "
<> T.pack (show relTarget)
)
]
-- | Pure ordering for the store's symlink second pass: each link
-- follows the pending links its target resolves at or through, and
-- cycle members fall out at the end in input order.
testLinkOrdering :: IO [Bool]
testLinkOrdering = do
putStrLn "store/link-ordering"
let root = "out"
-- The fixtures are ASCII: one path unit per character, both ways,
-- on every platform.
osPath = OP.pack . map OP.unsafeFromChar
fromOsPath = map OP.toChar . OP.unpack
orderedLinks pending = map (fromOsPath . fst) (orderLinks [(osPath link, osPath target) | (link, target) <- pending])
sequence
[ runTest "chain orders targets first" $
let pending = [(root </> "l1", "l2"), (root </> "l2", "l3"), (root </> "l3", "real")]
in assertEqual
"chain"
[root </> "l3", root </> "l2", root </> "l1"]
(orderedLinks pending),
runTest "already-ordered chain is stable" $
let pending = [(root </> "l3", "real"), (root </> "l2", "l3"), (root </> "l1", "l2")]
in assertEqual
"stable"
[root </> "l3", root </> "l2", root </> "l1"]
(orderedLinks pending),
runTest "link through a linked directory follows it" $
let pending = [(root </> "a", "dirlink/x"), (root </> "dirlink", "realdir")]
in assertEqual
"through-dir"
[root </> "dirlink", root </> "a"]
(orderedLinks pending),
runTest "parent-relative target orders after its link" $
let pending = [(root </> "sub" </> "l", "../other"), (root </> "other", "real")]
in assertEqual
"dotdot"
[root </> "other", root </> "sub" </> "l"]
(orderedLinks pending),
runTest "cycle members keep input order at the end" $
let pending = [(root </> "a", "b"), (root </> "b", "a"), (root </> "c", "real")]
in assertEqual
"cycle"
[root </> "c", root </> "a", root </> "b"]
(orderedLinks pending),
runTest "self-target link survives to the fallback" $
assertEqual
"self"
[root </> "x"]
(orderedLinks [(root </> "x", "x")]),
runTestM "long chain orders in linear time" $ do
-- 20000 links each targeting the next: the ready-set rounds
-- this replaced were quadratic here.
let chain =
[ (root </> ("l" <> show i), "l" <> show (i + 1))
| i <- [1 :: Int .. 20000]
]
++ [(root </> "l20001", "real")]
complete = length (orderedLinks chain) == length chain
outcome <- timeout walkWatchdogMicros (evaluate complete)
pure $ case outcome of
Just True -> Pass
Just False -> Fail "ordering dropped links"
Nothing -> Fail "ordering did not return promptly"
]
-- ---------------------------------------------------------------------------
-- Tests: fromATerm + Derivation Output Population (Phase 2, Batch 3)
-- ---------------------------------------------------------------------------
-- | A simple test derivation for round-trip testing.
simpleTestDrv :: Derivation
simpleTestDrv =
Derivation
{ drvOutputs =
[ DerivationOutput
{ doName = "out",
doPath = StorePath "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "hello-1.0",
doHashAlgo = "",
doHash = ""
}
],
drvInputDrvs = Map.empty,
drvInputSrcs = [],
drvPlatform = X86_64_Linux,
drvBuilder = "/nix/store/bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb-bash-5.2/bin/bash",
drvArgs = ["-e", "/nix/store/cccccccccccccccccccccccccccccccc-stdenv/setup"],
drvEnv = Map.fromList [("name", "hello-1.0"), ("system", "x86_64-linux")]
}
-- | A complex test derivation with multiple outputs, input drvs, and input srcs.
complexTestDrv :: Derivation
complexTestDrv =
Derivation
{ drvOutputs =
[ DerivationOutput "dev" (StorePath "dddddddddddddddddddddddddddddddd" "pkg-2.0-dev") "" "",
DerivationOutput "out" (StorePath "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "pkg-2.0") "" ""
],
drvInputDrvs =
Map.fromList
-- Hash fixtures stay inside the nix-base32 alphabet (no e o u t):
-- fromATerm parses these through parseStorePath, which now
-- charset-checks the hash component.
[ (StorePath "cccccccccccccccccccccccccccccccc" "dep1.drv", ["out"]),
(StorePath "ffffffffffffffffffffffffffffffff" "dep2.drv", ["lib", "out"])
],
drvInputSrcs = [StorePath "gggggggggggggggggggggggggggggggg" "source.tar.gz"],
drvPlatform = Aarch64_Darwin,
drvBuilder = "/nix/store/hhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh-bash/bin/bash",
drvArgs = ["-e", "build.sh"],
drvEnv =
Map.fromList
[ ("buildInputs", "/nix/store/cccccccccccccccccccccccccccccccc-dep1"),
("name", "pkg-2.0"),
("out", "/nix/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-pkg-2.0"),
("system", "aarch64-darwin")
]
}
testFromATerm :: IO [Bool]
testFromATerm = do
putStrLn "derivation/fromATerm"
sequence
[ -- Round-trip: simple derivation
runTest "fromATerm round-trip simple" $
assertEqual "simple round-trip" (Right simpleTestDrv) (fromATerm (toATerm simpleTestDrv)),
-- Round-trip: complex derivation
runTest "fromATerm round-trip complex" $
assertEqual "complex round-trip" (Right complexTestDrv) (fromATerm (toATerm complexTestDrv)),
-- A .drv read from disk is input: an output name that violates the
-- store-name rules (here a traversal shape that would later join
-- the build dir) must refuse at parse.
runTest "fromATerm rejects a traversal-shaped output name" $
let evil =
simpleTestDrv
{ drvOutputs =
[DerivationOutput "../evil" (StorePath (T.replicate 32 "a") "pkg") "" ""]
}
in case fromATerm (toATerm evil) of
Left _ -> Pass
Right _ -> Fail "parsed a drv with a traversal output name",
-- drv4: the modulo-substitution section merges input-drv entries that
-- share a modulo-hash key, unioning their output-name sets, so it is
-- byte-identical to the already-merged form. (Just subs replaces the
-- whole input-drv section, so simpleTestDrv's own inputs are irrelevant.)
runTest "inputDrvsSubst merges equal modulo keys" $
assertEqual
"subst-merge"
(toATermForHash False (Just [("00000000", ["dev", "out"])]) simpleTestDrv)
(toATermForHash False (Just [("00000000", ["out"]), ("00000000", ["dev"])]) simpleTestDrv),
runTest "inputDrvsSubst unions and dedups merged out-names" $
assertEqual
"subst-union"
(toATermForHash False (Just [("aabbccdd", ["dev", "out"])]) simpleTestDrv)
(toATermForHash False (Just [("aabbccdd", ["out"]), ("aabbccdd", ["out", "dev"])]) simpleTestDrv),
-- Distinct keys are untouched: still one entry each, ascending by key.
runTest "inputDrvsSubst preserves distinct keys in order" $
assertEqual
"subst-distinct"
(toATermForHash False (Just [("00000000", ["out"]), ("11111111", ["out"])]) simpleTestDrv)
(toATermForHash False (Just [("11111111", ["out"]), ("00000000", ["out"])]) simpleTestDrv),
-- Round-trip: empty derivation (no outputs, no inputs, no args, no env)
runTest "fromATerm round-trip empty" $
let emptyDrv =
Derivation
{ drvOutputs = [],
drvInputDrvs = Map.empty,
drvInputSrcs = [],
drvPlatform = X86_64_Linux,
drvBuilder = "/bin/true",
drvArgs = [],
drvEnv = Map.empty
}
in assertEqual "empty round-trip" (Right emptyDrv) (fromATerm (toATerm emptyDrv)),
-- Reject empty string
runTest "fromATerm rejects empty" $
assertLeft "empty" (fromATerm ""),
-- Reject malformed
runTest "fromATerm rejects malformed" $
assertLeft "malformed" (fromATerm "NotADerivation"),
-- Reject truncated
runTest "fromATerm rejects truncated" $
assertLeft "truncated" (fromATerm "Derive(["),
-- Escaping round-trip: strings with special chars
runTest "fromATerm escaping round-trip" $
let escapeDrv =
Derivation
{ drvOutputs =
[ DerivationOutput
{ doName = "out",
doPath = StorePath "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "esc-test",
doHashAlgo = "",
doHash = ""
}
],
drvInputDrvs = Map.empty,
drvInputSrcs = [],
drvPlatform = X86_64_Linux,
drvBuilder = "/bin/bash",
drvArgs = ["-c", "echo \"hello\nworld\""],
drvEnv = Map.fromList [("msg", "line1\nline2\ttab\\slash")]
}
in assertEqual "escape round-trip" (Right escapeDrv) (fromATerm (toATerm escapeDrv)),
-- A non-standard escape keeps the byte and drops the backslash,
-- matching upstream's .drv string parser.
runTest "fromATerm drops the backslash on a non-standard escape" $
let aterm = "Derive([(\"out\",\"/nix/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-x\",\"\",\"\")],[],[],\"x86_64-linux\",\"/bin/sh\",[],[(\"k\",\"a\\xb\")])"
in assertRight "nonstandard escape" (fromATerm aterm) $ \drv ->
assertEqual "escape dropped" (Just "axb") (Map.lookup "k" (drvEnv drv)),
-- writeDrv writes correct ATerm
runTestM "writeDrv writes correct ATerm" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-writeDrv"
removeIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let sp = StorePath "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" "test.drv"
destFile = storePathToFilePath (stDir store) sp
writeDrv store simpleTestDrv sp
contents <- BS.readFile destFile
closeStore store
removeIfExists tmpStore
pure (assertEqual "writeDrv content" (toATerm simpleTestDrv) contents),
-- The .drv closure registers as store objects: a row for every
-- recipe plus edges to its input sources and input .drvs, so an
-- output reference scan that names an input .drv resolves instead
-- of failing the registration batch.
runTestM "writeDrvClosure registers recipes with their references" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-drv-closure"
sd = StoreDir tmpStore
removeIfExists tmpStore
store <- openStore sd
let srcSp = StorePath "gggggggggggggggggggggggggggggggg" "source.tar.gz"
drvASp = StorePath "cccccccccccccccccccccccccccccccc" "dep1.drv"
drvBSp = StorePath "dddddddddddddddddddddddddddddddd" "top.drv"
drvB =
simpleTestDrv
{ drvInputDrvs = Map.fromList [(drvASp, ["out"])],
drvInputSrcs = [srcSp]
}
-- The source row registers first, as in the build driver, where
-- materializeEvalSources precedes the closure write.
registerPath (stDB store) (PathRegistration srcSp "sha256:0" 0 Nothing [])
writeDrvClosure
store
( Map.fromList
[ (storePathToText defaultStoreDir drvASp, toATerm simpleTestDrv),
(storePathToText defaultStoreDir drvBSp, toATerm drvB)
]
)
validA <- isValid store drvASp
validB <- isValid store drvBSp
refsB <- queryReferences (stDB store) drvBSp
closeStore store
removeIfExists tmpStore
let expectedRefs =
sort
[ T.pack (storePathToFilePath sd drvASp),
T.pack (storePathToFilePath sd srcSp)
]
pure $
if not validA
then Fail "input .drv not registered"
else
if not validB
then Fail "root .drv not registered"
else assertEqual "drv references" expectedRefs (sort refsB),
-- The recorded derivation populates drvOutputs. These three read the
-- Derivation the session records, which only the IO evaluator keeps.
runTestM "derivationStrict populates drvOutputs" $ do
tmpBase <- getTemporaryDirectory
result <- evalDerivationIO tmpBase "derivation { name = \"test\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }"
pure $ assertRight "drvOutputs" result $ \drv ->
case drvOutputs drv of
[] -> Fail "drvOutputs is empty"
(firstOut : _) ->
if doName firstOut == "out"
then Pass
else Fail ("first output name: " <> doName firstOut),
-- The .drv lists outputs sorted by name, as upstream writes them; the
-- declared order lives in the value's outputs and all.
runTestM "derivationStrict multi-output" $ do
tmpBase <- getTemporaryDirectory
result <- evalDerivationIO tmpBase "derivation { name = \"multi\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; outputs = [\"out\" \"dev\"]; }"
pure $ assertRight "multi-output" result $ \drv ->
let names = map doName (drvOutputs drv)
in if names == ["dev", "out"]
then Pass
else Fail ("output names: " <> T.pack (show names)),
-- The .drv env carries the output paths ($out, ...) and the build
-- attributes, and no "drvPath" key - matching C++ Nix, which never
-- writes one.
runTestM "derivationStrict populates drvEnv" $ do
tmpBase <- getTemporaryDirectory
result <- evalDerivationIO tmpBase "derivation { name = \"test\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }"
pure $ assertRight "drvEnv" result $ \drv ->
case (Map.lookup "out" (drvEnv drv), Map.lookup "name" (drvEnv drv)) of
(Just op, Just "test")
| "/nix/store/" `BS.isPrefixOf` op -> Pass
_ -> Fail ("drvEnv keys: " <> T.pack (show (Map.toList (drvEnv drv))))
]
-- ---------------------------------------------------------------------------
-- Tests: Builder (Phase 2, Batch 4)
-- ---------------------------------------------------------------------------
-- | Create a minimal Derivation for builder tests.
-- The shell path is discovered once via 'findTestShell' and threaded through.
-- All scripts are POSIX shell - bash is used on every platform.
mkTestBuildDrv :: Text -> StorePath -> Text -> Derivation
mkTestBuildDrv shell outSP script =
Derivation
{ drvOutputs =
[ DerivationOutput
{ doName = "out",
doPath = outSP,
doHashAlgo = "",
doHash = ""
}
],
drvInputDrvs = Map.empty,
drvInputSrcs = [],
drvPlatform = currentPlatform,
drvBuilder = TE.encodeUtf8 shell,
drvArgs = ["-c", TE.encodeUtf8 script],
drvEnv = Map.fromList [("name", "test-build"), ("system", TE.encodeUtf8 (platformToText currentPlatform))]
}
-- | 'mkTestBuildDrv' with a fixed-output spec: registration must
-- re-verify the placed bytes against the declared digest.
mkFixedOutputDrv :: Text -> StorePath -> Text -> Text -> Text -> Derivation
mkFixedOutputDrv shell outSP script algoField hexDigest =
(mkTestBuildDrv shell outSP script)
{ drvOutputs =
[ DerivationOutput
{ doName = "out",
doPath = outSP,
doHashAlgo = algoField,
doHash = hexDigest
}
]
}
testBuilder :: IO [Bool]
testBuilder = do
putStrLn "builder"
shell <- findTestShell
sequence
[ -- Build simple script that writes to $out
runTestM "build simple script" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-builder1"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let outSP = StorePath "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa1" "simple-test"
drv = mkTestBuildDrv shell outSP "mkdir -p $out && echo hello > $out/result.txt"
config = (defaultBuildConfig (stDir store)) {bcTmpDir = tmpBase </> "nova-nix-test-builder1-tmp"}
result <- buildDerivation config store drv
closeStore store
let ret = case result of
BuildSuccess sp -> assertEqual "success path" outSP sp
BuildFailure msg code -> Fail ("build failed (" <> T.pack (show code) <> "): " <> msg)
forceRemoveIfExists tmpStore
forceRemoveIfExists (bcTmpDir config)
pure ret,
-- Build with specific file content
runTestM "build writes file content" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-builder2"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let outSP = StorePath "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" "content-test"
drv = mkTestBuildDrv shell outSP "mkdir -p $out && echo 'test content 42' > $out/data.txt"
config = (defaultBuildConfig (stDir store)) {bcTmpDir = tmpBase </> "nova-nix-test-builder2-tmp"}
result <- buildDerivation config store drv
ret <- case result of
BuildSuccess _ -> do
let dataFile = storePathToFilePath (stDir store) outSP </> "data.txt"
content <- TIO.readFile dataFile
pure $
if T.strip content == "test content 42"
then Pass
else Fail ("unexpected content: " <> content)
BuildFailure msg code -> pure (Fail ("build failed (" <> T.pack (show code) <> "): " <> msg))
closeStore store
forceRemoveIfExists tmpStore
forceRemoveIfExists (bcTmpDir config)
pure ret,
-- Missing builder fails
runTestM "missing builder fails" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-builder3"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let outSP = StorePath "cccccccccccccccccccccccccccccccc" "fail-test"
drv =
Derivation
{ drvOutputs = [DerivationOutput "out" outSP "" ""],
drvInputDrvs = Map.empty,
drvInputSrcs = [],
drvPlatform = currentPlatform,
drvBuilder = "/nonexistent/builder",
drvArgs = [],
drvEnv = Map.empty
}
config = (defaultBuildConfig (stDir store)) {bcTmpDir = tmpBase </> "nova-nix-test-builder3-tmp"}
result <- buildDerivation config store drv
closeStore store
forceRemoveIfExists tmpStore
forceRemoveIfExists (bcTmpDir config)
pure $ case result of
BuildFailure _ _ -> Pass
BuildSuccess _ -> Fail "expected failure for missing builder",
-- Exit failure returns error code
runTestM "exit failure returns error code" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-builder4"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let outSP = StorePath "dddddddddddddddddddddddddddddddd" "exitfail"
drv = mkTestBuildDrv shell outSP "exit 42"
config = (defaultBuildConfig (stDir store)) {bcTmpDir = tmpBase </> "nova-nix-test-builder4-tmp"}
result <- buildDerivation config store drv
closeStore store
forceRemoveIfExists tmpStore
forceRemoveIfExists (bcTmpDir config)
pure $ case result of
BuildFailure _ code -> if code == 42 then Pass else Fail ("expected code 42, got " <> T.pack (show code))
BuildSuccess _ -> Fail "expected failure",
-- A builder that THROWS (nonexistent executable) must not leak the
-- deterministic build dir: stale contents would fake an archive
-- collision on the next builtin:unpack run of the same drv.
runTestM "crashed build removes its build dir" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-builder-leak"
tmpBuild = tmpBase </> "nova-nix-test-builder-leak-tmp"
forceRemoveIfExists tmpStore
forceRemoveIfExists tmpBuild
store <- openStore (StoreDir tmpStore)
let outSP = StorePath "pppppppppppppppppppppppppppppppp" "leaktest"
drv = mkTestBuildDrv (T.pack (tmpBase </> "no-such-builder.exe")) outSP "unused"
config = (defaultBuildConfig (stDir store)) {bcTmpDir = tmpBuild}
result <- buildDerivation config store drv
leftovers <- do
exists <- doesDirectoryExist tmpBuild
if exists then Dir.listDirectory tmpBuild else pure []
closeStore store
forceRemoveIfExists tmpStore
forceRemoveIfExists tmpBuild
pure $ case result of
BuildFailure _ _
| null leftovers -> Pass
| otherwise -> Fail ("build dir leaked: " <> T.pack (show leftovers))
BuildSuccess _ -> Fail "expected failure for a nonexistent builder",
-- A derivation carrying __json is built as upstream builds one: its
-- attributes, outputs included, arrive as .attrs.json and .attrs.sh
-- and none of them as a variable. The builder copies both files
-- out, finding $out where a structured builder must, in the files.
runTestM "structured attributes reach the builder as .attrs.json and .attrs.sh" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-builder-structured"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let outSP = StorePath "ssssssssssssssssssssssssssssssss" "structured"
outText = T.pack (storePathToFilePath (stDir store) outSP)
attrs =
"{\"greeting\":\"it's\",\"list\":[\"a\",1,true,null],\"nested\":{\"k\":\"v\"},\"outputs\":[\"out\"],\"self\":\""
<> hashPlaceholder "out"
<> "/bin\"}"
script =
T.unlines
[ "probe=\"${out-unset}|${__json-unset}|${greeting-unset}\"",
"out=$(sed -n \"/^declare -A outputs=/s/.*\\['out'\\]='\\([^']*\\)'.*/\\1/p\" \"$NIX_ATTRS_SH_FILE\")",
"mkdir \"$out\" && cp \"$NIX_ATTRS_JSON_FILE\" \"$out/attrs.json\" && cp \"$NIX_ATTRS_SH_FILE\" \"$out/attrs.sh\" && printf '%s' \"$probe\" > \"$out/env\""
]
drv =
(mkTestBuildDrv shell outSP script)
{ drvEnv = Map.fromList [("__json", TE.encodeUtf8 attrs), ("out", "/nix/store/ssssssssssssssssssssssssssssssss-structured")]
}
config = (defaultBuildConfig (stDir store)) {bcTmpDir = tmpBase </> "nova-nix-test-builder-structured-tmp"}
jsonPath = "\"" <> T.replace "\\" "\\\\" outText <> "\""
expectedJson =
"{\"greeting\":\"it's\",\"list\":[\"a\",1,true,null],\"nested\":{\"k\":\"v\"},\"outputs\":{\"out\":"
<> jsonPath
<> "},\"self\":"
<> T.dropEnd 1 jsonPath
<> "/bin\"}"
expectedShell =
T.concat
[ "declare greeting='it'\\''s'\n",
"declare -a list=('a' 1 1 '' )\n",
"declare -A nested=(['k']='v' )\n",
"declare -A outputs=(['out']='" <> outText <> "' )\n",
"declare self='" <> outText <> "/bin'\n"
]
result <- buildDerivation config store drv
ret <- case result of
BuildSuccess _ -> do
let outDir = storePathToFilePath (stDir store) outSP
json <- BS.readFile (outDir </> "attrs.json")
shellText <- BS.readFile (outDir </> "attrs.sh")
probe <- BS.readFile (outDir </> "env")
pure $
assertEqual "attrs.json" (TE.encodeUtf8 expectedJson) json
`andThen` assertEqual "attrs.sh" (TE.encodeUtf8 expectedShell) shellText
`andThen` assertEqual "no attribute is a variable" "unset|unset|unset" probe
BuildFailure msg code -> pure (Fail ("build failed (" <> T.pack (show code) <> "): " <> msg))
closeStore store
forceRemoveIfExists tmpStore
forceRemoveIfExists (bcTmpDir config)
pure ret,
-- Output at expected path
runTestM "output at expected store path" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-builder5"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let outSP = StorePath "cccccccccccccccccccccccccccccccc" "pathtest"
drv = mkTestBuildDrv shell outSP "mkdir -p $out && touch $out/marker"
config = (defaultBuildConfig (stDir store)) {bcTmpDir = tmpBase </> "nova-nix-test-builder5-tmp"}
result <- buildDerivation config store drv
ret <- case result of
BuildSuccess _ -> do
let expectedDir = storePathToFilePath (stDir store) outSP
exists <- doesDirectoryExist expectedDir
pure $ if exists then Pass else Fail "output dir doesn't exist at expected path"
BuildFailure msg code -> pure (Fail ("build failed (" <> T.pack (show code) <> "): " <> msg))
closeStore store
forceRemoveIfExists tmpStore
forceRemoveIfExists (bcTmpDir config)
pure ret,
-- A leftover tree at the output path that is NOT valid in the DB has
-- unknowable integrity (interrupted earlier run); the build replaces
-- it with the fresh output - upstream's delete-then-move - clearing
-- read-only marks rather than adopting stale bytes.
runTestM "stale leftover output is replaced by the fresh build" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-builder-stale"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let outSP = StorePath "qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqq" "staletest"
drv = mkTestBuildDrv shell outSP "mkdir -p $out && echo fresh > $out/data.txt"
config = (defaultBuildConfig (stDir store)) {bcTmpDir = tmpBase </> "nova-nix-test-builder-stale-tmp"}
targetPath = storePathToFilePath (stDir store) outSP
-- Fake the interrupted run: stale read-only content at the output's
-- store location, never registered.
createDirectoryIfMissing True targetPath
TIO.writeFile (targetPath </> "data.txt") "stale"
setReadOnly targetPath
result <- buildDerivation config store drv
content <- TIO.readFile (targetPath </> "data.txt")
registered <- isValid store outSP
closeStore store
forceRemoveIfExists tmpStore
forceRemoveIfExists (bcTmpDir config)
pure $ case result of
BuildSuccess _
| T.strip content == "fresh" && registered -> Pass
| otherwise -> Fail ("expected fresh registered content, got: " <> content)
BuildFailure msg code -> Fail ("build failed (" <> T.pack (show code) <> "): " <> msg),
-- Path registered in DB after build
runTestM "path registered in DB" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-builder6"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let outSP = StorePath "ffffffffffffffffffffffffffffffff" "dbtest"
drv = mkTestBuildDrv shell outSP "mkdir -p $out && touch $out/file"
config = (defaultBuildConfig (stDir store)) {bcTmpDir = tmpBase </> "nova-nix-test-builder6-tmp"}
result <- buildDerivation config store drv
ret <- case result of
BuildSuccess _ -> do
valid <- isValid store outSP
pure $ if valid then Pass else Fail "path not valid in DB after build"
BuildFailure msg code -> pure (Fail ("build failed (" <> T.pack (show code) <> "): " <> msg))
closeStore store
forceRemoveIfExists tmpStore
forceRemoveIfExists (bcTmpDir config)
pure ret,
-- Multiple outputs
runTestM "multiple outputs" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-builder7"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let outSP = StorePath "ggggggggggggggggggggggggggggggg1" "multi"
devSP = StorePath "ggggggggggggggggggggggggggggggg2" "multi-dev"
drv =
Derivation
{ drvOutputs =
[ DerivationOutput "out" outSP "" "",
DerivationOutput "dev" devSP "" ""
],
drvInputDrvs = Map.empty,
drvInputSrcs = [],
drvPlatform = currentPlatform,
drvBuilder = TE.encodeUtf8 shell,
drvArgs = ["-c", "mkdir -p $out && echo lib > $out/lib.txt && mkdir -p $dev && echo headers > $dev/include.h"],
drvEnv = Map.fromList [("name", "multi")]
}
config = (defaultBuildConfig (stDir store)) {bcTmpDir = tmpBase </> "nova-nix-test-builder7-tmp"}
result <- buildDerivation config store drv
ret <- case result of
BuildSuccess _ -> do
outExists <- doesDirectoryExist (storePathToFilePath (stDir store) outSP)
devExists <- doesDirectoryExist (storePathToFilePath (stDir store) devSP)
pure $
if outExists && devExists
then Pass
else Fail ("out exists=" <> T.pack (show outExists) <> " dev exists=" <> T.pack (show devExists))
BuildFailure msg code -> pure (Fail ("build failed (" <> T.pack (show code) <> "): " <> msg))
closeStore store
forceRemoveIfExists tmpStore
forceRemoveIfExists (bcTmpDir config)
pure ret,
runTestM "partial rebuild failure preserves a valid sibling output" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-builder-partial-valid"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let outSP = StorePath "ggggggggggggggggggggggggggggggg3" "partial-main"
devSP = StorePath "ggggggggggggggggggggggggggggggg4" "partial-dev"
mkDrv script =
Derivation
{ drvOutputs =
[ DerivationOutput "out" outSP "" "",
DerivationOutput "dev" devSP "" ""
],
drvInputDrvs = Map.empty,
drvInputSrcs = [],
drvPlatform = currentPlatform,
drvBuilder = TE.encodeUtf8 shell,
drvArgs = ["-c", script],
drvEnv = Map.fromList [("name", "partial-valid")]
}
config = (defaultBuildConfig (stDir store)) {bcTmpDir = tmpBase </> "nova-nix-test-builder-partial-valid-tmp"}
devPath = storePathToFilePath (stDir store) devSP
initial <- buildDerivation config store (mkDrv "mkdir -p $out $dev && echo main > $out/value && echo keep > $dev/value")
deleted <- deleteStorePathRaw store (spHash outSP <> "-" <> spName outSP)
rebuilt <- buildDerivation config store (mkDrv "mkdir -p $out && echo partial > $out/value && exit 1")
devOnDisk <- Dir.doesPathExist devPath
devValid <- isValid store devSP
devContents <- if devOnDisk then T.strip <$> TIO.readFile (devPath </> "value") else pure ""
closeStore store
forceRemoveIfExists tmpStore
forceRemoveIfExists (bcTmpDir config)
let deletedFirst = either (const False) (\outcome -> doRowRemoved outcome && doTreeRemoved outcome) deleted
pure $ case (initial, rebuilt) of
(BuildSuccess _, BuildFailure _ _)
| deletedFirst && devOnDisk && devValid && devContents == "keep" -> Pass
| otherwise -> Fail "failed partial rebuild removed or changed its valid sibling output"
_ -> Fail "partial rebuild test setup did not reach the expected states",
-- The shape the reviewer's blocker had: a package with a dev output
-- has ONE builder writing both, so a partial rebuild hands that
-- builder a $dev that is valid, registered and sealed read-only.
-- Writing there has to work and must not disturb what is registered.
runTestM "partial rebuild writes both outputs and leaves the valid one alone" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-builder-partial-both"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let outSP = StorePath "ggggggggggggggggggggggggggggggg5" "both-main"
devSP = StorePath "ggggggggggggggggggggggggggggggg6" "both-dev"
mkDrv script =
Derivation
{ drvOutputs =
[ DerivationOutput "out" outSP "" "",
DerivationOutput "dev" devSP "" ""
],
drvInputDrvs = Map.empty,
drvInputSrcs = [],
drvPlatform = currentPlatform,
drvBuilder = TE.encodeUtf8 shell,
drvArgs = ["-c", script],
drvEnv = Map.fromList [("name", "partial-both")]
}
config = (defaultBuildConfig (stDir store)) {bcTmpDir = tmpBase </> "nova-nix-test-builder-partial-both-tmp"}
devPath = storePathToFilePath (stDir store) devSP
outPath = storePathToFilePath (stDir store) outSP
-- Both outputs, every time, as a real multi-output builder does.
writeBoth v = "mkdir -p $out $dev && echo " <> v <> " > $out/value && echo " <> v <> " > $dev/value"
initial <- buildDerivation config store (mkDrv (writeBoth "first"))
deleted <- deleteStorePathRaw store (spHash outSP <> "-" <> spName outSP)
rebuilt <- buildDerivation config store (mkDrv (writeBoth "second"))
outContents <- T.strip <$> TIO.readFile (outPath </> "value")
devContents <- T.strip <$> TIO.readFile (devPath </> "value")
devValid <- isValid store devSP
outValid <- isValid store outSP
closeStore store
forceRemoveIfExists tmpStore
forceRemoveIfExists (bcTmpDir config)
let deletedFirst = either (const False) (\outcome -> doRowRemoved outcome && doTreeRemoved outcome) deleted
pure $ case (initial, rebuilt) of
(BuildSuccess _, BuildSuccess _)
| not deletedFirst -> Fail "partial rebuild setup did not delete the first output"
-- The valid sibling keeps the bytes its NarHash describes: the
-- builder wrote to a scratch path, not to it.
| devContents /= "first" -> Fail ("valid sibling was overwritten: " <> devContents)
| outContents /= "second" -> Fail ("rebuilt output has the wrong contents: " <> outContents)
| not (outValid && devValid) -> Fail "both outputs should be valid after the rebuild"
| otherwise -> Pass
(_, BuildFailure msg _) -> Fail ("a builder writing both outputs failed the rebuild: " <> msg)
_ -> Fail "partial rebuild test setup did not reach the expected states",
-- The scratch path is discarded after the build, so an output that
-- records it would be registered with a reference to nothing. We do
-- not rewrite the contents the way upstream does; we refuse.
runTestM "an output recording a valid sibling's scratch path fails the build" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-builder-scratch-leak"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let outSP = StorePath "ggggggggggggggggggggggggggggggg7" "leak-main"
devSP = StorePath "ggggggggggggggggggggggggggggggg8" "leak-dev"
mkDrv script =
Derivation
{ drvOutputs =
[ DerivationOutput "out" outSP "" "",
DerivationOutput "dev" devSP "" ""
],
drvInputDrvs = Map.empty,
drvInputSrcs = [],
drvPlatform = currentPlatform,
drvBuilder = TE.encodeUtf8 shell,
drvArgs = ["-c", script],
drvEnv = Map.fromList [("name", "scratch-leak")]
}
config = (defaultBuildConfig (stDir store)) {bcTmpDir = tmpBase </> "nova-nix-test-builder-scratch-leak-tmp"}
devPath = storePathToFilePath (stDir store) devSP
initial <- buildDerivation config store (mkDrv "mkdir -p $out $dev && echo first > $out/value && echo first > $dev/value")
deleted <- deleteStorePathRaw store (spHash outSP <> "-" <> spName outSP)
-- \$dev now names a scratch path, and the builder bakes it into $out
-- the way a compiler driver or a libtool archive would.
rebuilt <- buildDerivation config store (mkDrv "mkdir -p $out $dev && echo $dev > $out/recorded && echo first > $dev/value")
devContents <- T.strip <$> TIO.readFile (devPath </> "value")
devValid <- isValid store devSP
outValid <- isValid store outSP
closeStore store
forceRemoveIfExists tmpStore
forceRemoveIfExists (bcTmpDir config)
let deletedFirst = either (const False) (\outcome -> doRowRemoved outcome && doTreeRemoved outcome) deleted
pure $ case (initial, rebuilt) of
(BuildSuccess _, BuildFailure msg _)
| not deletedFirst -> Fail "scratch-leak setup did not delete the first output"
| not ("scratch path" `T.isInfixOf` msg) -> Fail ("expected a scratch-path refusal, got: " <> msg)
-- The refusal must not cost the sibling that was already valid.
| not devValid || devContents /= "first" -> Fail "the refusal disturbed the valid sibling"
| outValid -> Fail "the refused output registered anyway"
| otherwise -> Pass
(_, BuildSuccess _) -> Fail "an output naming a discarded scratch path was accepted"
_ -> Fail "scratch-leak test setup did not reach the expected states",
-- Builder succeeds but doesn't create $out, so the build fails
runTestM "missing output fails build" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-builder-noout"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let outSP = StorePath "iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii" "nooutput"
drv = mkTestBuildDrv shell outSP "echo 'forgot to create output'"
config = (defaultBuildConfig (stDir store)) {bcTmpDir = tmpBase </> "nova-nix-test-builder-noout-tmp"}
result <- buildDerivation config store drv
closeStore store
forceRemoveIfExists tmpStore
forceRemoveIfExists (bcTmpDir config)
pure $ case result of
BuildFailure msg _ ->
if T.isInfixOf "outputs missing" msg
then Pass
else Fail ("expected 'outputs missing' error, got: " <> msg)
BuildSuccess _ -> Fail "expected failure when builder doesn't create $out",
runTestM "missing sibling output cleans produced orphan" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-builder-partial-missing"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let outSP = StorePath "iiiiiiiiiiiiiiiiiiiiiiiiiiiiiii1" "partial-output"
devSP = StorePath "iiiiiiiiiiiiiiiiiiiiiiiiiiiiiii2" "missing-output"
drv =
Derivation
{ drvOutputs =
[ DerivationOutput "out" outSP "" "",
DerivationOutput "dev" devSP "" ""
],
drvInputDrvs = Map.empty,
drvInputSrcs = [],
drvPlatform = currentPlatform,
drvBuilder = TE.encodeUtf8 shell,
drvArgs = ["-c", "mkdir -p $out && echo orphan > $out/value"],
drvEnv = Map.fromList [("name", "partial-missing")]
}
config = (defaultBuildConfig (stDir store)) {bcTmpDir = tmpBase </> "nova-nix-test-builder-partial-missing-tmp"}
outPath = storePathToFilePath (stDir store) outSP
devPath = storePathToFilePath (stDir store) devSP
result <- buildDerivation config store drv
outOnDisk <- Dir.doesPathExist outPath
devOnDisk <- Dir.doesPathExist devPath
outValid <- isValid store outSP
devValid <- isValid store devSP
closeStore store
forceRemoveIfExists tmpStore
forceRemoveIfExists (bcTmpDir config)
pure $ case result of
BuildFailure msg _
| "outputs missing" `T.isInfixOf` msg && not outOnDisk && not devOnDisk && not outValid && not devValid -> Pass
| otherwise -> Fail ("missing-output failure left store state behind: " <> msg)
BuildSuccess _ -> Fail "partial-output builder unexpectedly succeeded",
-- File output (not directory) should succeed
runTestM "file output succeeds" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-builder-fileout"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let outSP = StorePath "jjjjjjjjjjjjjjjjjjjjjjjjjjjjjj" "fileout"
drv = mkTestBuildDrv shell outSP "echo 'I am a file output' > $out"
config = (defaultBuildConfig (stDir store)) {bcTmpDir = tmpBase </> "nova-nix-test-builder-fileout-tmp"}
result <- buildDerivation config store drv
closeStore store
forceRemoveIfExists tmpStore
forceRemoveIfExists (bcTmpDir config)
pure $ case result of
BuildSuccess sp -> assertEqual "file output path" outSP sp
BuildFailure msg code -> Fail ("file output build failed (" <> T.pack (show code) <> "): " <> msg),
-- Cleanup after failure
runTestM "cleanup after failure" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-builder8"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let outSP = StorePath "hhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh" "cleantest"
drv = mkTestBuildDrv shell outSP "exit 1"
tmpDir = tmpBase </> "nova-nix-test-builder8-tmp"
config = (defaultBuildConfig (stDir store)) {bcTmpDir = tmpDir}
_ <- buildDerivation config store drv
-- Build dir should be cleaned up
let buildDir = tmpDir </> T.unpack (spHash outSP)
buildDirExists <- doesDirectoryExist buildDir
closeStore store
forceRemoveIfExists tmpStore
forceRemoveIfExists tmpDir
pure $ if not buildDirExists then Pass else Fail "build dir not cleaned up after failure",
-- Fixed-output: registration re-checks the placed bytes
runTestM "fixed-output flat output verifies and registers" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-fo1"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let payload = "fixed output payload\n"
digest = maybe "" Hash.bytesToHexText (Hash.rawHashWithAlgo "sha256" payload)
outSP = StorePath "ffffffffffffffffffffffffffffff01" "fo-flat-good"
drv = mkFixedOutputDrv shell outSP "printf 'fixed output payload\\n' > $out" "sha256" digest
config = (defaultBuildConfig (stDir store)) {bcTmpDir = tmpBase </> "nova-nix-test-fo1-tmp"}
result <- buildDerivation config store drv
registered <- isValid store outSP
closeStore store
forceRemoveIfExists tmpStore
forceRemoveIfExists (bcTmpDir config)
pure $ case result of
BuildSuccess _
| registered -> Pass
| otherwise -> Fail "built but not registered valid"
BuildFailure msg code -> Fail ("expected success (" <> T.pack (show code) <> "): " <> msg),
-- The impureEnvVars carve-out (#185): a fixed-output derivation's
-- listed ambient variables reach the scrubbed build, an absent
-- listed name arrives as the EMPTY STRING (present, not omitted,
-- upstream's value_or("")), and everything else stays scrubbed.
runTestM "impureEnvVars reach a fixed-output build, absent names as empty" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-impure1"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
setEnv "NOVA_TEST_IMPURE" "proxy-ok"
unsetEnv "NOVA_TEST_ABSENT"
let payload = "fixed output payload\n"
digest = maybe "" Hash.bytesToHexText (Hash.rawHashWithAlgo "sha256" payload)
outSP = StorePath "ffffffffffffffffffffffffffffff03" "fo-impure-env"
script = "[ \"$NOVA_TEST_IMPURE\" = \"proxy-ok\" ] && [ \"${NOVA_TEST_ABSENT+set}\" = \"set\" ] && [ -z \"$NOVA_TEST_ABSENT\" ] && printf 'fixed output payload\\n' > $out"
baseDrv = mkFixedOutputDrv shell outSP script "sha256" digest
drv = baseDrv {drvEnv = Map.insert "impureEnvVars" "NOVA_TEST_IMPURE NOVA_TEST_ABSENT" (drvEnv baseDrv)}
config = (defaultBuildConfig (stDir store)) {bcTmpDir = tmpBase </> "nova-nix-test-impure1-tmp"}
result <- buildDerivation config store drv
unsetEnv "NOVA_TEST_IMPURE"
closeStore store
forceRemoveIfExists tmpStore
forceRemoveIfExists (bcTmpDir config)
pure $ case result of
BuildSuccess _ -> Pass
BuildFailure msg code -> Fail ("carve-out did not reach the build (" <> T.pack (show code) <> "): " <> msg),
runTestM "impureEnvVars are ignored for a non-fixed-output build" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-impure2"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
setEnv "NOVA_TEST_IMPURE" "must-not-leak"
let outSP = StorePath "ffffffffffffffffffffffffffffff04" "impure-scrubbed"
script = "[ -z \"${NOVA_TEST_IMPURE-}\" ] && echo ok > $out"
baseDrv = mkTestBuildDrv shell outSP script
drv = baseDrv {drvEnv = Map.insert "impureEnvVars" "NOVA_TEST_IMPURE" (drvEnv baseDrv)}
config = (defaultBuildConfig (stDir store)) {bcTmpDir = tmpBase </> "nova-nix-test-impure2-tmp"}
result <- buildDerivation config store drv
unsetEnv "NOVA_TEST_IMPURE"
closeStore store
forceRemoveIfExists tmpStore
forceRemoveIfExists (bcTmpDir config)
pure $ case result of
BuildSuccess _ -> Pass
BuildFailure msg code -> Fail ("ambient leaked into a non-fixed-output build (" <> T.pack (show code) <> "): " <> msg),
runTestM "fixed-output flat mismatch fails and removes the output" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-fo2"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let digest = maybe "" Hash.bytesToHexText (Hash.rawHashWithAlgo "sha256" "expected content\n")
outSP = StorePath "ffffffffffffffffffffffffffffff02" "fo-flat-bad"
drv = mkFixedOutputDrv shell outSP "printf 'tampered content\\n' > $out" "sha256" digest
config = (defaultBuildConfig (stDir store)) {bcTmpDir = tmpBase </> "nova-nix-test-fo2-tmp"}
result <- buildDerivation config store drv
registered <- isValid store outSP
onDisk <- Dir.doesPathExist (storePathToFilePath (stDir store) outSP)
closeStore store
forceRemoveIfExists tmpStore
forceRemoveIfExists (bcTmpDir config)
pure $ case result of
BuildFailure msg _
| "hash mismatch" `T.isInfixOf` msg && not registered && not onDisk -> Pass
| otherwise ->
Fail
( "wrong failure shape (valid="
<> T.pack (show registered)
<> ", onDisk="
<> T.pack (show onDisk)
<> "): "
<> msg
)
BuildSuccess _ -> Fail "mismatched fixed output registered",
runTestM "fixed-output recursive tree verifies against its NAR hash" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-fo3"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let tree = NAR.NarDirectory [("data.txt", NAR.NarRegular False "inner bytes\n")]
digest = maybe "" Hash.bytesToHexText (Hash.rawHashWithAlgo "sha256" (NAR.serialise tree))
outSP = StorePath "ffffffffffffffffffffffffffffff03" "fo-rec-good"
drv = mkFixedOutputDrv shell outSP "mkdir -p $out && printf 'inner bytes\\n' > $out/data.txt" "r:sha256" digest
config = (defaultBuildConfig (stDir store)) {bcTmpDir = tmpBase </> "nova-nix-test-fo3-tmp"}
result <- buildDerivation config store drv
registered <- isValid store outSP
closeStore store
forceRemoveIfExists tmpStore
forceRemoveIfExists (bcTmpDir config)
pure $ case result of
BuildSuccess _
| registered -> Pass
| otherwise -> Fail "built but not registered valid"
BuildFailure msg code -> Fail ("expected success (" <> T.pack (show code) <> "): " <> msg),
runTestM "fixed-output recursive mismatch fails the build" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-fo4"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let tree = NAR.NarDirectory [("data.txt", NAR.NarRegular False "declared bytes\n")]
digest = maybe "" Hash.bytesToHexText (Hash.rawHashWithAlgo "sha256" (NAR.serialise tree))
outSP = StorePath "ffffffffffffffffffffffffffffff04" "fo-rec-bad"
drv = mkFixedOutputDrv shell outSP "mkdir -p $out && printf 'other bytes\\n' > $out/data.txt" "r:sha256" digest
config = (defaultBuildConfig (stDir store)) {bcTmpDir = tmpBase </> "nova-nix-test-fo4-tmp"}
result <- buildDerivation config store drv
registered <- isValid store outSP
closeStore store
forceRemoveIfExists tmpStore
forceRemoveIfExists (bcTmpDir config)
pure $ case result of
BuildFailure msg _
| "hash mismatch" `T.isInfixOf` msg && not registered -> Pass
| otherwise -> Fail ("wrong failure shape: " <> msg)
BuildSuccess _ -> Fail "mismatched fixed output registered",
runTestM "fixed-output flat mode rejects a directory output" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-fo5"
forceRemoveIfExists tmpStore
store <- openStore (StoreDir tmpStore)
let digest = maybe "" Hash.bytesToHexText (Hash.rawHashWithAlgo "sha256" "whatever\n")
outSP = StorePath "ffffffffffffffffffffffffffffff05" "fo-flat-dir"
drv = mkFixedOutputDrv shell outSP "mkdir -p $out && printf 'x' > $out/f" "sha256" digest
config = (defaultBuildConfig (stDir store)) {bcTmpDir = tmpBase </> "nova-nix-test-fo5-tmp"}
result <- buildDerivation config store drv
closeStore store
forceRemoveIfExists tmpStore
forceRemoveIfExists (bcTmpDir config)
pure $ case result of
BuildFailure msg _
| "directory" `T.isInfixOf` msg -> Pass
| otherwise -> Fail ("wrong failure: " <> msg)
BuildSuccess _ -> Fail "directory output passed a flat fixed-output check"
]
-- ---------------------------------------------------------------------------
-- Tests: CLI Integration (Phase 2, Batch 5)
-- ---------------------------------------------------------------------------
-- | A tree holding a reserved device stem, a colon and a trailing dot,
-- names POSIX holds and Windows does not, in the order a sorted listing
-- gives them. The colon follows more than one letter: bsdtar, which
-- fetchTarball's extraction runs on macOS, drops a one-letter prefix
-- such as @a:@ as a drive letter once @--strip-components@ has exposed
-- it.
reservedNameFiles :: [(FilePath, BS.ByteString)]
reservedNameFiles = [("aux.c", "device\n"), ("dot.", "dot\n"), ("key:value", "colon\n")]
-- | Where upstream stores 'reservedNameFiles' as a coerced source
-- directory named @src@ (nix-instantiate 2.33.2, @"${./src}"@) and as
-- the tree of a fetchTarball (with @--store 'local?root=...'@, which
-- holds it under exactly these names).
reservedNameSourcePath, reservedNameTarballPath :: StorePath
reservedNameSourcePath = StorePath "42hs0hrpla9b23iz9p3nj0px0np0jv6f" "src"
reservedNameTarballPath = StorePath "rlwykawmqrmdiq4xmcr4rf2zxf6y9k09" "source"
-- | End-to-end: eval .nix source, extract derivation, build, verify output.
evalAndBuild :: StoreDir -> Text -> IO (Either Text (BuildResult, Store))
evalAndBuild storeDir source = do
case parseNix testBaseDir "<test>" source of
Left err -> pure (Left ("parse error: " <> T.pack (show err)))
Right expr -> do
-- The SAME store the build below is given. Evaluating against the
-- platform default while building elsewhere is what let a store dir
-- honored on writes but not on reads pass the whole suite.
st <- newEvalState storeDir "."
evalResult <- runEvalIO st $ do
val <- eval (builtinEnv unrestrictedPolicy (esTimestamp st) (esSearchPaths st)) expr
-- What the CLI driver does: force drvPath, which runs
-- derivationStrict (so a missing required attr surfaces as an eval
-- error) and records the .drv the build reads back by that path.
case val of
VAttrs attrs | Just thunk <- attrSetLookup "drvPath" attrs -> do
pathVal <- force thunk
case pathVal of
VStr pathBytes _ -> lookupSessionDrv (bytesText pathBytes)
_ -> pure Nothing
_ -> pure Nothing
case evalResult of
Left err -> pure (Left ("eval error: " <> err))
Right Nothing -> pure (Left "result is not a derivation")
Right (Just drv) -> do
store <- openStore storeDir
tmpBase <- getTemporaryDirectory
let config = (defaultBuildConfig storeDir) {bcTmpDir = tmpBase </> "nova-nix-e2e-tmp"}
-- What the CLI driver does before building, in the same
-- order: eval has no store DB handle, so anything it wrote
-- is registered here or not at all. Skipping it made this
-- harness unable to see a whole class of driver bug.
sourceCache <- readIORef (esSourcePathCache st)
storeWrites <- readIORef (esStoreWriteCache st)
materializeEvalSources store sourceCache
materializeEvalStoreWrites store storeWrites
result <- buildDerivation config store drv
pure (Right (result, store))
testE2E :: IO [Bool]
testE2E = do
putStrLn "cli/e2e"
shell <- findTestShell
sequence
[ -- End-to-end: eval -> build a simple derivation
runTestM "e2e eval -> build" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-e2e1"
forceRemoveIfExists tmpStore
-- Build the Nix source with the discovered shell path.
-- Nix strings use \\ for literal backslash, \" for literal quote.
let nixEscape = T.concatMap (\c -> if c == '\\' then "\\\\" else if c == '"' then "\\\"" else T.singleton c)
e2eSource =
T.concat
[ "derivation { name = \"e2e-test\"; system = builtins.currentSystem; ",
"builder = \"" <> nixEscape shell <> "\"; ",
"args = [\"-c\" \"mkdir -p $out && echo e2e > $out/e2e.txt\"]; }"
]
result <- evalAndBuild (StoreDir tmpStore) e2eSource
ret <- case result of
Left err -> pure (Fail err)
Right (BuildSuccess _, store) -> do
closeStore store
pure Pass
Right (BuildFailure msg code, store) -> do
closeStore store
pure (Fail ("build failed (" <> T.pack (show code) <> "): " <> msg))
forceRemoveIfExists tmpStore
forceRemoveIfExists (tmpBase </> "nova-nix-e2e-tmp")
pure ret,
-- Every eval-time store writer must register, not only toFile: an
-- unrecorded write reaches drvInputSrcs and the build dies with
-- "references unregistered path".
runTestM "e2e eval-time store writes register as derivation inputs" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-e2e-inputs"
srcDir = tmpBase </> "nova-nix-test-e2e-inputs-src"
nixEscape = T.concatMap (\c -> if c == '\\' then "\\\\" else if c == '"' then "\\\"" else T.singleton c)
drvWith srcExpr =
T.concat
[ "derivation { name = \"inputs-test\"; system = builtins.currentSystem; ",
"builder = \"" <> nixEscape shell <> "\"; ",
"args = [\"-c\" \"echo ok > $out\"]; ",
"src = " <> srcExpr <> "; }"
]
forceRemoveIfExists tmpStore
forceRemoveIfExists srcDir
Dir.createDirectoryIfMissing True srcDir
writeFile (srcDir </> "f.txt") "content\n"
let cases =
[ ("toFile", "builtins.toFile \"note\" \"text\""),
-- A path LITERAL, not a string, so it must be spelled the
-- way the evaluator spells path values: the lexer rejects a
-- backslash, and a native Windows temp dir is full of them.
-- Through 'canonPathValue' rather than a separator replace,
-- because a backslash is an ordinary file-name character on
-- POSIX and only a separator on Windows.
("path", "builtins.path { path = " <> canonPathValue (T.pack srcDir) <> "; name = \"sd\"; }")
]
outcomes <-
mapM
( \(label, expr) -> do
result <- evalAndBuild (StoreDir tmpStore) (drvWith expr)
pure (label, result)
)
cases
let failures =
[ label <> ": " <> reason
| (label, result) <- outcomes,
Just reason <-
[ case result of
Left err -> Just err
Right (BuildFailure msg _, _) -> Just msg
Right (BuildSuccess _, _) -> Nothing
]
]
mapM_
( \(_, result) -> case result of
Right (_, store) -> closeStore store
Left _ -> pure ()
)
outcomes
forceRemoveIfExists tmpStore
forceRemoveIfExists srcDir
pure $ case failures of
[] -> Pass
errs -> Fail (T.intercalate "; " errs),
-- POSIX holds names Windows reserves, and upstream stores them as
-- their bytes there (#84). A coerced source and a fetchTarball
-- tree holding a device stem, a colon and a trailing dot restore
-- with exactly those names, under the paths upstream computes
-- for them ('reservedNameSourcePath'), as the raw copy they
-- replace stored them (#235).
runTestM "e2e sources holding names Windows reserves restore with their names" $
if SI.os == "mingw32"
then Pass <$ putStrLn " SKIP a Windows volume cannot hold these names"
else do
tmpBase <- getTemporaryDirectory
environment <- getEnvironment
let root = tmpBase </> "nova-nix-test-e2e-names"
srcDir = root </> "src"
stage = root </> "stage"
tarball = root </> "names.tar.gz"
tmpStore = tmpBase </> "nova-nix-test-e2e-names-store"
nixEscape = T.concatMap (\c -> if c == '\\' then "\\\\" else if c == '"' then "\\\"" else T.singleton c)
source =
T.concat
[ "derivation { name = \"names\"; system = builtins.currentSystem; ",
"builder = \"" <> nixEscape shell <> "\"; ",
"args = [\"-c\" \"echo ok > $out\"]; ",
"srcs = [ " <> canonPathValue (T.pack srcDir) <> " ",
"(builtins.fetchTarball \"file://" <> nixEscape (T.pack tarball) <> "\") ]; }"
]
-- bsdtar would otherwise add AppleDouble entries for
-- any extended attributes the files carry.
tarProcess =
(Proc.proc "tar" ["-czf", tarball, "-C", stage, "top"])
{ Proc.env = Just (("COPYFILE_DISABLE", "1") : environment)
}
writeTree dir = do
createDirectoryIfMissing True dir
mapM_ (\(name, bytes) -> BS.writeFile (dir </> name) bytes) reservedNameFiles
storedAs store sp = do
let dest = storePathToFilePath (stDir store) sp
present <- doesDirectoryExist dest
if not present
then pure (Just (spName sp <> ": no tree at " <> T.pack dest))
else do
names <- sort <$> Dir.listDirectory dest
contents <- traverse (BS.readFile . (dest </>)) names
valid <- isValid store sp
pure $
if valid && zip names contents == reservedNameFiles
then Nothing
else Just (spName sp <> " valid " <> T.pack (show valid) <> ", stored as " <> T.pack (show (zip names contents)))
forceRemoveIfExists root
forceRemoveIfExists tmpStore
writeTree srcDir
writeTree (stage </> "top")
(tarCode, _, tarErr) <- Proc.readCreateProcessWithExitCode tarProcess ""
verdict <- case tarCode of
ExitFailure n -> pure (Fail ("tar exited " <> T.pack (show n) <> ": " <> T.pack tarErr))
ExitSuccess -> do
built <- evalAndBuild (StoreDir tmpStore) source
case built of
Left err -> pure (Fail err)
Right (BuildFailure msg _, store) -> Fail msg <$ closeStore store
Right (BuildSuccess _, store) -> do
problems <- catMaybes <$> traverse (storedAs store) [reservedNameSourcePath, reservedNameTarballPath]
closeStore store
pure (if null problems then Pass else Fail (T.intercalate "; " problems))
forceRemoveIfExists root
forceRemoveIfExists tmpStore
pure verdict,
-- The writer half of the eval-write pair: an interrupted earlier
-- run's truncated file at a toFile path must be rewritten, not
-- adopted on bare existence (adopting it used to register such a file
-- valid under the full content's hash, seal it read-only, and let a
-- build consume it).
runTestM "a truncated pre-existing toFile write is rewritten, not adopted" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-tofile-verify"
nixEscape = T.concatMap (\c -> if c == '\\' then "\\\\" else if c == '"' then "\\\"" else T.singleton c)
goodText = "the full intended content" :: Text
goodBytes = TE.encodeUtf8 goodText
forceRemoveIfExists tmpStore
case makeTextPath "note" (sha256Digest goodBytes) [] of
Left err -> pure (Fail ("test store path rejected: " <> T.pack (show err)))
Right sp -> do
let dest = storePathToFilePath (StoreDir tmpStore) sp
Dir.createDirectoryIfMissing True (takeDirectory dest)
BS.writeFile dest (TE.encodeUtf8 "the full")
let expr =
"derivation { name = \"tofile-verify\"; system = builtins.currentSystem; "
<> "builder = \""
<> nixEscape shell
<> "\"; "
<> "args = [\"-c\" \"echo ok > $out\"]; "
<> "src = builtins.toFile \"note\" \""
<> goodText
<> "\"; }"
result <- evalAndBuild (StoreDir tmpStore) expr
rewritten <- BS.readFile dest
outcome <- case result of
Left err -> pure (Fail err)
Right (BuildFailure msg _, store) -> closeStore store >> pure (Fail msg)
Right (BuildSuccess _, store) -> do
registered <- isValid store sp
closeStore store
pure $
if rewritten == goodBytes && registered
then Pass
else Fail "adopted the truncated file instead of rewriting it"
forceRemoveIfExists tmpStore
pure outcome,
-- Same guarantee for the tree writer behind builtins.path: a
-- corrupted partial tree at the computed path is cleared and
-- re-unpacked, never adopted.
runTestM "a corrupted pre-existing builtins.path tree is re-copied, not adopted" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-path-verify"
srcDir = tmpBase </> "nova-nix-test-path-verify-src"
nixEscape = T.concatMap (\c -> if c == '\\' then "\\\\" else if c == '"' then "\\\"" else T.singleton c)
forceRemoveIfExists tmpStore
forceRemoveIfExists srcDir
Dir.createDirectoryIfMissing True srcDir
BS.writeFile (srcDir </> "f.txt") (TE.encodeUtf8 "real content\n")
entry <- NAR.serialiseFromPath srcDir
case makeFixedOutputPath "sd" "sha256" "recursive" (sha256Digest (NAR.serialise entry)) of
Left err -> pure (Fail ("test store path rejected: " <> T.pack (show err)))
Right sp -> do
let dest = storePathToFilePath (StoreDir tmpStore) sp
Dir.createDirectoryIfMissing True dest
BS.writeFile (dest </> "f.txt") (TE.encodeUtf8 "partial garbage")
let expr =
"derivation { name = \"path-verify\"; system = builtins.currentSystem; "
<> "builder = \""
<> nixEscape shell
<> "\"; "
<> "args = [\"-c\" \"echo ok > $out\"]; "
<> "src = builtins.path { path = "
<> canonPathValue (T.pack srcDir)
<> "; name = \"sd\"; }; }"
result <- evalAndBuild (StoreDir tmpStore) expr
outcome <- case result of
Left err -> pure (Fail err)
Right (BuildFailure msg _, store) -> closeStore store >> pure (Fail msg)
Right (BuildSuccess _, store) -> do
-- Strict bytes: a lazy read here holds the file open past
-- the cleanup below, and Windows refuses to delete it.
adopted <- BS.readFile (dest </> "f.txt")
registered <- isValid store sp
closeStore store
pure $
if adopted == TE.encodeUtf8 "real content\n" && registered
then Pass
else Fail ("adopted the corrupted tree: " <> T.pack (show adopted))
forceRemoveIfExists tmpStore
forceRemoveIfExists srcDir
pure outcome,
-- The build path joins the per-path lock protocol (#119, #121) that
-- delete, materialize and register already used. Lock files persist
-- by design, so the one guarding the output is the observable
-- evidence the build took it; without it two concurrent builds share
-- a build directory and interleave into one tree.
runTestM "e2e a build takes its output's path lock" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-e2e-lock"
nixEscape = T.concatMap (\c -> if c == '\\' then "\\\\" else if c == '"' then "\\\"" else T.singleton c)
lockSource =
T.concat
[ "derivation { name = \"lock-test\"; system = builtins.currentSystem; ",
"builder = \"" <> nixEscape shell <> "\"; ",
"args = [\"-c\" \"echo locked > $out\"]; }"
]
forceRemoveIfExists tmpStore
result <- evalAndBuild (StoreDir tmpStore) lockSource
ret <- case result of
Left err -> pure (Fail err)
Right (BuildFailure msg code, store) -> do
closeStore store
pure (Fail ("build failed (" <> T.pack (show code) <> "): " <> msg))
Right (BuildSuccess sp, store) -> do
closeStore store
let outPath = storePathToFilePath (StoreDir tmpStore) sp
locked <- Dir.doesFileExist (outPath <> ".lock")
pure $
if locked
then Pass
else Fail "no lock file beside the built output"
forceRemoveIfExists tmpStore
forceRemoveIfExists (tmpBase </> "nova-nix-e2e-tmp")
pure ret,
-- Parse error produces Left
runTestM "e2e parse error" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-e2e2"
forceRemoveIfExists tmpStore
result <- evalAndBuild (StoreDir tmpStore) "{{ invalid nix"
forceRemoveIfExists tmpStore
pure $ case result of
Left msg ->
if "parse error" `T.isInfixOf` msg
then Pass
else Fail ("expected parse error, got: " <> msg)
Right _ -> Fail "expected error but got success",
-- Eval error produces Left
runTestM "e2e eval error" $ do
tmpBase <- getTemporaryDirectory
let tmpStore = tmpBase </> "nova-nix-test-e2e3"
forceRemoveIfExists tmpStore
result <- evalAndBuild (StoreDir tmpStore) "derivation { }"
forceRemoveIfExists tmpStore
pure $ case result of
Left msg ->
if "error" `T.isInfixOf` T.toLower msg
then Pass
else Fail ("expected eval error, got: " <> msg)
Right _ -> Fail "expected error but got success",
-- E2E with subprocess: nova-nix eval on a .nix file
runTestM "e2e nova-nix eval subprocess" $ do
tmpBase <- getTemporaryDirectory
let tmpDir = tmpBase </> "nova-nix-test-e2e-sub"
nixFile = tmpDir </> "test.nix"
forceRemoveIfExists tmpDir
createDirectoryIfMissing True tmpDir
writeFile nixFile "1 + 2"
-- Run nova-nix eval via Process
(exitCode, stdoutStr, stderrStr) <-
Proc.readCreateProcessWithExitCode
(Proc.proc "cabal" ["run", "nova-nix", "--", "eval", nixFile])
""
forceRemoveIfExists tmpDir
pure $ case exitCode of
ExitSuccess ->
let nonEmpty = filter (not . T.null) (T.lines (T.pack stdoutStr))
lastLine = case reverse nonEmpty of
(l : _) -> Just l
[] -> Nothing
in if lastLine == Just "3"
then Pass
else Fail ("expected 3 as last line, got: " <> T.pack stdoutStr)
ExitFailure code ->
Fail ("nova-nix eval failed (" <> T.pack (show code) <> "): stderr=" <> T.pack stderrStr)
]
-- | Exercise the real CLI: testing 'execWrapperConfig' alone cannot catch
-- a sub-parser that never passes the option to it. The foreign builder is
-- deliberately "-c", so only launching it through the shell can succeed.
testExecWrapperCLI :: IO [Bool]
testExecWrapperCLI = do
putStrLn "cli/exec-wrapper"
shell <- findTestShell
tmpBase <- getTemporaryDirectory
ambient <- getEnvironment
let root = tmpBase </> "nova-nix-test-cli-wrapper"
system = platformToText (if currentPlatform == X86_64_Windows then X86_64_Linux else X86_64_Windows)
wrapper = ["--exec-wrapper", T.unpack (system <> "=" <> shell)]
otherWrapper = ["--exec-wrapper", T.unpack (platformToText currentPlatform <> "=" <> shell)]
source =
"derivation { name = \"cli-wrapper\"; system = \""
<> T.unpack system
<> "\"; builder = \"-c\"; args = [\"printf wrapped > \\\"$out\\\"\"]; }"
target = ["--expr", source]
isolatedEnv =
("NIX_CONFIG", "substituters =\ntrusted-public-keys =\n")
: ("XDG_CONFIG_HOME", root </> "config")
: filter (\(key, _) -> key `notElem` ["NIX_CONFIG", "XDG_CONFIG_HOME"]) ambient
runCLI args =
Proc.readCreateProcessWithExitCode
((Proc.proc "cabal" (["run", "-v0", "nova-nix", "--"] ++ args)) {Proc.env = Just isolatedEnv})
""
buildCases =
[ ("before build", wrapper ++ ["build"] ++ target),
("before target", ["build"] ++ wrapper ++ target),
("after target", ["build"] ++ target ++ wrapper),
("repeated across build", otherWrapper ++ ["build"] ++ target ++ wrapper)
]
errorCases =
[ ("missing value", ["build"] ++ target ++ ["--exec-wrapper"], "--exec-wrapper requires a value"),
("malformed spec", ["build"] ++ target ++ ["--exec-wrapper", "invalid"], "--exec-wrapper expects SYSTEM=PATH, got: invalid"),
("duplicate system", wrapper ++ ["build"] ++ target ++ wrapper, "--exec-wrapper names " <> system <> " twice"),
("missing launcher", ["build"] ++ target ++ ["--exec-wrapper", T.unpack system ++ "=" ++ (root </> "missing-launcher")], "does not exist")
]
bracket_
(forceRemoveIfExists root >> createDirectoryIfMissing True root)
(forceRemoveIfExists root)
( do
builds <-
mapM
( \(label, args) -> runTestM ("CLI wrapper " <> label) $ do
(code, out, err) <- runCLI (args ++ ["--store", root </> T.unpack label])
case (code, reverse (filter (not . null) (lines out))) of
(ExitSuccess, path : _) -> assertEqual "wrapped output" "wrapped" <$> BS.readFile path
_ -> pure (Fail ("CLI failed: " <> T.pack (show code) <> "; stdout=" <> T.pack out <> "; stderr=" <> T.pack err))
)
buildCases
errors <-
mapM
( \(label, args, expected) -> runTestM ("CLI wrapper " <> label) $ do
(code, _, err) <- runCLI args
pure $
if code /= ExitSuccess && expected `T.isInfixOf` T.pack err
then Pass
else Fail ("expected failure containing " <> expected <> ", got " <> T.pack (show (code, err)))
)
errorCases
pure (builds ++ errors)
)
-- ---------------------------------------------------------------------------
-- Tests: Phase 4 - search paths, dynamic keys, directory import
-- ---------------------------------------------------------------------------
testPhase4 :: IO [Bool]
testPhase4 = do
putStrLn "phase4/search-paths"
sequence
[ -- parseNixPath tests
runTest "parseNixPath empty" $
assertEqual "empty" [] (parseNixPath ""),
runTest "parseNixPath single" $
let result = parseNixPath "nixpkgs=/home/user/nixpkgs"
in case result of
[thunk] | Just (VAttrs m) <- readThunkValue thunk ->
case (attrSetLookup "prefix" m >>= readThunkValue, attrSetLookup "path" m >>= readThunkValue) of
(Just (VStr "nixpkgs" _), Just (VStr "/home/user/nixpkgs" _)) -> Pass
_ -> Fail "wrong prefix/path"
_ -> Fail ("expected one entry, got " <> T.pack (show (length result))),
runTest "parseNixPath multiple" $
assertEqual "count" 2 (length (parseNixPath "nixpkgs=/nix:custom=/opt")),
runTest "parseNixPath channel entry" $
let result = parseNixPath "nixpkgs=channel:nixos-24.11"
in case result of
[thunk] | Just (VAttrs m) <- readThunkValue thunk ->
case (attrSetLookup "prefix" m >>= readThunkValue, attrSetLookup "path" m >>= readThunkValue) of
(Just (VStr "nixpkgs" _), Just (VStr "channel:nixos-24.11" _)) -> Pass
_ -> Fail "wrong prefix/path for channel"
_ -> Fail ("expected one entry, got " <> T.pack (show (length result))),
runTest "splitNixPath drive letters and separators" $
assertEqual
"split"
["nixpkgs=C:\\nixpkgs", "custom=/opt/custom", "C:/x"]
(splitNixPath "nixpkgs=C:\\nixpkgs:custom=/opt/custom:C:/x"),
runTest "splitNixPath splits a Unix-style absolute path list" $
assertEqual "split-unix" ["/foo", "/bar"] (splitNixPath "/foo:/bar"),
runTest "splitNixPath splits a Unix entry after a drive entry" $
assertEqual "split-mixed" ["C:\\a", "/foo"] (splitNixPath "C:\\a:/foo"),
runTest "splitNixPath keeps a URL entry whole" $
assertEqual
"split-url"
["nixpkgs=https://example.com/nixpkgs.tar.gz", "custom=/opt"]
(splitNixPath "nixpkgs=https://example.com/nixpkgs.tar.gz:custom=/opt"),
runTest "splitNixPath keeps a channel entry whole" $
assertEqual
"split-channel"
["channel:nixos-24.11", "/foo"]
(splitNixPath "channel:nixos-24.11:/foo"),
runTest "splitNixPath keeps a prefixed channel entry whole" $
assertEqual
"split-channel-prefixed"
["nixpkgs=channel:nixos-24.11", "/foo"]
(splitNixPath "nixpkgs=channel:nixos-24.11:/foo"),
runTest "splitNixPath keeps a flake entry whole" $
assertEqual "split-flake" ["flake:nixpkgs", "/foo"] (splitNixPath "flake:nixpkgs:/foo"),
runTest "splitNixPath keeps every listed scheme whole" $
assertEqual
"split-schemes"
["http://h/a", "https://h/b", "file:///c", "channel://d", "git://h/e", "s3://b/f", "ssh://h/g"]
(splitNixPath "http://h/a:https://h/b:file:///c:channel://d:git://h/e:s3://b/f:ssh://h/g"),
runTest "splitNixPath splits an unlisted scheme at its colon" $
assertEqual "split-unlisted" ["foo", "//x", "/bar"] (splitNixPath "foo://x:/bar"),
runTest "splitNixPath drops empty entries" $
assertEqual "split-empties" ["a", "b"] (splitNixPath "a::b:"),
runTest "splitNixPath drops leading empty entries" $
assertEqual "split-leading-empties" ["x"] (splitNixPath "::x"),
runTest "splitNixPath matches a scheme case-sensitively" $
assertEqual "split-scheme-case" ["HTTP", "//x", "/y"] (splitNixPath "HTTP://x:/y"),
runTest "splitNixPath judges the scheme after the last = of the entry" $
assertEqual "split-last-equals" ["a=b=https://x", "/y"] (splitNixPath "a=b=https://x:/y"),
runTest "splitNixPath splits a URL port after the host" $
assertEqual "split-port" ["https://example.com", "8080/x"] (splitNixPath "https://example.com:8080/x"),
runTest "splitNixPath absorbs one run after a channel entry" $
assertEqual "split-one-run" ["channel:channel", "x"] (splitNixPath "channel:channel:x"),
runTest "splitNixPath keeps a bare channel colon" $
assertEqual "split-channel-bare" ["channel:", "foo"] (splitNixPath "channel::foo"),
runTest "isNixPathPseudoUrl: channel, flake and the listed schemes are fetched" $
assertEqual
"pseudo"
[True, True, True, True, True]
(map isNixPathPseudoUrl ["channel:nixos-24.11", "channel:", "flake:nixpkgs", "https://example.com/x.tar.gz", "file:///c"]),
runTest "isNixPathPseudoUrl: a path, an unlisted scheme, a drive and a bare word are not" $
assertEqual "not-pseudo" [False, False, False, False] (map isNixPathPseudoUrl ["/foo", "foo://x", "C:/x", "channel"]),
runTest "splitNixPath drops a trailing empty entry" $
assertEqual "split-trail" ["a"] (splitNixPath "a:"),
runTestM "splitNixPath long entry splits in linear time" $ do
let entry = TE.encodeUtf8 (T.replicate 2000000 "p")
split = splitNixPath ("first:" <> entry) == ["first", entry]
outcome <- timeout walkWatchdogMicros (evaluate split)
pure $ case outcome of
Just True -> Pass
Just False -> Fail "wrong split for a long entry"
Nothing -> Fail "split did not return promptly",
runTest "parseNixPath plain path" $
let result = parseNixPath "/some/path"
in case result of
[thunk] | Just (VAttrs m) <- readThunkValue thunk ->
case (attrSetLookup "prefix" m >>= readThunkValue, attrSetLookup "path" m >>= readThunkValue) of
(Just (VStr "" _), Just (VStr "/some/path" _)) -> Pass
_ -> Fail "wrong prefix/path for plain"
_ -> Fail "expected one entry",
-- ESearchPath desugars to __findFile __nixPath "name" during resolution
runTest "parse <nixpkgs>" $
assertParse "search path" "<nixpkgs>" (EApp (EApp (EVar "__findFile") (EVar "__nixPath")) (EStr [StrLit "nixpkgs"])),
runTest "parse <nixpkgs/lib>" $
assertParse "search path with subpath" "<nixpkgs/lib>" (EApp (EApp (EVar "__findFile") (EVar "__nixPath")) (EStr [StrLit "nixpkgs/lib"])),
-- ESearchPath eval (should fail in pure mode since no search paths)
runTest "eval <nixpkgs> fails without path" $
assertEvalFail "search path not found" "<nixpkgs>",
-- Dynamic attribute keys
runTest "dynamic key basic" $
assertEval "dynamic key" "{ ${\"hello\"} = 42; }.hello" (VInt 42),
runTest "dynamic key from let" $
assertEval "dynamic key let" "let name = \"x\"; in { ${name} = 1; }.x" (VInt 1),
runTest "dynamic key in select" $
assertEval "dynamic key select" "let s = { x = 10; }; in s.${\"x\"}" (VInt 10),
runTest "dynamic key in hasAttr" $
assertEval "dynamic key hasAttr" "let s = { x = 10; }; in s ? ${\"x\"}" (VBool True),
runTest "dynamic key hasAttr missing" $
assertEval "dynamic key hasAttr missing" "let s = { x = 10; }; in s ? ${\"y\"}" (VBool False),
-- has-attr checks presence of the terminal attribute without
-- forcing its value, matching upstream laziness.
runTest "hasAttr does not force the final attribute" $
assertEval "hasattr-lazy" "{ a = builtins.throw \"boom\"; } ? a" (VBool True),
runTest "hasAttr path does not force the terminal attribute" $
assertEval "hasattr-path-lazy" "{ a = { b = builtins.throw \"boom\"; }; } ? a.b" (VBool True),
-- A null dynamic key in select or has-attr is a type error, as
-- upstream; it is not treated as an absent attribute.
runTest "null dynamic select key is a type error" $
assertEvalFail "sel-null-key" "({ x = 1; }).${null}",
runTest "null dynamic hasAttr key is a type error" $
assertEvalFail "has-null-key" "{ x = 1; } ? ${null}",
-- inherit inside a rec set with a dynamic key resolves against the
-- enclosing scope, never the rec set's own binding.
runTest "inherit in a dynamic-keyed rec set resolves outward" $
assertEval "dyn-rec-inherit" "let v = 42; in (rec { ${\"d\"} = 1; inherit v; }).v" (VInt 42),
-- Dynamic attr inside string interpolation (the ${name} must not
-- prematurely close the outer interpolation)
runTest "dynamic key in string interp" $
assertEval "dynamic key interp" "let s = { x = 10; }; in \"${toString s.${\"x\"}}\"" (VStr "10" mempty)
]
testPhase4IO :: IO [Bool]
testPhase4IO = do
putStrLn "phase4/directory-import"
tmpDir <- getTemporaryDirectory
let testDir = tmpDir </> "nova-nix-phase4-test"
subDir = testDir </> "mypkg"
defaultNix = subDir </> "default.nix"
-- Create temp directory structure
createDirectoryIfMissing True subDir
TIO.writeFile defaultNix "42"
results <-
sequence
[ -- Directory import: import ./dir resolves to ./dir/default.nix
runTestM "import directory" $ do
result <- evalNixIO testDir ("import " <> T.pack "./mypkg")
pure $ case result of
Right (VInt 42) -> Pass
Right other -> Fail ("expected VInt 42, got " <> T.pack (show other))
Left err -> Fail ("eval error: " <> err),
-- Search path with --nix-path equivalent (populated nixPath)
runTestM "search path with populated nixPath" $ do
st <- newEvalState platformStoreDir testDir
let nixPaths = parseNixPath (TE.encodeUtf8 ("mypkg=" <> T.pack subDir))
env = builtinEnv unrestrictedPolicy (esTimestamp st) nixPaths
result <- runEvalIO st (eval env (EApp (EApp (EVar "__findFile") (EVar "__nixPath")) (EStr [StrLit "mypkg"])))
pure $ case result of
Right (VPath _) -> Pass
Right other -> Fail ("expected VPath, got " <> T.pack (show other))
Left err -> Fail ("eval error: " <> err)
]
-- Cleanup
removeDirectoryRecursive testDir
pure results
-- | @builtins.toJSON@ of a path uses copy-to-store coercion (upstream
-- value-to-json.cc serializes paths with @copyToStore = true@): the JSON
-- text is the quoted source store path and the result carries its
-- context. EvalIO-only: PureEval has no store-path computation.
testToJSONPathIO :: IO [Bool]
testToJSONPathIO = do
putStrLn "eval/tojson-path-io"
tmpDir <- getTemporaryDirectory
let testDir = tmpDir </> "nova-nix-tojson-path-test"
createDirectoryIfMissing True testDir
TIO.writeFile (testDir </> "data.txt") "payload\n"
results <-
sequence
[ runTestM "toJSON of a path is its quoted store path with context" $ do
result <- evalNixIO testDir "builtins.toJSON ./data.txt"
pure $ case result of
Right (VStr json ctx) ->
if "\"/nix/store/" `BS.isPrefixOf` json
&& "-data.txt\"" `BS.isSuffixOf` json
&& ctx /= emptyContext
then Pass
else Fail ("expected a quoted store path with context, got " <> bytesText json)
Right other -> Fail ("expected VStr, got " <> T.pack (show other))
Left err -> Fail ("eval error: " <> err)
]
removeDirectoryRecursive testDir
pure results
-- ---------------------------------------------------------------------------
-- Arena lifecycle guard (C FFI)
-- ---------------------------------------------------------------------------
-- | The argument that turns this executable into the child of
-- 'testArenaGuard'. The child reaches the C layer with no 'arenaInit',
-- which the suite cannot do in its own process: 'main' brackets every
-- group, and a destroy-then-reinit cycle would invalidate the arena
-- pointers that process-lifetime CAFs already hold (#19).
arenaGuardChildFlag :: String
arenaGuardChildFlag = "--arena-guard-child"
-- | One way a library user reaches the C layer, with what the child must
-- report for it.
data ArenaGuardPath = ArenaGuardPath
{ -- | The child's argument.
guardName :: !String,
-- | The suite's name for the case.
guardClaim :: !Text,
-- | What the child must report.
guardOutcome :: !GuardOutcome,
-- | The child's body, run with no 'arenaInit' of its own.
guardAction :: !(IO ())
}
-- | What a guard child must report for its path.
data GuardOutcome
= -- | 'ArenaNotInitialized', naming this C entry point.
RefusedAt !Text
| -- | No exception: the path needs no arena.
Served
-- | The line a guard child prints when its path raised nothing.
servedLine :: String
servedLine = "served without an exception"
-- | The paths a library user reaches the C layer by. The first C call
-- of each of the first four lands in a different sub-arena, and the
-- fifth runs a full init .. destroy cycle first, so both ends of the
-- window are covered. The last two read the shared @null@, @true@ and
-- @false@ thunks, which must be valid in every window: were they arena
-- cells behind a process-lifetime CAF, forcing one outside the window
-- would poison it with 'ArenaNotInitialized' for every later arena, and
-- forcing one inside an arena would leave it pointing into memory the
-- next 'arenaDestroy' frees, a use-after-free the ASan job reports.
arenaGuardPaths :: [ArenaGuardPath]
arenaGuardPaths =
[ noArena "compile" "nn_bc_emit" evalIssueProgram,
noArena "thunk" "nn_thunk_new_computed_int" (void (evaluate (unThunk (evaluated (VInt 1))))),
noArena "symbol" "nn_symbol_intern" (void (evaluate (unThunk (evaluated (mkStr "a"))))),
noArena "env" "nn_env_alloc_slots" (void (evaluate (fst (buildCSlots [evaluated (VInt 1)])))),
noArena "after-destroy" "nn_bc_emit" (bracket_ arenaInit arenaDestroy (pure ()) >> evalIssueProgram),
ArenaGuardPath
{ guardName = "constants-outside-window",
guardClaim = "the null, true and false thunks read correctly before arenaInit and in a later arena",
guardOutcome = Served,
guardAction = readConstants >> bracket_ arenaInit arenaDestroy readConstants
},
ArenaGuardPath
{ guardName = "constants-across-cycles",
guardClaim = "the null, true and false thunks read correctly across two init .. destroy cycles",
guardOutcome = Served,
guardAction = bracket_ arenaInit arenaDestroy readConstants >> bracket_ arenaInit arenaDestroy readConstants
}
]
where
noArena name site = ArenaGuardPath name ("no arena: " <> T.pack name <> " raises ArenaNotInitialized at " <> site) (RefusedAt site)
-- The program from #206, forced to its result.
evalIssueProgram = case parseNix "/tmp" "<expr>" "let x = 5; in x * 2 + 1" of
Left err -> throwIO (ErrorCall (show err))
Right expr -> void (evaluate (runPureEval (eval (builtinEnv unrestrictedPolicy 0 []) expr)))
-- Read through the IO accessors: a pure read of a constant is itself
-- a constant GHC may share between the cycles, and the second would
-- then read nothing. A wrong cell is a broken outcome rather than the
-- guard under test, so it leaves the child by another exception.
readConstants = do
found <- mapM (readCell . unThunk . evaluated) [VNull, VBool True, VBool False]
unless (found == [(ThunkComputed, ValueNull, 0), (ThunkComputed, ValueBool, 1), (ThunkComputed, ValueBool, 0)]) $
throwIO (ErrorCall ("the constants read back as " ++ show found))
readCell ptr = (,,) <$> cthunkState ptr <*> cthunkValueTag ptr <*> cthunkGetBool ptr
-- | Child body: run one path with no arena and print what it raised, or
-- 'servedLine'. Exit 0 either way; a segfault, a sanitizer report or
-- any other exception type surfaces as the process's own exit code.
arenaGuardChild :: String -> IO ()
arenaGuardChild name = case [guardAction path | path <- arenaGuardPaths, guardName path == name] of
[action] -> do
outcome <- try action
putStrLn $ case outcome of
Left (err :: CStatusError) -> displayException err
Right () -> servedLine
_ -> hPutStrLn stderr ("unknown arena guard path: " ++ name) >> exitWith (ExitFailure 2)
-- | @builtins.storePath@ resolves a path's symlinks unless the path is
-- itself a store path (primops.cc at 2.24.9), so a link outside the store
-- into it names its target. The links dangle on a runner with no store,
-- which upstream resolves the same way; Windows needs symlink privilege.
testStorePathLinksIO :: IO [Bool]
testStorePathLinksIO = do
putStrLn "eval/storepath-links-io"
canLink <- symlinksAvailable
if not canLink || SI.os == "mingw32"
then [] <$ putStrLn " SKIP needs POSIX symlinks"
else do
tmpBase <- Dir.canonicalizePath =<< getTemporaryDirectory
let dir = tmpBase </> "nova-nix-test-storepath-links"
target = "/nix/store/00000000000000000000000000000000-x"
through name = "builtins.storePath (/. + " <> nixQuotedPath (dir </> name) <> ")"
Dir.removePathForcibly dir
createDirectoryIfMissing True dir
Dir.createFileLink target (dir </> "path")
Dir.createFileLink (target <> "/bin") (dir </> "sub")
results <-
sequence
[ runTestIO "a link into the store names the store path" dir (through "path") (VStr (TE.encodeUtf8 (T.pack target)) (Context.plainContext (StorePath "00000000000000000000000000000000" "x"))),
runTestIO "a link to a subpath names the subpath" dir (through "sub") (VStr (TE.encodeUtf8 (T.pack (target <> "/bin"))) (Context.plainContext (StorePath "00000000000000000000000000000000" "x")))
]
Dir.removePathForcibly dir
pure results
-- | A derivation attribute carrying another's drvPath brings that .drv's
-- whole closure into inputSrcs and inputDrvs, as upstream's
-- derivationStrict does (primops.cc at 2.24.9). Each drvPath is
-- nix-instantiate 2.24.9's.
testDeepContextClosureIO :: IO [Bool]
testDeepContextClosureIO = do
putStrLn "eval/deep-context-closure-io"
tmpBase <- getTemporaryDirectory
let plain name rest = "derivation { name = \"" <> name <> "\"; system = \"x\"; builder = \"/bin/sh\"; " <> rest <> "}"
drvPathOf bindings body = "builtins.unsafeDiscardStringContext (let " <> bindings <> " in " <> body <> ").drvPath"
a = "a = " <> plain "a" "" <> ";"
m = "m = " <> plain "m" "dep = a; " <> ";"
t = "t = " <> plain "t" "dep = m; " <> ";"
sequence
[ runTestIO "a drvPath brings its own .drv into inputSrcs" tmpBase (drvPathOf a (plain "b" "x = \"${a.drvPath}\"; ")) (mkStr "/nix/store/r3pz4ykyxg5s9f08fafcksw6bxfds40r-b.drv"),
runTestIO "a drvPath brings the .drv files it depends on" tmpBase (drvPathOf (a <> " " <> m) (plain "b" "x = \"${m.drvPath}\"; ")) (mkStr "/nix/store/00pfjcd57v5dd5j4w4zmsp3s8lcpv6wg-b.drv"),
runTestIO "the closure is followed to its end" tmpBase (drvPathOf (a <> " " <> m <> " " <> t) (plain "b" "x = \"${t.drvPath}\"; ")) (mkStr "/nix/store/f480ldqci72g5miaywmhljjlw1fg1y4i-b.drv")
]
-- | Run as a child, evaluate one expression under the IO evaluator, which
-- writes traces and warnings to stderr as it goes, then write its failure
-- to the same stream, so the parent reads them in the order they came.
evalChildFlag :: String
evalChildFlag = "--eval-child"
evalChild :: String -> IO ()
evalChild source = do
result <- evalNixIO "." (T.pack source)
either (\err -> hPutStrLn stderr ("error: " <> T.unpack err)) (const (pure ())) result
-- | @deepSeq@, @trace@ and @warn@ finish with their first argument before
-- they force their second (primops.cc at 2.24.9), however the second
-- arrives. Each expected stream is nix-instantiate 2.24.9's: its trace
-- and warning lines, then the final error line.
testFirstArgumentOrderIO :: IO [Bool]
testFirstArgumentOrderIO = do
putStrLn "eval/first-argument-order-io"
self <- getExecutablePath
let emits label source expected = runTestM label $ do
(_, _, err) <- Proc.readCreateProcessWithExitCode (Proc.proc self [evalChildFlag, T.unpack source]) ""
pure (assertEqual label expected (T.lines (T.pack err)))
sequence
[ emits "trace prints before its second argument fails" "builtins.trace \"hi\" (throw \"b\")" ["trace: hi", "error: b"],
emits "warn warns before its second argument fails" "builtins.warn \"w\" (throw \"b\")" ["evaluation warning: w", "error: b"],
emits "deepSeq forces its first argument deeply before its second" "builtins.deepSeq { a = throw \"a\"; } (throw \"b\")" ["error: a"],
emits "deepSeq applied to one argument first forces it on the second" "let f = builtins.deepSeq { a = throw \"a\"; }; in f (throw \"b\")" ["error: a"],
emits "deepSeq mapped over a list forces its first argument first" "builtins.elemAt (map (builtins.deepSeq { a = throw \"a\"; }) [ (throw \"b\") ]) 0" ["error: a"],
emits "trace inside deepSeq sees the forced value" "let x = { a = 1 + 1; }; in builtins.deepSeq x (builtins.trace x 1)" ["trace: { a = 2; }"]
]
-- | The smallest slot count whose byte size exceeds @UINT32_MAX@.
-- @nn_env_alloc_slots@ refuses it before touching a page, so inside a
-- live arena it fails without exhausting anything.
slotCountPastUInt32 :: Int
slotCountPastUInt32 = fromIntegral (maxBound :: Word32) `div` sizeOf (nullPtr :: Ptr ()) + 1
-- | One byte past the longest string the symbol table can hold.
symbolLengthPastUInt32 :: Int
symbolLengthPastUInt32 = fromIntegral (maxBound :: Word32) + 1
-- | Intern a ByteString whose length claims 'symbolLengthPastUInt32'
-- bytes over one real byte, so no 4 GiB buffer is needed. Sound only
-- because the interner refuses on the length before reading: an
-- interner that read would run out of bounds here.
internOversizedSymbol :: IO Symbol
internOversizedSymbol =
alloca $ \byte -> do
poke byte (0 :: CChar)
oversized <- BSU.unsafePackCStringLen (byte, symbolLengthPastUInt32)
symbolInternBytes oversized
-- | Reaching the C layer outside the 'arenaInit' .. 'arenaDestroy'
-- window raises 'ArenaNotInitialized' naming the entry point, where
-- #206 reported a SIGSEGV. Each such path runs in a child process.
-- The live side of the same check runs in this process, under the
-- suite's bracket: a refusal with the arena up is 'CAllocationFailed'.
testArenaGuard :: IO [Bool]
testArenaGuard = do
putStrLn "arena/guard"
self <- getExecutablePath
children <-
mapM
( \path -> runTestM (guardClaim path) $ do
(code, out, err) <- Proc.readCreateProcessWithExitCode (Proc.proc self [arenaGuardChildFlag, guardName path]) ""
let message = T.pack out
pure $ case (code, guardOutcome path) of
(ExitSuccess, RefusedAt site)
| "arenaInit" `T.isInfixOf` message && site `T.isInfixOf` message -> Pass
| otherwise -> Fail ("message does not name arenaInit and " <> site <> ": " <> message)
(ExitSuccess, Served)
| T.strip message == T.pack servedLine -> Pass
| otherwise -> Fail ("expected no exception, got: " <> message)
(ExitFailure n, _) -> Fail ("child exited " <> T.pack (show n) <> " (negative is a signal): " <> T.pack err)
)
arenaGuardPaths
live <-
sequence
[ liveRefusal "a slot array past UINT32_MAX bytes" "nn_env_alloc_slots" (void (evaluate (allocCSlots slotCountPastUInt32))),
-- The list's items come from the same slot allocator, so the same
-- count is refused there and must surface as a list failure, where
-- the NULL it used to return read as the empty list.
liveRefusal "a list past UINT32_MAX slot bytes" "nn_list_new" (void (clistNew (fromIntegral slotCountPastUInt32))),
-- A length the entry's uint32_t cannot hold, refused rather than
-- truncated to alias a shorter string.
liveRefusal "a symbol longer than UINT32_MAX bytes" "nn_symbol_intern" (void internOversizedSymbol)
]
tableIntact <-
runTestM "a refused symbol leaves the table unchanged" $ do
before <- symbolCount
_ <- try internOversizedSymbol :: IO (Either CStatusError Symbol)
after <- symbolCount
sym <- symbolIntern "after-a-refusal"
pure $
if before == after && symbolText sym == "after-a-refusal"
then Pass
else Fail ("count " <> T.pack (show before) <> " -> " <> T.pack (show after) <> ", text " <> symbolText sym)
pure (children ++ live ++ [tableIntact])
where
liveRefusal what site action =
runTestM ("live arena: " <> what <> " raises CAllocationFailed at " <> site) $ do
alive <- arenaLive
outcome <- try action
pure $ case (alive, outcome) of
(True, Left (CAllocationFailed refused _)) | refused == T.unpack site -> Pass
(True, Left err) -> Fail ("expected CAllocationFailed at " <> site <> ", got " <> T.pack (show err))
(True, Right ()) -> Fail "no exception raised"
(False, _) -> Fail "arenaLive is False inside the suite's bracket"
-- ---------------------------------------------------------------------------
-- Symbol interning (C FFI)
-- ---------------------------------------------------------------------------
testSymbol :: IO [Bool]
testSymbol = do
putStrLn "symbol"
-- Symbol table is initialized by arenaInit in main bracket.
sequence
[ runTestM "intern returns non-zero" $ do
sym <- symbolIntern "hello"
pure (if unSymbol sym /= 0 then Pass else Fail "got symbol 0"),
runTestM "intern same string returns same symbol" $ do
sym1 <- symbolIntern "name"
sym2 <- symbolIntern "name"
pure (assertEqual "same symbol" sym1 sym2),
runTestM "intern different strings returns different symbols" $ do
sym1 <- symbolIntern "foo"
sym2 <- symbolIntern "bar"
pure (if sym1 /= sym2 then Pass else Fail "symbols should differ"),
runTestM "symbolText round-trips" $ do
sym <- symbolIntern "version"
let txt = symbolText sym
pure (assertEqual "text" "version" txt),
runTestM "symbolLen correct" $ do
sym <- symbolIntern "outputs"
pure (assertEqual "len" 7 (symbolLen sym)),
runTestM "empty string interns" $ do
sym <- symbolIntern ""
let txt = symbolText sym
pure (assertEqual "empty" "" txt),
runTestM "symbolCount tracks unique entries" $ do
_ <- symbolIntern "alpha"
_ <- symbolIntern "beta"
_ <- symbolIntern "alpha"
count <- symbolCount
-- count includes all symbols interned in this bracket,
-- so at least the ones from prior tests plus alpha + beta
pure (if count >= 2 then Pass else Fail ("count too low: " <> T.pack (show count))),
runTestM "many symbols (stress)" $ do
let names = map (\i -> "pkg_" <> T.pack (show (i :: Int))) [1 .. 1000]
syms <- mapM symbolIntern names
-- All unique
let unique = length (Set.fromList (map unSymbol syms))
pure (assertEqual "1000 unique" 1000 unique)
]
-- ---------------------------------------------------------------------------
-- C attribute set (FFI)
-- ---------------------------------------------------------------------------
-- | Cast a StablePtr to CThunkPtr for CAttrSet tests.
-- CAttrSet stores void* - we use StablePtrs as opaque values in tests.
spToCPtr :: StablePtr a -> CThunkPtr
spToCPtr = castPtr . castStablePtrToPtr
-- | Cast a CThunkPtr back to StablePtr for CAttrSet test verification.
cptrToSp :: CThunkPtr -> StablePtr a
cptrToSp = castPtrToStablePtr . castPtr
testCAttrSet :: IO [Bool]
testCAttrSet = do
putStrLn "cattrset"
-- Symbol table is initialized by arenaInit in main bracket.
sequence
[ runTestM "new/free" $ do
_set <- cattrsetNew 16
-- set freed by arenaDestroy via nn_attrset_free_all
pure Pass,
runTestM "insert + freeze + lookup" $ do
set <- cattrsetNew 4
kName <- symbolIntern "name"
kVer <- symbolIntern "version"
valName <- newStablePtr ("hello" :: Text)
valVer <- newStablePtr ("1.0" :: Text)
cattrsetInsert set kName (spToCPtr valName)
cattrsetInsert set kVer (spToCPtr valVer)
cattrsetFreeze set
result <- cattrsetLookup set kName
case result of
Nothing -> do
-- set freed by arenaDestroy via nn_attrset_free_all
freeStablePtr valName
freeStablePtr valVer
pure (Fail "lookup returned Nothing")
Just cptr -> do
val <- deRefStablePtr (cptrToSp cptr) :: IO Text
-- set freed by arenaDestroy via nn_attrset_free_all
freeStablePtr valName
freeStablePtr valVer
pure (assertEqual "lookup name" "hello" val),
runTestM "lookup missing key returns Nothing" $ do
set <- cattrsetNew 4
kFoo <- symbolIntern "foo"
kBar <- symbolIntern "bar"
sp <- newStablePtr ("x" :: Text)
cattrsetInsert set kFoo (spToCPtr sp)
cattrsetFreeze set
result <- cattrsetLookup set kBar
-- set freed by arenaDestroy via nn_attrset_free_all
freeStablePtr sp
pure (case result of Nothing -> Pass; Just _ -> Fail "expected Nothing"),
runTestM "size after freeze" $ do
set <- cattrsetNew 4
k1 <- symbolIntern "a"
k2 <- symbolIntern "b"
k3 <- symbolIntern "c"
sp <- newStablePtr (42 :: Int)
cattrsetInsert set k1 (spToCPtr sp)
cattrsetInsert set k2 (spToCPtr sp)
cattrsetInsert set k3 (spToCPtr sp)
cattrsetFreeze set
n <- cattrsetSize set
-- set freed by arenaDestroy via nn_attrset_free_all
freeStablePtr sp
pure (assertEqual "size" 3 n),
runTestM "duplicate keys: last writer wins" $ do
set <- cattrsetNew 4
kName <- symbolIntern "name"
sp1 <- newStablePtr ("first" :: Text)
sp2 <- newStablePtr ("second" :: Text)
cattrsetInsert set kName (spToCPtr sp1)
cattrsetInsert set kName (spToCPtr sp2)
cattrsetFreeze set
n <- cattrsetSize set
result <- cattrsetLookup set kName
val <- case result of
Nothing -> pure "MISSING"
Just cptr -> deRefStablePtr (cptrToSp cptr)
-- set freed by arenaDestroy via nn_attrset_free_all
freeStablePtr sp1
freeStablePtr sp2
pure
( if n == 1 && val == ("second" :: Text)
then Pass
else Fail ("size=" <> T.pack (show n) <> " val=" <> val)
),
runTestM "keys returned sorted" $ do
set <- cattrsetNew 8
-- Insert in reverse order; after freeze keys should be sorted by symbol ID
k1 <- symbolIntern "zzz"
k2 <- symbolIntern "aaa"
k3 <- symbolIntern "mmm"
sp <- newStablePtr (0 :: Int)
cattrsetInsert set k1 (spToCPtr sp)
cattrsetInsert set k2 (spToCPtr sp)
cattrsetInsert set k3 (spToCPtr sp)
cattrsetFreeze set
keys <- cattrsetKeys set
-- set freed by arenaDestroy via nn_attrset_free_all
freeStablePtr sp
-- Keys should be sorted by symbol ID (ascending)
let ids = map unSymbol keys
sorted = ids == foldl (\acc x -> acc ++ [x]) [] (Set.toAscList (Set.fromList ids))
pure (if sorted then Pass else Fail ("unsorted: " <> T.pack (show ids))),
runTestM "union right-biased" $ do
setA <- cattrsetNew 4
setB <- cattrsetNew 4
kX <- symbolIntern "x"
kY <- symbolIntern "y"
kZ <- symbolIntern "z"
spA <- newStablePtr ("fromA" :: Text)
spB <- newStablePtr ("fromB" :: Text)
spZ <- newStablePtr ("onlyA" :: Text)
cattrsetInsert setA kX (spToCPtr spA)
cattrsetInsert setA kZ (spToCPtr spZ)
cattrsetInsert setB kX (spToCPtr spB)
cattrsetInsert setB kY (spToCPtr spB)
cattrsetFreeze setA
cattrsetFreeze setB
merged <- cattrsetUnion setA setB
n <- cattrsetSize merged
resultX <- cattrsetLookup merged kX
valX <- case resultX of
Nothing -> pure "MISSING"
Just cptr -> deRefStablePtr (cptrToSp cptr)
-- sets freed by arenaDestroy via nn_attrset_free_all
freeStablePtr spA
freeStablePtr spB
freeStablePtr spZ
pure
( if n == 3 && valX == ("fromB" :: Text)
then Pass
else Fail ("size=" <> T.pack (show n) <> " x=" <> valX)
),
runTestM "stress: 10k entries" $ do
set <- cattrsetNew 1024
sp <- newStablePtr (0 :: Int)
syms <- mapM (\i -> symbolIntern ("key_" <> T.pack (show (i :: Int)))) [1 .. 10000]
mapM_ (\sym -> cattrsetInsert set sym (spToCPtr sp)) syms
cattrsetFreeze set
n <- cattrsetSize set
-- Spot-check a lookup from the middle of the key range
hit <- case drop 5000 syms of
middleSym : _ -> cattrsetLookup set middleSym
[] -> pure Nothing
-- set freed by arenaDestroy via nn_attrset_free_all
freeStablePtr sp
pure
( if n == 10000 && isJust hit
then Pass
else Fail ("size=" <> T.pack (show n))
),
-- Grown from the default capacity, so every doubling runs; the
-- index of an absent key is the C side's NN_ATTRSET_NOT_FOUND.
runTestM "index finds each key at its sorted position and none for an absent key" $ do
set <- cattrsetNew 0
sp <- newStablePtr (0 :: Int)
syms <- mapM (\i -> symbolIntern ("index_" <> T.pack (show (i :: Int)))) [1 .. 100]
mapM_ (\sym -> cattrsetInsert set sym (spToCPtr sp)) syms
cattrsetFreeze set
absent <- symbolIntern "index_absent"
found <- mapM (cattrsetIndex set) (sort syms)
missing <- cattrsetIndex set absent
freeStablePtr sp
pure
( if found == map Just [0 .. 99] && isNothing missing
then Pass
else Fail ("found=" <> T.pack (show found) <> " missing=" <> T.pack (show missing))
)
]
-- ---------------------------------------------------------------------------
-- C thunk arena (FFI)
-- ---------------------------------------------------------------------------
testCThunk :: IO [Bool]
testCThunk = do
putStrLn "cthunk"
-- Arena is already initialized by main's bracket.
-- Each test uses the shared arena (thunks accumulate - that's fine).
sequence
[ runTestM "new pending + state" $ do
sp <- newStablePtr ("pending" :: Text)
ptr <- cthunkNewBc 0 (castStablePtrToPtr sp)
state <- cthunkState ptr
pure (assertEqual "state" 0 state),
runTestM "new computed + state" $ do
sp <- newStablePtr ("computed" :: Text)
ptr <- cthunkNewComputed (castStablePtrToPtr sp)
state <- cthunkState ptr
pure (assertEqual "state" 1 state),
runTestM "payload round-trips (pending)" $ do
sp <- newStablePtr ("hello" :: Text)
ptr <- cthunkNewBc 0 (castStablePtrToPtr sp)
payload <- cthunkPayload ptr
val <- deRefStablePtr (castPtrToStablePtr payload) :: IO Text
pure (assertEqual "payload" "hello" val),
runTestM "payload round-trips (computed)" $ do
sp <- newStablePtr (42 :: Int)
ptr <- cthunkNewComputed (castStablePtrToPtr sp)
payload <- cthunkPayload ptr
val <- deRefStablePtr (castPtrToStablePtr payload) :: IO Int
pure (assertEqual "payload" 42 val),
runTestM "mark_blackhole succeeds on pending" $ do
sp <- newStablePtr ("x" :: Text)
ptr <- cthunkNewBc 0 (castStablePtrToPtr sp)
ok <- cthunkMarkBlackhole ptr
state <- cthunkState ptr
pure
( if ok && state == 2
then Pass
else Fail ("ok=" <> T.pack (show ok) <> " state=" <> T.pack (show state))
),
runTestM "mark_blackhole fails on computed" $ do
sp <- newStablePtr ("x" :: Text)
ptr <- cthunkNewComputed (castStablePtrToPtr sp)
ok <- cthunkMarkBlackhole ptr
pure (if not ok then Pass else Fail "should have failed"),
runTestM "mark_blackhole fails on blackhole" $ do
sp <- newStablePtr ("x" :: Text)
ptr <- cthunkNewBc 0 (castStablePtrToPtr sp)
_ <- cthunkMarkBlackhole ptr
ok <- cthunkMarkBlackhole ptr
pure (if not ok then Pass else Fail "should have failed"),
runTestM "set_computed stores into a blackhole" $ do
pendingSp <- newStablePtr ("old" :: Text)
ptr <- cthunkNewBc 0 (castStablePtrToPtr pendingSp)
_ <- cthunkMarkBlackhole ptr
computedSp <- newStablePtr ("new" :: Text)
stored <- cthunkSetComputed ptr (castStablePtrToPtr computedSp)
state <- cthunkState ptr
newPayload <- cthunkPayload ptr
newVal <- deRefStablePtr (castPtrToStablePtr newPayload) :: IO Text
freeStablePtr pendingSp
pure
( if stored && newVal == "new" && state == 1
then Pass
else Fail ("stored=" <> T.pack (show stored) <> " new=" <> newVal <> " state=" <> T.pack (show state))
),
-- set_computed accepts PENDING (direct memoization, no blackhole step)
runTestM "set_computed stores into a pending thunk" $ do
sp <- newStablePtr ("x" :: Text)
ptr <- cthunkNewBc 0 (castStablePtrToPtr sp)
valSp <- newStablePtr ("v" :: Text)
stored <- cthunkSetComputed ptr (castStablePtrToPtr valSp)
freeStablePtr sp
pure (if stored then Pass else Fail "refused a PENDING thunk"),
runTestM "set_computed refuses a computed thunk and keeps its value" $ do
firstSp <- newStablePtr ("first" :: Text)
ptr <- cthunkNewComputed (castStablePtrToPtr firstSp)
secondSp <- newStablePtr ("second" :: Text)
stored <- cthunkSetComputed ptr (castStablePtrToPtr secondSp)
payload <- cthunkPayload ptr
kept <- deRefStablePtr (castPtrToStablePtr payload) :: IO Text
freeStablePtr secondSp
pure
( if not stored && kept == "first"
then Pass
else Fail ("stored=" <> T.pack (show stored) <> " kept=" <> kept)
),
-- The shared cells are one static each for the whole process, so a
-- transition that ran on one would change every null or boolean.
runTestM "the shared null and boolean cells refuse every transition" $ do
let cells = [cthunkNull, cthunkBool True, cthunkBool False]
marked <- mapM cthunkMarkBlackhole cells
stored <- mapM (`cthunkSetComputed` nullPtr) cells
repointed <- mapM (`cthunkSetPayload` nullPtr) cells
let values = map (readThunkValue . Thunk) cells
expected = map Just [VNull, VBool True, VBool False]
pure
( if not (or (marked ++ stored ++ repointed)) && values == expected
then Pass
else Fail ("accepted=" <> T.pack (show (marked, stored, repointed)) <> " values=" <> T.pack (show values))
),
runTestM "count tracks allocations" $ do
countBefore <- cthunkCount
sp <- newStablePtr (0 :: Int)
_ <- cthunkNewBc 0 (castStablePtrToPtr sp)
_ <- cthunkNewBc 0 (castStablePtrToPtr sp)
_ <- cthunkNewComputed (castStablePtrToPtr sp)
countAfter <- cthunkCount
let delta = countAfter - countBefore
pure (assertEqual "delta" 3 delta),
runTestM "get retrieves by index" $ do
countBefore <- cthunkCount
sp <- newStablePtr ("indexed" :: Text)
ptr <- cthunkNewBc 0 (castStablePtrToPtr sp)
retrieved <- cthunkGet countBefore
stateOrig <- cthunkState ptr
stateRetrieved <- cthunkState retrieved
pure
( if ptr == retrieved && stateOrig == stateRetrieved
then Pass
else Fail "get returned wrong pointer"
),
runTestM "stress: 100k thunks" $ do
countBefore <- cthunkCount
sp <- newStablePtr (0 :: Int)
mapM_ (\_ -> cthunkNewBc 0 (castStablePtrToPtr sp)) [(1 :: Int) .. 100000]
countAfter <- cthunkCount
let delta = countAfter - countBefore
-- Spot-check: retrieve one from the middle
midPtr <- cthunkGet (countBefore + 50000)
midState <- cthunkState midPtr
pure
( if delta == 100000 && midState == 0
then Pass
else
Fail
( "delta="
<> T.pack (show delta)
<> " midState="
<> T.pack (show midState)
)
)
]
-- ---------------------------------------------------------------------------
-- Bytecode compilation tests
-- ---------------------------------------------------------------------------
-- ---------------------------------------------------------------------------
-- Tests: upstream conformance follow-ups (#50)
-- ---------------------------------------------------------------------------
-- | Error kind for 'StubStoreEval', mirroring PureEval's split: only a
-- throw/assert is tryEval-catchable.
data StubErr = StubThrow !Text | StubOther !Text
-- | Pure evaluator over a stubbed store: 'readStoreDerivation' serves
-- derivations from a fixed map (keyed by canonical @.drv@ path text);
-- everything else behaves like 'PureEval'. Exercises the
-- input-derivation-modulo STORE-READ arm hermetically - the real arm
-- reads the platform store, which dev machines and CI runners must not
-- depend on (the build matrix has no writable @/nix/store@).
newtype StubStoreEval a = StubStoreEval (StubEnv -> Either StubErr a)
-- | What the stubbed store answers from.
data StubEnv = StubEnv
{ -- | Derivations 'readStoreDerivation' serves, by canonical @.drv@ path.
seDrvs :: !(Map.Map Text Derivation),
-- | Recorded fetches 'lookupFetchCache' serves, by key.
seFetchCache :: !(Map.Map Text Text),
-- | Store paths 'adoptStorePath' accepts. Deliberately NOT the same
-- answer as 'doesPathExist', which is 'False' throughout: on disk and
-- registered are different facts, and a test where the two coincide
-- cannot tell which one the code under test asked about.
seAdoptable :: !(Set.Set Text)
}
-- | A stub store holding nothing but the given derivations.
stubEnv :: Map.Map Text Derivation -> StubEnv
stubEnv drvs = StubEnv {seDrvs = drvs, seFetchCache = Map.empty, seAdoptable = Set.empty}
runStubStoreEvalWith :: StubEnv -> StubStoreEval a -> Either Text a
runStubStoreEvalWith env (StubStoreEval action) = case action env of
Left (StubThrow msg) -> Left msg
Left (StubOther msg) -> Left msg
Right val -> Right val
instance Functor StubStoreEval where
fmap f (StubStoreEval g) = StubStoreEval (fmap f . g)
instance Applicative StubStoreEval where
pure val = StubStoreEval (const (Right val))
StubStoreEval mf <*> StubStoreEval ma = StubStoreEval $ \env -> mf env <*> ma env
instance Monad StubStoreEval where
StubStoreEval ma >>= f = StubStoreEval $ \env -> case ma env of
Left err -> Left err
Right val -> let StubStoreEval mb = f val in mb env
instance MonadEval StubStoreEval where
throwEvalError msg = StubStoreEval (const (Left (StubOther msg)))
throwCatchableError msg = StubStoreEval (const (Left (StubThrow msg)))
abortEvaluation msg = StubStoreEval (const (Left (StubOther ("evaluation aborted: " <> msg))))
catchEvalError (StubStoreEval action) = StubStoreEval $ \env -> case action env of
Left (StubThrow msg) -> Right (Left msg)
Left other -> Left other
Right val -> Right (Right val)
onEvalError (StubStoreEval action) _ = StubStoreEval action
addErrorTrace _ action = action
-- The stub keeps no call depth: it exists to answer store questions,
-- and the ceiling is tested on the evaluators that enforce it.
withCallFrame (StubStoreEval action) = StubStoreEval action
doesPathExist _ _ = pure False
listDirectory _ = throwEvalError "readDir: not available in the stub evaluator"
importFile _ = throwEvalError "import: not available in the stub evaluator"
getEnvVar _ = pure ""
getCurrentTime = pure 0
writeToStore _ _ _ = throwEvalError "toFile: not available in the stub evaluator"
scopedImportFile _ _ = throwEvalError "scopedImport: not available in the stub evaluator"
readFileBytes _ = throwEvalError "readFile: not available in the stub evaluator"
getFileType _ = throwEvalError "readFileType: not available in the stub evaluator"
runProcess _ _ _ = throwEvalError "runProcess: not available in the stub evaluator"
createScratchDir _ = throwEvalError "createScratchDir: not available in the stub evaluator"
removeScratchDir _ = pure ()
copyPathToStore _ _ _ = throwEvalError "builtins.path: not available in the stub evaluator"
narHashOfPath _ = throwEvalError "builtins.fetchGit: not available in the stub evaluator"
setExecutableFile _ = throwEvalError "builtins.fetchGit: not available in the stub evaluator"
lookupFetchCache key = StubStoreEval $ \env -> Right (Map.lookup key (seFetchCache env))
adoptStorePath path = StubStoreEval $ \env -> Right (Set.member path (seAdoptable env))
writeFetchCache _ _ = pure ()
isExecutableFile _ = throwEvalError "builtins.path: not available in the stub evaluator"
readSymlinkTarget _ = throwEvalError "builtins.path: not available in the stub evaluator"
resolveSymlinks = pure
addSourceNar _ _ = throwEvalError "builtins.path: not available in the stub evaluator"
addFixedOutputFile _ _ = throwEvalError "builtins.fetchurl: not available in the stub evaluator"
traceMessage _ = pure ()
lookupDrvHash _ = pure Nothing
cacheDrvHash _ _ = pure ()
recordDrvAterm _ _ = pure ()
readStoreDerivation sp =
StubStoreEval $ \env -> Right (Map.lookup (storePathToText defaultStoreDir sp) (seDrvs env))
lookupSessionDrv _ = pure Nothing
lookupSessionReferences _ = pure Nothing
storeSourcePath = pure
evalPolicy = pure unrestrictedPolicy
checkUri _ = pure ()
resolvePathLiteral = pure . canonPath
forceThunk evalFn thunk@(Thunk ptr) = case readThunkValue thunk of
Just val -> pure val
Nothing -> case unsafePerformIO (cthunkState ptr) of
2 {- BLACKHOLE -} -> abortEvaluation "infinite recursion encountered"
_ {- PENDING -} ->
let bcIdx = unsafePerformIO (cthunkGetBcIdx ptr)
envSp = unsafePerformIO (cthunkPayload ptr)
env = unsafePerformIO (deRefStablePtr (castPtrToStablePtr envSp))
in evalFn env bcIdx
-- | Parse and evaluate under the stubbed-store evaluator.
evalNixStub :: Map.Map Text Derivation -> Text -> Either Text NixValue
evalNixStub = evalNixStubWith . stubEnv
-- | 'evalNixStub' with the whole stub store spelled out.
evalNixStubWith :: StubEnv -> Text -> Either Text NixValue
evalNixStubWith env source = case parseNix testBaseDir "<test>" source of
Left err -> Left (T.pack (show err))
Right expr -> runStubStoreEvalWith env (eval (builtinEnv unrestrictedPolicy 0 []) expr)
-- | Upstream conformance follow-ups (#50): behaviors that landed
-- with #37 but had no direct test. Pure cases here; filesystem-touching
-- cases in 'testClassIFollowupsIO'.
testClassIFollowups :: IO [Bool]
testClassIFollowups = do
putStrLn "eval/class-i-followups"
let storeA = "/nix/store/" <> T.replicate 32 "a"
enclosingCtx = StringContext (Set.singleton (SCPlain (StorePath (T.replicate 32 "a") "x")))
sequence
[ -- path + path concatenates the spellings and canonicalizes
runTest "path + path canonicalizes the joined spelling" $
assertEval "pp-canon" "builtins.toString (/a/b + /c/../d)" (mkStr "/a/b/d"),
-- concatStringsSep coerces a path element; an in-store path takes
-- the short-circuit (itself + enclosing context, no store copy)
runTest "concatStringsSep coerces an in-store path element" $
assertEval
"csep-path"
("builtins.concatStringsSep \":\" [ " <> storeA <> "-x \"y\" ]")
(VStr (TE.encodeUtf8 (storeA <> "-x:y")) enclosingCtx),
runTest "substring and unsafeDiscardOutputDependency keep a coerced path's context" $
assertEval "substring-store-path" ("builtins.substring 0 10 " <> storeA <> "-x") (VStr "/nix/store" enclosingCtx)
`andThen` assertEval
"discard-output-store-path"
("builtins.unsafeDiscardOutputDependency " <> storeA <> "-x")
(VStr (TE.encodeUtf8 (storeA <> "-x")) enclosingCtx),
runTest "addDrvOutputDependencies judges a coerced path by its context" $
assertEvalError
"add-output-store-path"
("builtins.addDrvOutputDependencies " <> storeA <> "-x")
("builtins.addDrvOutputDependencies: path " <> storeA <> "-x is not a derivation"),
-- the same in-store short-circuit for general interpolation, on a
-- SUBPATH: the text is the subpath, the context the enclosing path
runTest "interpolating an in-store subpath keeps text, contexts the enclosing path" $
assertEval
"interp-substore"
("\"${" <> storeA <> "-x/sub}\"")
(VStr (TE.encodeUtf8 (storeA <> "-x/sub")) enclosingCtx),
-- storePath on a subpath: value text is the subpath itself
runTest "storePath on a subpath keeps text, contexts the enclosing path" $
assertEval
"storepath-sub"
("builtins.storePath " <> storeA <> "-x/sub/file")
(VStr (TE.encodeUtf8 (storeA <> "-x/sub/file")) enclosingCtx),
runTest "fromJSON falls to float past uint64" $
assertEval "fromjson-float" "builtins.fromJSON \"18446744073709551616\"" (VFloat 18446744073709551616.0),
-- the input-derivation-modulo STORE-READ arm: a dependent whose
-- input .drv was NOT evaluated in-session resolves by reading the
-- (stubbed) store, and lands on the same drvPath as the in-session
-- cache-hit arm computes for the identical derivation
runTestM "input modulo recurses through the store read (stub store)" $ do
let depSrc = "derivation { name = \"dep\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }"
tmpBase <- getTemporaryDirectory
depDrv <- evalDerivationIO tmpBase depSrc >>= either (fail . ("dep: " <>) . T.unpack) pure
depPath <- case evalNix ("(" <> depSrc <> ").drvPath") of
Right (VStr p _) -> pure (bytesText p)
other -> fail ("dep.drvPath: " <> show other)
let stubResult =
evalNixStub (Map.singleton depPath depDrv) $
T.concat
[ "(derivation { name = \"main\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; ",
"input = builtins.appendContext \"x\" { \"",
depPath,
"\" = { outputs = [\"out\"]; }; }; }).drvPath"
]
ioResult <-
evalNixIO tmpBase $
T.concat
[ "let dep = ",
depSrc,
"; in (derivation { name = \"main\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; ",
"input = builtins.appendContext \"x\" { \"${dep.drvPath}\" = { outputs = [\"out\"]; }; }; }).drvPath"
]
pure $ case (stubResult, ioResult) of
(Right (VStr a _), Right (VStr b _))
| a == b -> Pass
| otherwise ->
Fail ("store-read and in-session arms disagree: " <> bytesText a <> " vs " <> bytesText b)
other -> Fail ("expected two drvPaths, got: " <> T.pack (show other))
]
-- | Filesystem-touching conformance follow-ups (#50).
testClassIFollowupsIO :: IO [Bool]
testClassIFollowupsIO = do
putStrLn "eval/class-i-followups-io"
tmpDir <- getTemporaryDirectory
let testDir = tmpDir </> "nova-nix-classi-test"
testDirFwd = T.replace "\\" "/" (T.pack testDir)
bracket_
( do
createDirectoryIfMissing True (testDir </> "sub")
TIO.writeFile (testDir </> "target.txt") "hit\n"
TIO.writeFile (testDir </> "thefile") "payload\n"
-- Imported files for the two path-resolution tests below. Each is
-- a directory deeper than the expression that names it, so a
-- literal resolved against the wrong one is visibly wrong.
TIO.writeFile (testDir </> "sub" </> "useq.nix") "q\n"
TIO.writeFile (testDir </> "sub" </> "tilde.nix") "~/nova-tilde-probe\n"
)
( do
exists <- doesDirectoryExist testDir
when exists (removeDirectoryRecursive testDir)
)
$ sequence
[ -- ~/ expands against the home directory at path resolution
runTestM "tilde path literal expands against the home directory" $ do
home <- Dir.getHomeDirectory
result <- evalNixIO testDir "builtins.toString ~/nova-tilde-probe"
let expected = canonPathValue (T.pack (home </> "nova-tilde-probe"))
pure $ assertRight "tilde" result $ \val ->
assertEqual "tilde-expanded" (mkStr expected) val,
-- The same literal inside an imported file. Path resolution runs
-- over every parsed file now, and joining ~/x to the importing
-- directory would bury the tilde where nothing expands it.
runTestM "tilde path literal expands the same inside an imported file" $ do
home <- Dir.getHomeDirectory
result <- evalNixIO testDir "builtins.toString (import ./sub/tilde.nix)"
let expected = canonPathValue (T.pack (home </> "nova-tilde-probe"))
pure $ assertRight "tilde-import" result $ \val ->
assertEqual "tilde-expanded-in-import" (mkStr expected) val,
-- A path literal names a location relative to the file it is
-- written in. This one is written here and forced during the
-- evaluation of sub/useq.nix, where the base directory is sub/:
-- resolving on force rather than on parse gave sub/target.txt.
runTestM "a path literal resolves where it is written, not where it is forced" $ do
let expr = "builtins.toString (builtins.scopedImport { q = ./target.txt; } ./sub/useq.nix)"
result <- evalNixIO testDir expr
let expected = canonPathValue (T.pack (testDir </> "target.txt"))
pure $ assertRight "scoped-import-path" result $ \val ->
assertEqual "resolved-against-writing-file" (mkStr expected) val,
-- a search-path match is returned CANONICALIZED
runTestM "findFile canonicalizes the matched candidate" $ do
result <-
evalNixIO testDir $
T.concat
["builtins.findFile [ { prefix = \"\"; path = \"", testDirFwd, "/sub/..\"; } ] \"target.txt\""]
pure $ assertRight "findfile-canon" result $ \val ->
assertEqual "canonical" (VPath (testDirFwd <> "/target.txt")) val,
-- the store copy is named by canonBaseName (the path's last segment)
runTestM "source copy is named by canonBaseName" $ do
result <- evalNixIO testDir "\"${./thefile}\""
pure $ assertRight "canonbase" result $ \case
VStr s ctx ->
if "/nix/store/" `BS.isPrefixOf` s && "-thefile" `BS.isSuffixOf` s && ctx /= emptyContext
then Pass
else Fail ("expected a store path named -thefile with context, got " <> bytesText s)
other -> Fail ("expected VStr, got " <> T.pack (show other)),
-- canonBaseName's empty-name arm: the filesystem root has no
-- base name to copy under, refused before any read. POSIX only:
-- a root path literal on Windows names a drive.
if SI.os == "mingw32"
then True <$ putStrLn " SKIP coercing the filesystem root errors (no base name): the root is a drive"
else runTestM "coercing the filesystem root errors (no base name)" $ do
result <- evalNixIO testDir "\"${/.}\""
pure $ case result of
Left err | "no base name" `T.isInfixOf` err -> Pass
Left err -> Fail ("expected a base-name error, got: " <> err)
Right val -> Fail ("expected failure, got " <> T.pack (show val))
]
-- | Bytecode short_arg spill: op-level payload counts at or above the
-- 0xFFFF sentinel move to the first data word, so literals are no longer
-- capped at 65535 elements. The two exact-boundary list cases pin the
-- inline maximum (65534) and the first spilled count (65535); the rest
-- drive each counted-op kind (list, attrs, let, string parts, attr path)
-- well past the old ceiling.
-- ---------------------------------------------------------------------------
-- Bytecode shared across elements
-- ---------------------------------------------------------------------------
-- | A bytecode instruction as far as the reserved instructions use them: a
-- resolved variable (level, slot), a deferred application, or anything
-- else (opcode, flags).
data CodeShape
= SlotRef !Word32 !Word32
| DeferredApp !CodeShape !CodeShape
| OtherCode !Word8 !Word8
deriving (Eq, Show)
-- | Read the code at a bytecode index back as a 'CodeShape'.
codeShape :: Word32 -> IO CodeShape
codeShape idx = do
op <- cbcOpcode idx
flags <- cbcFlags idx
arg1 <- cbcArg1 idx
arg2 <- cbcArg2 idx
case op of
OpResolvedVar -> pure (SlotRef arg1 arg2)
OpApp | flags == appDeferred -> DeferredApp <$> codeShape arg1 <*> codeShape arg2
_ -> pure (OtherCode op flags)
-- | The instructions and data words evaluating a source adds to the
-- bytecode store, which only 'arenaDestroy' frees. The source must
-- evaluate to an integer computed from everything it builds, so each
-- element has been forced when the counts are read.
bytecodeGrowth :: Text -> IO (Either Text (Word32, Word32))
bytecodeGrowth source = do
opsBefore <- cbcOpCount
dataBefore <- cbcDataCount
forced <- case evalNix source of
Right (VInt n) -> Right <$> evaluate n
Right other -> pure (Left ("expected an integer, got " <> T.pack (show other)))
Left err -> pure (Left err)
opsAfter <- cbcOpCount
dataAfter <- cbcDataCount
pure ((opsAfter - opsBefore, dataAfter - dataBefore) <$ forced)
-- | A source builds one element or two hundred, and the bytecode it adds
-- is the same: the code each element runs is shared, never compiled per
-- element. A first run at one element is discarded, so anything compiled
-- once per process is not counted against either size.
assertNoPerElementBytecode :: (Text -> Text) -> IO TestResult
assertNoPerElementBytecode sourceFor = do
_ <- bytecodeGrowth (sourceFor "1")
one <- bytecodeGrowth (sourceFor "1")
many <- bytecodeGrowth (sourceFor "200")
pure $ case (one, many) of
(Right atOne, Right atMany) ->
assertEqual "instructions and data words added at 1 element and at 200" atOne atMany
(Left err, _) -> Fail err
(_, Left err) -> Fail err
testBytecodePerElement :: IO [Bool]
testBytecodePerElement = do
putStrLn "bytecode/per-element"
let summed body n = "builtins.foldl' (a: b: a + b) 0 (" <> body n <> ")"
indices n = "builtins.genList (i: i) " <> n
sequence
[ runTestM "reserved instructions are the deferred applications of the slots" $ do
apply1 <- codeShape reservedApply1
apply2 <- codeShape reservedApply2
apply2Function <- cbcArg1 reservedApply2
pure $
assertEqual "reservedApply1" (DeferredApp (SlotRef 0 0) (SlotRef 0 1)) apply1
`andThen` assertEqual "reservedApply2" (DeferredApp (DeferredApp (SlotRef 0 0) (SlotRef 0 1)) (SlotRef 0 2)) apply2
`andThen` assertEqual "reservedApply2's function" reservedApply1 apply2Function,
runTestM "map adds no bytecode per element" $
assertNoPerElementBytecode (summed (\n -> "builtins.map (x: x + 1) (" <> indices n <> ")")),
runTestM "genList adds no bytecode per element" $
assertNoPerElementBytecode (summed ("builtins.genList (i: i * 2) " <>)),
runTestM "concatMap adds no bytecode per element" $
assertNoPerElementBytecode (summed (\n -> "builtins.concatMap (x: [ x x ]) (" <> indices n <> ")")),
runTestM "mapAttrs adds no bytecode per attribute" $
assertNoPerElementBytecode
( summed
(\n -> "builtins.attrValues (builtins.mapAttrs (name: v: v + 1) (builtins.listToAttrs (builtins.genList (i: { name = toString i; value = i; }) " <> n <> ")))")
),
runTestM "zipAttrsWith adds no bytecode per attribute" $
assertNoPerElementBytecode
( summed
(\n -> "builtins.attrValues (builtins.zipAttrsWith (name: vs: builtins.length vs) (builtins.genList (i: { ${toString i} = i; }) " <> n <> "))")
),
runTestM "inherit (from) in an attr set adds no bytecode per evaluation" $
assertNoPerElementBytecode (summed ("builtins.genList (i: { inherit ({ v = i; }) v; }.v) " <>)),
runTestM "inherit (from) in a recursive attr set adds no bytecode per evaluation" $
assertNoPerElementBytecode (summed ("builtins.genList (i: rec { inherit ({ v = i; }) v; }.v) " <>)),
runTestM "inherit (from) in a let adds no bytecode per evaluation" $
assertNoPerElementBytecode (summed ("builtins.genList (i: let inherit ({ v = i; }) v; in v) " <>))
]
testBytecodeCountSpill :: IO [Bool]
testBytecodeCountSpill = do
putStrLn "bytecode/count-spill"
let listOf n = "builtins.length [ " <> T.unwords (replicate n "1") <> " ]"
bigAttrsBody = T.concat [T.pack ("a" <> show i <> " = " <> show i <> "; ") | i <- [0 :: Int .. 69999]]
sequence
[ runTest "list literal at the inline count maximum (65534)" $
assertEval "spill-list-inline-max" (listOf 65534) (VInt 65534),
runTest "list literal at the first spilled count (65535)" $
assertEval "spill-list-first-spill" (listOf 65535) (VInt 65535),
runTest "spilled list preserves element order" $
assertEval
"spill-list-order"
("builtins.elemAt [ " <> T.unwords (map (T.pack . show) [0 :: Int .. 69999]) <> " ] 69999")
(VInt 69999),
runTest "spilled attrset literal binds every attribute" $
assertEval
"spill-attrs-count"
("builtins.length (builtins.attrNames { " <> bigAttrsBody <> "})")
(VInt 70000),
runTest "spilled attrset lookup reads the right value" $
assertEval
"spill-attrs-lookup"
("{ " <> bigAttrsBody <> "}.a69999")
(VInt 69999),
runTest "spilled let binds every name" $
assertEval
"spill-let"
("let " <> T.concat [T.pack ("v" <> show i <> " = " <> show i <> "; ") | i <- [0 :: Int .. 69999]] <> "in v69999")
(VInt 69999),
runTest "spilled interpolated string keeps every part" $
assertEval
"spill-string-parts"
("builtins.stringLength \"" <> T.concat (replicate 70000 "${\"x\"}") <> "\"")
(VInt 70000),
runTest "spilled attr path walks (set ? long.path)" $
assertEval
"spill-attrpath"
("{ } ? " <> T.intercalate "." (map (\i -> T.pack ("p" <> show i)) [0 :: Int .. 69999]))
(VBool False)
]
-- | C value structs carry element counts as a full uint32; a narrower
-- count would wrap at 65536 and size the C array smaller than the fill
-- loop that follows it. Both cases marshal counts past that boundary
-- and force the value twice - the first force writes the C struct (the
-- marshal side), the second reads it back off the computed thunk cell
-- (the unmarshal side).
testValueCountWidths :: IO [Bool]
testValueCountWidths = do
putStrLn "value/count-widths"
let formalsBody = T.intercalate ", " [T.pack ("a" <> show i) | i <- [0 :: Int .. 69999]]
sequence
[ runTest "lambda with 70000 formals round-trips through the C closure" $
assertEval
"width-lambda-formals"
( "let f = { "
<> formalsBody
<> " }: 1; in builtins.seq (builtins.functionArgs f) (builtins.length (builtins.attrNames (builtins.functionArgs f)))"
)
(VInt 70000),
runTest "string context with 70000 elements round-trips through the C thunk" $
assertEval
"width-ctxstr-elems"
( "let s = builtins.appendContext \"x\" (builtins.listToAttrs (builtins.genList (i: { "
<> "name = \"/nix/store/00000000000000000000000000000000-p\" + builtins.toString i; "
<> "value = { path = true; }; }) 70000)); "
<> "in builtins.seq s (builtins.length (builtins.attrNames (builtins.getContext s)))"
)
(VInt 70000)
]
-- ---------------------------------------------------------------------------
-- Tests: store-path name validation at write sinks (#39)
-- ---------------------------------------------------------------------------
-- | Name validation at write sinks (#39): the store-path name rules hold
-- at path CONSTRUCTION, not only at parse. Derivation names, output names, and
-- fetchurl basenames reject exactly what the parse boundary rejects,
-- before any write path is built from them - and names the old ad hoc
-- sink checks over-rejected (an interior @..@) are valid again.
testStoreNameSinks :: IO [Bool]
testStoreNameSinks = do
putStrLn "store/name-sinks"
let drvWith nameLit =
"(derivation { name = " <> nameLit <> "; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }).drvPath"
drvOutPath nameLit =
"(derivation { name = " <> nameLit <> "; system = \"x86_64-linux\"; builder = \"/bin/sh\"; }).outPath"
drvWithOutputs outsLit =
"(derivation { name = \"p\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; outputs = " <> outsLit <> "; }).drvPath"
failsWith label source needle = case evalNix source of
Left err
| parseErrorTag `T.isPrefixOf` err -> Fail (label <> ": did not parse: " <> err)
| needle `T.isInfixOf` err -> Pass
| otherwise -> Fail (label <> ": wrong error: " <> err)
Right val -> Fail (label <> ": expected an eval error, got " <> T.pack (show val))
succeedsWithSuffix label source suffix = case evalNix source of
Left err -> Fail (label <> ": unexpected error: " <> err)
Right (VStr s _) ->
if TE.encodeUtf8 suffix `BS.isSuffixOf` s
then Pass
else Fail (label <> ": expected suffix " <> suffix <> ", got " <> bytesText s)
Right other -> Fail (label <> ": expected VStr, got " <> T.pack (show other))
sequence
[ runTest "derivation name with a space is rejected" $
failsWith "name-space" (drvWith "\"a b\"") "invalid derivation name",
runTest "derivation name with a slash is rejected" $
failsWith "name-slash" (drvWith "\"a/b\"") "invalid derivation name",
runTest "derivation name with a backslash is rejected" $
failsWith "name-backslash" (drvWith "\"a\\\\b\"") "invalid derivation name",
runTest "derivation name with a drive colon is rejected" $
failsWith "name-colon" (drvWith "\"C:x\"") "invalid derivation name",
runTest "empty derivation name is rejected" $
failsWith "name-empty" (drvWith "\"\"") "name must not be empty",
runTest "212-character derivation name is rejected" $
failsWith "name-long" (drvWith ("\"" <> T.replicate 212 "a" <> "\"")) "must be no longer than 211 characters",
runTest "derivation name '..' is rejected" $
failsWith "name-dotdot" (drvWith "\"..\"") "name '..' is not valid",
runTest "derivation name '.-x' is rejected" $
failsWith "name-dotdash" (drvWith "\".-x\"") "dash-separated component",
runTest "dotfile derivation name stays valid" $
succeedsWithSuffix "name-dotfile" (drvWith "\".foo-1.0\"") "-.foo-1.0.drv",
runTest "interior '..' in a derivation name stays valid" $
succeedsWithSuffix "name-interior-dots" (drvOutPath "\"x..y\"") "-x..y",
runTest "derivation output name with a traversal is rejected" $
failsWith "out-traversal" (drvWithOutputs "[ \"out\" \"../x\" ]") "invalid derivation output name",
runTest "derivation output name with a colon is rejected" $
failsWith "out-colon" (drvWithOutputs "[ \"a:b\" ]") "invalid derivation output name",
-- Upstream's derivationStrict refuses these in its outputs loop: the
-- result set already has a drvPath attribute, and a repeat would
-- collide there too.
runTest "derivation output named drvPath is rejected" $
failsWith "out-drvpath" (drvWithOutputs "[ \"drvPath\" ]") "invalid derivation output name 'drvPath'",
runTest "repeated derivation output name is rejected" $
failsWith "out-duplicate" (drvWithOutputs "[ \"out\" \"out\" ]") "duplicate derivation output 'out'",
-- The wrapper never calls derivationStrict with an empty list (its
-- builtins.head fails on the empty outputsList first), so the primop
-- is called directly.
runTest "empty derivation output list is rejected" $
failsWith
"out-empty"
"derivationStrict { name = \"p\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; outputs = [ ]; }"
"derivation cannot have an empty set of outputs",
-- Both fields clean on their own, only the COMPOSED drvName-output
-- crosses the length cap: the construction-side check catches what
-- the field-level checks cannot.
runTest "composed name-output past the length cap is rejected" $
failsWith
"composed-long"
( "(derivation { name = \""
<> T.replicate 208 "a"
<> "\"; system = \"x86_64-linux\"; builder = \"/bin/sh\"; outputs = [ \"dev\" ]; }).drvPath"
)
"invalid store path name",
-- fetchurl derives the store name from the URL alone, so a bad
-- basename fails BEFORE the download: under PureEval a reachable
-- download would surface as "runProcess: not available" instead.
runTest "fetchurl rejects a backslash basename before fetching" $
failsWith "fetchurl-backslash" "builtins.fetchurl \"http://e/a\\\\b\"" "invalid store path name",
runTest "fetchurl rejects a dot-segment basename before fetching" $
failsWith "fetchurl-dotdot" "builtins.fetchurl \"http://e/..\"" "invalid store path name"
]
-- | Which entry names and link targets each host's rules admit
-- ("Nix.Store.EntryName"). The decision is pure, so every host's answer
-- is checked on any host: the grammar's refusals hold everywhere, POSIX
-- holds every other name as bytes, macOS needs UTF-8 without a
-- noncharacter, and Windows refuses what Win32 reserves or rewrites.
testNarNameSafety :: IO [Bool]
testNarNameSafety = do
putStrLn "store/entry-name-rules"
let admitted rules names = [(name, admits rules name) | name <- names]
admits rules name = either (const False) (const True) (checkEntryName rules name)
allAdmit rules names = assertEqual (T.pack (show rules) <> " verdicts") [(name, True) | name <- names] (admitted rules names)
allRefuse rules names = assertEqual (T.pack (show rules) <> " verdicts") [(name, False) | name <- names] (admitted rules names)
everyHost = [PosixNames, DarwinNames, WindowsNames]
grammarRefused = ["", ".", "..", "a/b", "/", "a\NULb"]
posixOnlyNames = [name | (name, _) <- posixOnlyEntries]
notUtf8 = ["caf\xE9", "\xFF", "\xC0\xAF", "\xED\xA0\x80", "\xF4\x90\x80\x80"]
noncharacters = ["n\xEF\xB7\x90", "n\xEF\xB7\xAF", "n\xEF\xBF\xBE", "n\xEF\xBF\xBF", "n\xF0\x9F\xBF\xBE", "n\xF4\x8F\xBF\xBF"]
sequence
[ runTest "the grammar's refusals hold on every host" $
foldr (keepFirstFail . (`allRefuse` grammarRefused)) Pass everyHost,
runTest "POSIX holds every other name as its bytes" $
allAdmit PosixNames (posixOnlyNames <> notUtf8 <> noncharacters <> ["caf\xC3\xA9", "a\x7F"]),
runTest "macOS holds a name upstream restores there" $
allAdmit DarwinNames (posixOnlyNames <> ["caf\xC3\xA9", "n\xEE\x80\x80", "n\xEF\xBF\xBD", "n\xEF\xBB\xBF"]),
runTest "macOS refuses a name that is not UTF-8 or holds a noncharacter" $
allRefuse DarwinNames (notUtf8 <> noncharacters),
runTest "Windows refuses device names, trailing dots and spaces, and reserved characters" $
allRefuse
WindowsNames
( filter (not . BS.isPrefixOf "link-") posixOnlyNames
<> ["nul.txt", "Nul .txt", "COM0.log", "com3", "lpt9", "COM\xC2\xB2", "COM\xC2\xB3", "C:evil", "a*b", "a?b", "a<b", "a>b", "a|b", "ctl\x1F"]
),
runTest "Windows refuses a name with no UTF-16 form" $
allRefuse WindowsNames notUtf8,
runTest "Windows holds ordinary and near-miss names" $
allAdmit
WindowsNames
["a", ".hidden", "a.b", "a b", " a", "com10", "COM", "NULx", "xNUL.txt", "caf\xC3\xA9", "LPT\xE2\x81\xB9", "a~b", "a\x7F", "n\xEF\xBF\xBE"],
runTest "a refusal names the entry and the reason" $
assertEqual
"refusals"
[ Left "NAR directory entry name 'aux.c' is a Windows device name",
Left "NAR directory entry name 'x.' ends in a dot or a space, which Windows strips",
Left "NAR directory entry name 'a:b' holds a character Windows does not allow in a name",
Left "NAR directory entry name \"caf\\233\" is not valid UTF-8, which a macOS filesystem cannot hold",
Left "unsafe NAR directory entry name: \"a/b\""
]
[ checkEntryName WindowsNames "aux.c",
checkEntryName WindowsNames "x.",
checkEntryName WindowsNames "a:b",
checkEntryName DarwinNames "caf\xE9",
checkEntryName PosixNames "a/b"
],
runTest "a link target is bytes on POSIX and macOS and UTF-16 on Windows" $
assertEqual
"target verdicts"
[Right (), Right (), Left "NAR symlink target \"caf\\233\" is not valid UTF-8, so it has no UTF-16 form for Windows", Right ()]
[ checkLinkTarget PosixNames "caf\xE9",
checkLinkTarget DarwinNames "caf\xE9",
checkLinkTarget WindowsNames "caf\xE9",
checkLinkTarget WindowsNames "../a b/c:d"
],
-- The Windows rules check a name's bytes, where the check they
-- replace read it as text; on every name both could judge (UTF-8
-- without a character the old check let through and Windows
-- refuses at the create) they must agree.
runTestM "the Windows rules refuse what the text check they replace refused" $ do
result <-
QC.quickCheckWithResult QC.stdArgs {QC.chatty = False, QC.maxSuccess = 5000} $
QC.forAll genDeviceLikeName $ \name ->
either (const False) (const True) (checkEntryName WindowsNames (TE.encodeUtf8 name))
QC.=== legacyTextNameSafety name
pure (if QC.isSuccess result then Pass else Fail (T.pack (QC.output result)))
]
where
keepFirstFail Pass acc = acc
keepFirstFail failure _ = failure
-- | The text-form name check the Windows rules replaced, kept verbatim as
-- the oracle their byte-form port is tested against.
legacyTextNameSafety :: Text -> Bool
legacyTextNameSafety name =
not (T.null name)
&& name /= ".."
&& name /= "."
&& not (T.any escapesTree name)
&& not (trailingRewritten name)
&& not (reservedDeviceStem name)
where
escapesTree c = c == '/' || c == '\\' || c == ':' || c == '\0'
trailingRewritten n = case T.unsnoc n of
Just (_, end) -> end == '.' || end == ' '
Nothing -> False
reservedDeviceStem n =
let stem = T.toUpper (T.dropWhileEnd (== ' ') (T.takeWhile (/= '.') n))
in stem == "CON"
|| stem == "PRN"
|| stem == "AUX"
|| stem == "NUL"
|| numberedDeviceStem stem
numberedDeviceStem stem = case T.unpack stem of
[a, b, c, digit] -> ([a, b, c] == "COM" || [a, b, c] == "LPT") && deviceDigit digit
_ -> False
deviceDigit c = isDigit c || c == '\185' || c == '\178' || c == '\179'
-- | Names shaped like a Windows device: a stem in mixed case or a near
-- miss, then a digit (plain, superscript, or a superscript nine that is
-- not a device digit), spaces, and nothing, an extension, or more
-- pieces, among them separators, dots and letters whose uppercase is
-- longer than themselves. About one name in twenty is refused by the
-- device rule alone.
genDeviceLikeName :: QC.Gen Text
genDeviceLikeName = do
stem <- QC.elements ["con", "CON", "Prn", "aux", "AUX", "nul", "NuL", "com", "COM", "lpt", "LpT", "x", "\305", "\329"]
digit <- QC.elements ["", "0", "1", "9", "10", "\185", "\178", "\179", "\8313", "\233"]
spaces <- QC.elements ["", " ", " "]
rest <- QC.frequency [(3, pure ""), (3, ("." <>) <$> pieces), (2, pieces)]
pure (stem <> digit <> spaces <> rest)
where
pieces =
T.concat
<$> QC.resize 4 (QC.listOf (QC.elements [".", "..", " ", "x", "txt", "\233", "\223", "\64256", ":", "\\", "/", "\NUL", "con", "1"]))
-- | Entry names upstream's restore writes on POSIX as it finds them and
-- Windows cannot hold, each as compared against @nix-store --restore@
-- 2.33.2: device stems (one with a superscript digit), trailing dots and
-- spaces, colons (perl's man pages carry them), a backslash, the
-- punctuation Win32 reserves, a control character, and links pointing
-- at such names.
posixOnlyEntries :: [(BS.ByteString, NAR.NarEntry)]
posixOnlyEntries =
[ ("COM1", NAR.NarRegular False "com1"),
("ExtUtils::MakeMaker.3", NAR.NarRegular False "man"),
("LPT\xC2\xB9.txt", NAR.NarRegular False "lpt"),
("NUL", NAR.NarRegular False "nul"),
("a:b", NAR.NarRegular False "colon"),
("a\\b", NAR.NarRegular False "backslash"),
("aux.c", NAR.NarRegular False "aux"),
("con.h", NAR.NarRegular False "con"),
("ctl\x01", NAR.NarRegular False "control"),
("dir.", NAR.NarDirectory [("prn", NAR.NarRegular True "prn")]),
("link-aux", NAR.NarSymlink "aux.c"),
("link-colon", NAR.NarSymlink "a:b"),
("link-dot", NAR.NarSymlink "x."),
("q\"*?<>|", NAR.NarRegular False "reserved"),
("x.", NAR.NarRegular False "dot"),
("y ", NAR.NarRegular False "space")
]
-- | 'posixOnlyEntries' as one directory.
posixOnlyTree :: NAR.NarEntry
posixOnlyTree = NAR.NarDirectory posixOnlyEntries
-- | IO-evaluator write sinks reject an invalid name BEFORE any write:
-- every case here errors out against a scratch dir with no store traffic.
testStoreNameSinksIO :: IO [Bool]
testStoreNameSinksIO = do
putStrLn "store/name-sinks-io"
tmpBase <- getTemporaryDirectory
let testDir = tmpBase </> "nova-nix-test-name-sinks"
needleTest label source needle = do
result <- evalNixIO testDir source
runTest label $ case result of
Left err
| needle `T.isInfixOf` err -> Pass
| otherwise -> Fail (label <> ": wrong error: " <> err)
Right val -> Fail (label <> ": expected an eval error, got " <> T.pack (show val))
bracket_
( do
createDirectoryIfMissing True (testDir </> "tree")
TIO.writeFile (testDir </> "tree" </> "f.txt") "payload\n"
)
( do
exists <- doesDirectoryExist testDir
when exists (removeDirectoryRecursive testDir)
)
$ sequence
[ needleTest "toFile rejects a stream-colon name" "builtins.toFile \"a:b\" \"x\"" "invalid store path name",
needleTest "toFile rejects a dot-segment name" "builtins.toFile \"..\" \"x\"" "invalid store path name",
needleTest
"path rejects a traversal name override"
"builtins.path { path = ./tree; name = \"../../evil\"; }"
"invalid store path name",
needleTest
"path with a filter rejects a drive-prefixed name"
"builtins.path { path = ./tree; name = \"C:evil\"; filter = (_: _: true); }"
"invalid store path name",
needleTest
"source coercion rejects a basename outside the name rules"
"\"${./. + \"/sp ace\"}\""
"invalid store path name"
]
-- | An inherited name and whether its select reads that name, as the one
-- path segment, from slot 0 of the env it runs in.
inheritedSelect :: BcInheritedName -> IO (Text, Bool)
inheritedSelect (BcInheritedName sym selectIdx) = do
op <- cbcOpcode selectIdx
pathLen <- cbcShortArg selectIdx
target <- cbcArg1 selectIdx
pathOff <- cbcArg2 selectIdx
targetOp <- cbcOpcode target
level <- cbcArg1 target
slot <- cbcArg2 target
keyTag <- cbcData pathOff
keySym <- cbcData (pathOff + 1)
pure
( symbolText (Symbol sym),
op == OpSelect && pathLen == 1 && targetOp == OpResolvedVar && level == 0 && slot == 0 && keyTag == attrkeyStatic && keySym == sym
)
testBytecodeCompile :: IO [Bool]
testBytecodeCompile = do
putStrLn "bytecode"
-- Arena (including bytecode store) already initialized by main's bracket.
sequence
[ runTestM "compile ELit NixInt" $ do
idx <- compileExpr (ELit (NixInt 42))
op <- cbcOpcode idx
a1 <- cbcArg1 idx
a2 <- cbcArg2 idx
pure
( if op == OpLitInt && a1 == 42 && a2 == 0
then Pass
else Fail ("op=" <> T.pack (show op) <> " a1=" <> T.pack (show a1))
),
runTestM "compile ELit NixInt negative" $ do
idx <- compileExpr (ELit (NixInt (-1)))
op <- cbcOpcode idx
a1 <- cbcArg1 idx
a2 <- cbcArg2 idx
-- -1 as uint64 = 0xFFFFFFFFFFFFFFFF, lo=0xFFFFFFFF, hi=0xFFFFFFFF
pure
( if op == OpLitInt && a1 == 0xFFFFFFFF && a2 == 0xFFFFFFFF
then Pass
else
Fail
( "a1="
<> T.pack (show a1)
<> " a2="
<> T.pack (show a2)
)
),
runTestM "compile ELit NixBool" $ do
idxT <- compileExpr (ELit (NixBool True))
idxF <- compileExpr (ELit (NixBool False))
opT <- cbcOpcode idxT
opF <- cbcOpcode idxF
saT <- cbcShortArg idxT
saF <- cbcShortArg idxF
pure
( if opT == OpLitBool && saT == 1 && opF == OpLitBool && saF == 0
then Pass
else Fail "bool encoding mismatch"
),
runTestM "compile ELit NixNull" $ do
idx <- compileExpr (ELit NixNull)
op <- cbcOpcode idx
pure (assertEqual "opcode" OpLitNull op),
runTestM "compile EResolvedVar" $ do
idx <- compileExpr (EResolvedVar 3 7)
op <- cbcOpcode idx
a1 <- cbcArg1 idx
a2 <- cbcArg2 idx
pure
( if op == OpResolvedVar && a1 == 3 && a2 == 7
then Pass
else
Fail
( "op="
<> T.pack (show op)
<> " a1="
<> T.pack (show a1)
<> " a2="
<> T.pack (show a2)
)
),
runTestM "compile EVar" $ do
idx <- compileExpr (EVar "hello")
op <- cbcOpcode idx
sym <- cbcArg1 idx
let symText = symbolText (Symbol sym)
pure
( if op == OpVar && symText == "hello"
then Pass
else Fail ("op=" <> T.pack (show op) <> " sym=" <> symText)
),
runTestM "compile EApp" $ do
idx <- compileExpr (EApp (EVar "f") (ELit (NixInt 1)))
op <- cbcOpcode idx
funcIdx <- cbcArg1 idx
argIdx <- cbcArg2 idx
funcOp <- cbcOpcode funcIdx
argOp <- cbcOpcode argIdx
pure
( if op == OpApp && funcOp == OpVar && argOp == OpLitInt
then Pass
else
Fail
( "op="
<> T.pack (show op)
<> " funcOp="
<> T.pack (show funcOp)
<> " argOp="
<> T.pack (show argOp)
)
),
runTestM "compile EIf" $ do
idx <-
compileExpr
(EIf (ELit (NixBool True)) (ELit (NixInt 1)) (ELit (NixInt 2)))
op <- cbcOpcode idx
condIdx <- cbcArg1 idx
thenIdx <- cbcArg2 idx
elseIdx <- cbcArg3 idx
condOp <- cbcOpcode condIdx
thenA1 <- cbcArg1 thenIdx
elseA1 <- cbcArg1 elseIdx
pure
( if op == OpIf && condOp == OpLitBool && thenA1 == 1 && elseA1 == 2
then Pass
else Fail "if structure mismatch"
),
runTestM "compile EBinary" $ do
idx <-
compileExpr
(EBinary OpAdd (ELit (NixInt 10)) (ELit (NixInt 20)))
op <- cbcOpcode idx
fl <- cbcFlags idx
leftIdx <- cbcArg1 idx
rightIdx <- cbcArg2 idx
leftA1 <- cbcArg1 leftIdx
rightA1 <- cbcArg1 rightIdx
pure
( if op == OpBinary && fl == binaryAdd && leftA1 == 10 && rightA1 == 20
then Pass
else Fail "binary structure mismatch"
),
runTestM "compile EUnary" $ do
idx <- compileExpr (EUnary OpNegate (ELit (NixInt 5)))
op <- cbcOpcode idx
fl <- cbcFlags idx
operandIdx <- cbcArg1 idx
operandA1 <- cbcArg1 operandIdx
pure
( if op == OpUnary && fl == unaryNegate && operandA1 == 5
then Pass
else Fail "unary structure mismatch"
),
runTestM "compile EList" $ do
idx <-
compileExpr
(EList [ELit (NixInt 1), ELit (NixInt 2), ELit (NixInt 3)])
op <- cbcOpcode idx
count <- cbcShortArg idx
dataOff <- cbcArg1 idx
c0 <- cbcData dataOff
c1 <- cbcData (dataOff + 1)
c2 <- cbcData (dataOff + 2)
c0a1 <- cbcArg1 c0
c1a1 <- cbcArg1 c1
c2a1 <- cbcArg1 c2
pure
( if op == OpList && count == 3 && c0a1 == 1 && c1a1 == 2 && c2a1 == 3
then Pass
else
Fail
( "op="
<> T.pack (show op)
<> " count="
<> T.pack (show count)
)
),
runTestM "compile EStr with interpolation" $ do
idx <-
compileExpr
(EStr [StrLit "hello ", StrInterp (EVar "name"), StrLit "!"])
op <- cbcOpcode idx
count <- cbcShortArg idx
dataOff <- cbcArg1 idx
-- 3 parts x 2 words each = 6 data words
tag0 <- cbcData dataOff
_val0 <- cbcData (dataOff + 1)
tag1 <- cbcData (dataOff + 2)
val1 <- cbcData (dataOff + 3)
tag2 <- cbcData (dataOff + 4)
-- tag0=0(lit), tag1=1(interp), tag2=0(lit)
interpOp <- cbcOpcode val1
pure
( if op == OpStr
&& count == 3
&& tag0 == strpartLit
&& tag1 == strpartInterp
&& tag2 == strpartLit
&& interpOp == OpVar
then Pass
else
Fail
( "op="
<> T.pack (show op)
<> " count="
<> T.pack (show count)
<> " tag0="
<> T.pack (show tag0)
<> " tag1="
<> T.pack (show tag1)
)
),
runTestM "compile EWith" $ do
idx <- compileExpr (EWith (EVar "lib") (EVar "x"))
op <- cbcOpcode idx
scopeIdx <- cbcArg1 idx
bodyIdx <- cbcArg2 idx
scopeOp <- cbcOpcode scopeIdx
bodyOp <- cbcOpcode bodyIdx
pure
( if op == OpWith && scopeOp == OpVar && bodyOp == OpVar
then Pass
else Fail "with structure mismatch"
),
runTestM "compile EAssert" $ do
idx <- compileExpr (EAssert (ELit (NixBool True)) (ELit (NixInt 1)))
op <- cbcOpcode idx
condIdx <- cbcArg1 idx
bodyIdx <- cbcArg2 idx
condOp <- cbcOpcode condIdx
bodyOp <- cbcOpcode bodyIdx
pure
( if op == OpAssert && condOp == OpLitBool && bodyOp == OpLitInt
then Pass
else Fail "assert structure mismatch"
),
runTestM "compile ELambda (FormalName)" $ do
idx <-
compileExpr
(ELambda (FormalName "x") (EResolvedVar 0 0) NoCaptureInfo)
op <- cbcOpcode idx
fl <- cbcFlags idx
bodyIdx <- cbcArg2 idx
bodyOp <- cbcOpcode bodyIdx
pure
( if op == OpLambda && fl == formalName && bodyOp == OpResolvedVar
then Pass
else
Fail
( "op="
<> T.pack (show op)
<> " flags="
<> T.pack (show fl)
)
),
runTestM "compile ELet" $ do
idx <-
compileExpr
( ELet
[NamedBinding (StaticKey "x") (ELit (NixInt 42))]
(EResolvedVar 0 0)
NoCaptureInfo
)
op <- cbcOpcode idx
count <- cbcShortArg idx
bodyIdx <- cbcArg2 idx
bodyOp <- cbcOpcode bodyIdx
pure
( if op == OpLet && count == 1 && bodyOp == OpResolvedVar
then Pass
else
Fail
( "op="
<> T.pack (show op)
<> " count="
<> T.pack (show count)
)
),
runTestM "compile EAttrs" $ do
idx <-
compileExpr
( EAttrs
False
[NamedBinding (StaticKey "a") (ELit (NixInt 1))]
NoCaptureInfo
)
op <- cbcOpcode idx
fl <- cbcFlags idx
count <- cbcShortArg idx
pure
( if op == OpAttrs && fl == 0 && count == 1
then Pass
else Fail "attrs structure mismatch"
),
runTestM "compile EAttrs recursive" $ do
idx <-
compileExpr
( EAttrs
True
[ NamedBinding (StaticKey "x") (ELit (NixInt 1)),
NamedBinding (StaticKey "y") (EResolvedVar 0 0)
]
(Captures [(0, 0)])
)
op <- cbcOpcode idx
fl <- cbcFlags idx
count <- cbcShortArg idx
pure
( if op == OpAttrs && fl == 1 && count == 2
then Pass
else
Fail
( "flags="
<> T.pack (show fl)
<> " count="
<> T.pack (show count)
)
),
runTestM "compile ESelect" $ do
idx <-
compileExpr
(ESelect (EVar "x") [StaticKey "a"] Nothing)
op <- cbcOpcode idx
fl <- cbcFlags idx
pure
( if op == OpSelect && fl == 0
then Pass
else Fail ("flags=" <> T.pack (show fl))
),
runTestM "compile ESelect with default" $ do
idx <-
compileExpr
(ESelect (EVar "x") [StaticKey "a"] (Just (ELit NixNull)))
op <- cbcOpcode idx
fl <- cbcFlags idx
defIdx <- cbcArg3 idx
defOp <- cbcOpcode defIdx
pure
( if op == OpSelect && fl == 1 && defOp == OpLitNull
then Pass
else Fail ("flags=" <> T.pack (show fl))
),
runTestM "compile EHasAttr" $ do
idx <-
compileExpr
(EHasAttr (EVar "x") [StaticKey "a", StaticKey "b"])
op <- cbcOpcode idx
pathLen <- cbcShortArg idx
pure
( if op == OpHasAttr && pathLen == 2
then Pass
else
Fail
( "op="
<> T.pack (show op)
<> " pathLen="
<> T.pack (show pathLen)
)
),
-- ESearchPath is desugared by resolver to __findFile __nixPath "name",
-- so the compiler sees an EApp chain, not a raw ESearchPath.
runTestM "compile desugared search path" $ do
idx <- compileExpr (EApp (EApp (EVar "__findFile") (EVar "__nixPath")) (EStr [StrLit "nixpkgs"]))
op <- cbcOpcode idx
pure
( if op == OpApp
then Pass
else Fail ("expected OpApp, got op=" <> T.pack (show op))
),
runTestM "op_count grows after compilation" $ do
before <- cbcOpCount
_ <- compileExpr (EApp (EVar "f") (ELit (NixInt 1)))
after <- cbcOpCount
pure
( if after > before
then Pass
else
Fail
( "before="
<> T.pack (show before)
<> " after="
<> T.pack (show after)
)
),
runTestM "compile ELit NixFloat" $ do
idx <- compileExpr (ELit (NixFloat 3.14))
op <- cbcOpcode idx
pure (assertEqual "opcode" OpLitFloat op),
runTestM "compile ELit NixUri" $ do
idx <- compileExpr (ELit (NixUri "https://example.com"))
op <- cbcOpcode idx
sym <- cbcArg1 idx
pure
( if op == OpLitUri && symbolText (Symbol sym) == "https://example.com"
then Pass
else Fail "uri mismatch"
),
runTestM "compile ELit NixPath" $ do
idx <- compileExpr (ELit (NixPath "/nix/store/foo"))
op <- cbcOpcode idx
sym <- cbcArg1 idx
pure
( if op == OpLitPath && symbolText (Symbol sym) == "/nix/store/foo"
then Pass
else Fail "path mismatch"
),
runTestM "compile inherit-from binding" $ do
idx <-
compileExpr
( EAttrs
False
[InheritFrom (EVar "s") ["x", "y"]]
NoCaptureInfo
)
op <- cbcOpcode idx
count <- cbcShortArg idx
dataOff <- cbcArg1 idx
bindings <- decodeBcBindings 1 dataOff
case bindings of
[BcInheritFrom _ names]
| op == OpAttrs && count == 1 -> do
selects <- mapM inheritedSelect names
pure (assertEqual "inherited names and their selects" [("x", True), ("y", True)] selects)
_ -> pure (Fail "inherit binding mismatch"),
-- A plain inherit has no lookup of its own: it carries the variable,
-- bound like any other, for the evaluator to read in the outer env.
runTestM "compile plain inherit with the variable it copies" $ do
idx <- compileExpr (EAttrs False [Inherit "x" (EResolvedVar 0 0)] NoCaptureInfo)
dataOff <- cbcArg1 idx
bindings <- decodeBcBindings 1 dataOff
case bindings of
[BcInherit sym valIdx] -> do
valOp <- cbcOpcode valIdx
pure $
if symbolText (Symbol sym) == "x" && valOp == OpResolvedVar
then Pass
else Fail "expected x to carry the resolved variable"
_ -> pure (Fail "expected one inherit binding"),
runTestM "compile ELambda (FormalSet)" $ do
idx <-
compileExpr
( ELambda
(FormalSet [Formal "a" Nothing, Formal "b" (Just (ELit (NixInt 0)))] False)
(EResolvedVar 0 0)
NoCaptureInfo
)
op <- cbcOpcode idx
fl <- cbcFlags idx
pure
( if op == OpLambda && fl == formalSet
then Pass
else Fail ("flags=" <> T.pack (show fl))
),
runTestM "compile ELambda (FormalNamedSet)" $ do
idx <-
compileExpr
( ELambda
(FormalNamedSet "args" [Formal "x" Nothing] True)
(EResolvedVar 0 0)
NoCaptureInfo
)
op <- cbcOpcode idx
fl <- cbcFlags idx
pure
( if op == OpLambda && fl == formalNamedSet
then Pass
else Fail ("flags=" <> T.pack (show fl))
),
runTestM "compile CaptureInfo (Captures)" $ do
idx <-
compileExpr
( ELambda
(FormalName "x")
(EResolvedVar 0 0)
(Captures [(1, 2), (3, 4)])
)
op <- cbcOpcode idx
capOff <- cbcArg3 idx
capTag <- cbcData capOff
capCount <- cbcData (capOff + 1)
capL0 <- cbcData (capOff + 2)
capI0 <- cbcData (capOff + 3)
capL1 <- cbcData (capOff + 4)
capI1 <- cbcData (capOff + 5)
pure
( if op == OpLambda
&& capTag == captureSlots
&& capCount == 2
&& capL0 == 1
&& capI0 == 2
&& capL1 == 3
&& capI1 == 4
then Pass
else
Fail
( "capTag="
<> T.pack (show capTag)
<> " capCount="
<> T.pack (show capCount)
)
),
runTestM "compile CaptureInfo (CapturesWithScopes)" $ do
idx <-
compileExpr
( ELambda
(FormalName "x")
(EResolvedVar 0 0)
(CapturesWithScopes [(0, 0)])
)
capOff <- cbcArg3 idx
capTag <- cbcData capOff
pure (assertEqual "captureTag" captureWithScopes capTag),
runTestM "compile EWithVar" $ do
idx <- compileExpr (EWithVar "dynamic")
op <- cbcOpcode idx
sym <- cbcArg1 idx
pure
( if op == OpWithVar && symbolText (Symbol sym) == "dynamic"
then Pass
else Fail "withvar mismatch"
),
runTestM "compile EIndStr" $ do
idx <- compileExpr (EIndStr [StrLit "indented"])
op <- cbcOpcode idx
count <- cbcShortArg idx
pure
( if op == OpIndStr && count == 1
then Pass
else Fail "indstr mismatch"
)
]
-- ---------------------------------------------------------------------------
-- Tests: substituter signature verification (the --trusted-key trust gate)
-- ---------------------------------------------------------------------------
-- | Minimal narinfo for signing tests; the fingerprint covers StorePath,
-- NarHash, NarSize, and References.
sigTestNarInfo :: NarInfo.NarInfo
sigTestNarInfo =
NarInfo.NarInfo
{ NarInfo.niStorePath = "/nix/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-hello-1.0",
NarInfo.niUrl = "nar/aaaa.nar",
NarInfo.niCompression = "none",
NarInfo.niFileHash = Just ("sha256:" <> T.replicate 52 "0"),
NarInfo.niFileSize = Just 1,
NarInfo.niNarHash = "sha256:" <> T.replicate 52 "0",
NarInfo.niNarSize = 1,
NarInfo.niReferences = [],
NarInfo.niDeriver = Nothing,
NarInfo.niSigs = [],
NarInfo.niCA = Nothing
}
-- | A substituter cache trusting the given public key text.
sigTestCache :: Text -> Subst.CacheConfig
sigTestCache publicKeyText =
Subst.CacheConfig
{ Subst.ccUrl = "http://localhost/test-cache",
Subst.ccPublicKeys = [publicKeyText],
Subst.ccPriority = 40
}
-- | Deterministic Ed25519 test keys: a nix secret key file is
-- seed(32) + public(32), and both signing and public-key derivation use
-- only the seed, so the public half can be zeros here. Both keys carry
-- the SAME name so the wrong-key test exercises the cryptographic
-- verification, not just the name comparison.
sigTestKeyText, sigTestWrongKeyText :: Text
sigTestKeyText = "test-key-1:" <> B64.encode (BS.pack ([1 .. 32] ++ replicate 32 0))
sigTestWrongKeyText = "test-key-1:" <> B64.encode (BS.pack ([101 .. 132] ++ replicate 32 0))
-- | Derive (trusted cache, signature by the trusted key, signature by an
-- impostor key with the same name). Left on any setup failure.
sigTestSetup :: Either String (Subst.CacheConfig, Text, Text)
sigTestSetup = do
secretKey <- Signing.parseSecretKey sigTestKeyText
impostorKey <- Signing.parseSecretKey sigTestWrongKeyText
publicKey <- Signing.toPublicKey secretKey
let publicKeyText = Signing.renderPublicKey publicKey
validSig <- Signing.sign secretKey sigTestNarInfo
impostorSig <- Signing.sign impostorKey sigTestNarInfo
pure (sigTestCache publicKeyText, validSig, impostorSig)
-- | verifySigs is the security boundary behind @--trusted-key@: unsigned
-- narinfos, wrong-key signatures, and malformed trusted keys must all be
-- rejected; a valid signature must be accepted.
testVerifySigs :: IO [Bool]
testVerifySigs = do
putStrLn "substituter/verify-sigs"
case sigTestSetup of
Left err -> (: []) <$> runTest "verifySigs test setup" (Fail (T.pack err))
Right (cache, validSig, impostorSig) ->
sequence
[ runTest "valid signature accepted" $
assertEqual "verify ok" (Right ()) (Subst.verifySigs cache sigTestNarInfo {NarInfo.niSigs = [validSig]}),
runTest "unsigned narinfo rejected" $
assertLeft "no sigs" (Subst.verifySigs cache sigTestNarInfo),
runTest "same-name signature from a different key rejected" $
assertLeft "impostor sig" (Subst.verifySigs cache sigTestNarInfo {NarInfo.niSigs = [impostorSig]}),
runTest "valid signature among invalid ones accepted" $
assertEqual "any valid" (Right ()) (Subst.verifySigs cache sigTestNarInfo {NarInfo.niSigs = [impostorSig, validSig]}),
runTest "signature under a different key name rejected" $
assertLeft "name mismatch" (Subst.verifySigs cache sigTestNarInfo {NarInfo.niSigs = ["other-key:" <> T.drop (T.length "test-key-1:") validSig]}),
runTest "malformed trusted public key rejected" $
assertLeft "bad pubkey" (Subst.verifySigs (sigTestCache "not-a-key") sigTestNarInfo {NarInfo.niSigs = [validSig]}),
-- The flat trusted-key set: a signature valid under ANY of
-- several trusted keys is accepted, even when the matching key
-- is not first.
runTest "a signature valid under any of several trusted keys is accepted" $
let multiKey = cache {Subst.ccPublicKeys = Subst.ccPublicKeys Subst.defaultCacheConfig ++ Subst.ccPublicKeys cache}
in assertEqual "any-of" (Right ()) (Subst.verifySigs multiKey sigTestNarInfo {NarInfo.niSigs = [validSig]}),
runTest "a signature matching none of several trusted keys is rejected" $
let multiKey = cache {Subst.ccPublicKeys = ["cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY=", "other.cache-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY="]}
in assertLeft "none-of" (Subst.verifySigs multiKey sigTestNarInfo {NarInfo.niSigs = [validSig]}),
-- A malformed key anywhere in the set is an error, not a
-- silently skipped key: a typo must not quietly narrow the
-- trusted set to the keys that happened to parse.
runTest "a malformed key among valid ones is an error, not skipped" $
let multiKey = cache {Subst.ccPublicKeys = "not-a-key" : Subst.ccPublicKeys cache}
in assertLeft "typo not skipped" (Subst.verifySigs multiKey sigTestNarInfo {NarInfo.niSigs = [validSig]})
]
-- | The nix.conf / NIX_CONFIG resolver: parsing, aliases, the extra-
-- append rule, the precedence fold, include expansion over an in-memory
-- file map, and the file cascade. The trusted-key cases are the
-- security-relevant ones, a plain assignment in a higher source replaces
-- the trusted set, an extra- widens it.
testNixConfig :: IO [Bool]
testNixConfig = do
putStrLn "config/nix-conf"
let -- A root the platform agrees is absolute: "/" is not one on
-- Windows, for System.FilePath and for upstream's canonPath alike.
root = if SI.os == "mingw32" then "C:\\" else "/"
etcNix = root </> "etc" </> "nix"
etcXdg = root </> "etc" </> "xdg"
etcXdgLocal = root </> "etc" </> "xdg-local"
configHome = root </> "home" </> "u" </> ".config"
systemConf = etcNix </> "nix.conf"
xdgConf dir = dir </> "nix" </> "nix.conf"
-- The expander's one effect, served from an in-memory map: a path
-- is in it or there is nothing there.
readFrom files path = Identity (maybe (Left Config.ConfigFileMissing) Right (Map.lookup path files))
resolveWith files paths env = runIdentity (Config.loadConfig (readFrom files) paths env)
substitutersOf files paths env = ncSubstituters <$> resolveWith files paths env
fileMap = Map.mapKeys asciiOsPath . Map.fromList
-- The same, over the cascade a 'ConfigLocations' computes.
substitutersAt files locations env = Config.configFilePaths locations >>= \paths -> substitutersOf files paths env
firstPathOf locations = listToMaybe <$> Config.configFilePaths locations
-- Successive texts as successive files, weakest first.
resolveTexts texts =
let paths = [asciiOsPath (root </> "src" </> (show index ++ ".conf")) | index <- [1 .. length texts]]
in resolveWith (Map.fromList (zip paths texts)) paths Nothing
subs = fmap ncSubstituters . resolveTexts
keys = fmap ncTrustedPublicKeys . resolveTexts
uris = fmap ncAllowedUris . resolveTexts
cascade =
Config.ConfigLocations
{ Config.clConfDir = Nothing,
Config.clSystemConfDir = Just (asciiOsPath etcNix),
Config.clUserConfFiles = Nothing,
Config.clConfigHome = asciiOsPath configHome,
Config.clConfigDirs = map asciiOsPath [etcXdg, etcXdgLocal]
}
cascadeFiles =
fileMap
[ (systemConf, "substituters = https://system"),
(xdgConf etcXdgLocal, "substituters = https://xdg-local"),
(xdgConf etcXdg, "substituters = https://xdg"),
(xdgConf configHome, "substituters = https://home")
]
listVar = BS8.pack . intercalate [searchPathSeparator]
depth = fmap ncMaxCallDepth . resolveTexts
depthOf value = depth ["max-call-depth = " <> value]
refused = either (const True) (const False) . depthOf
-- Bytes with no UTF-8 reading (0xE9, Latin-1's e-acute). They are
-- a host path on POSIX and none on Windows, whose paths are UTF-16,
-- so the cases holding them branch on whether they spell one.
latin1 = "caf\xE9" :: BS.ByteString
-- What a lossy decode would open instead: U+FFFD's UTF-8.
replaced = "caf\xEF\xBF\xBD"
nixConfName = asciiOsPath "nix.conf"
sequence
[ runTest "parses a whitespace-split substituters list" $
assertEqual "subs" (Right ["https://a", "https://b"]) (subs ["substituters = https://a https://b"]),
runTest "a comment truncates the line" $
assertEqual "comment" (Right ["https://a"]) (subs ["substituters = https://a # not https://b"]),
runTest "a plain assignment replaces across sources" $
assertEqual "replace" (Right ["https://b"]) (subs ["substituters = https://a", "substituters = https://b"]),
runTest "extra- appends within a source set" $
assertEqual "append" (Right ["https://a", "https://b"]) (subs ["substituters = https://a", "extra-substituters = https://b"]),
runTest "binary-caches aliases substituters" $
assertEqual "alias" (Right ["https://a"]) (subs ["binary-caches = https://a"]),
runTest "extra- composes with an alias" $
assertEqual "extra-alias" (Right ["https://a", "https://b"]) (subs ["substituters = https://a", "extra-binary-caches = https://b"]),
runTest "binary-cache-public-keys aliases trusted-public-keys" $
assertEqual "key-alias" (Right ["k1"]) (keys ["binary-cache-public-keys = k1"]),
runTest "a higher source plainly replaces the trusted set" $
assertEqual "trust-replace" (Right ["k2"]) (keys ["trusted-public-keys = k1", "trusted-public-keys = k2"]),
runTest "a higher source with extra- widens the trusted set" $
assertEqual "trust-widen" (Right ["k1", "k2"]) (keys ["trusted-public-keys = k1", "extra-trusted-public-keys = k2"]),
runTest "an unknown setting is ignored, not an error" $
assertEqual "unknown" (Right ["https://a"]) (subs ["cores = 4\nsubstituters = https://a"]),
runTest "blank and comment-only lines are skipped" $
assertEqual "blanks" (Right ["https://a"]) (subs ["# a comment\n\nsubstituters = https://a\n"]),
runTest "a line missing = is a syntax error quoting the line as truncated, untrimmed" $
let expected = "nix.conf: syntax error in configuration line ' substituters https://a ' in '" <> T.pack (root </> "src" </> "1.conf") <> "'"
in assertEqual "syntax" (Left expected) (resolveTexts [" substituters https://a # comment"]),
runTest "the default config is empty" $
assertEqual "default" (Right []) (subs []),
-- Tokens, as upstream's tokenizeString splits them: on space, tab,
-- CR and LF only, which nix config show 2.33.2 agrees with.
runTest "a value splits on space, tab and CR, and not on other spaces" $
assertEqual
"separators"
(Right ["https://a\xA0https://b\vhttps://c\fhttps://d", "https://e", "https://f", "https://g"])
(uris ["allowed-uris = https://a\xC2\xA0https://b\vhttps://c\fhttps://d https://e\rhttps://f\thttps://g"]),
runTest "a CRLF line ends where its LF does" $
assertEqual "crlf" (Right ["https://a"]) (subs ["substituters = https://a\r\n"]),
runTest "a Boolean value ending in a no-break space is upstream's invalid-value error" $
assertEqual "nbsp-bool" (Left "Boolean setting 'pure-eval' has invalid value 'true\xA0'") (ncPureEval <$> resolveTexts ["pure-eval = true\xC2\xA0"]),
-- Bytes with no UTF-8 reading in a setting.
runTest "a comment and an unknown setting holding a byte with no UTF-8 reading are never decoded" $
assertEqual "bytes-ignored" (Right ["https://a"]) (substitutersOf Map.empty [] (Just ("trusted-users = " <> latin1 <> "\nsubstituters = https://a # " <> latin1))),
runTest "a list setting holding a byte with no UTF-8 reading is refused under its own name" $
let expected = "setting 'substituters' has invalid value 'https://caf\xFFFD.example': not valid UTF-8"
in assertEqual "list-bytes" (Left expected) (substitutersOf Map.empty [] (Just ("extra-binary-caches = https://" <> latin1 <> ".example"))),
runTest "a Boolean or integer setting holding such a byte is upstream's invalid-value error" $
assertEqual
"scalar-bytes"
(Left "Boolean setting 'pure-eval' has invalid value 'true\xFFFD'", Left "setting 'max-call-depth' has invalid value '5\xFFFD'")
(ncPureEval <$> resolveTexts ["pure-eval = true\xE9"], depthOf "5\xE9"),
-- max-call-depth: a scalar under upstream's unsigned-integer grammar.
runTest "max-call-depth defaults to upstream's 10000" $
assertEqual "depth-default" (Right 10000) (depth []),
runTest "max-call-depth parses a decimal" $
assertEqual "depth-decimal" (Right 5) (depthOf "5"),
runTest "a higher source replaces max-call-depth" $
assertEqual "depth-replace" (Right 7) (depth ["max-call-depth = 5", "max-call-depth = 7"]),
runTest "max-call-depth takes a binary unit suffix in either case" $
assertEqual "depth-unit" (Right [10240, 5120, 1048576]) (traverse depthOf ["10K", "5k", "1M"]),
runTest "max-call-depth takes a leading plus and leading zeros" $
assertEqual "depth-plus" (Right [5, 7]) (traverse depthOf ["+5", "007"]),
runTest "max-call-depth accepts the top of unsigned int" $
assertEqual "depth-top" (Right 4294967295) (depthOf "4294967295"),
runTest "an invalid max-call-depth is refused with upstream's words" $
assertEqual "depth-invalid" (Left "setting 'max-call-depth' has invalid value 'abc'") (depthOf "abc"),
runTest "max-call-depth refuses a sign, a fraction, hex, an unknown unit, an empty value and a second token" $
assertEqual "depth-refused" (True, 6) (all refused rejects, length rejects),
runTest "max-call-depth refuses a value past unsigned int, a unit product included" $
assertEqual "depth-range" True (refused "4294967296" && refused "5G"),
runTest "extra-max-call-depth is an unknown name, not an append" $
assertEqual "depth-extra" (Right 10000) (depth ["extra-max-call-depth = 5"]),
-- Includes.
runTest "an include is spliced in at its line, resolved against the including file's directory" $
let files =
fileMap
[ (systemConf, "substituters = https://a\ninclude site.conf\nextra-substituters = https://c"),
(etcNix </> "site.conf", "extra-substituters = https://b")
]
in assertEqual "inline" (Right ["https://a", "https://b", "https://c"]) (substitutersOf files [asciiOsPath systemConf] Nothing),
runTest "a nested include resolves against the nested file, with .. collapsed" $
let files =
fileMap
[ (systemConf, "include sub/one.conf"),
(etcNix </> "sub" </> "one.conf", "include ../two.conf"),
(etcNix </> "two.conf", "substituters = https://two")
]
in assertEqual "nested" (Right ["https://two"]) (substitutersOf files [asciiOsPath systemConf] Nothing),
runTest "!include of a file that cannot be read is skipped" $
let files = fileMap [(systemConf, "substituters = https://a\n!include missing.conf\nextra-substituters = https://b")]
in assertEqual "optional" (Right ["https://a", "https://b"]) (substitutersOf files [asciiOsPath systemConf] Nothing),
runTest "include of a missing file is an error in upstream's words, naming both files" $
let files = fileMap [(systemConf, "include missing.conf")]
expected = "nix.conf: file '" <> T.pack (etcNix </> "missing.conf") <> "' included from '" <> T.pack systemConf <> "' not found"
in assertEqual "required" (Left expected) (substitutersOf files [asciiOsPath systemConf] Nothing),
-- A file that exists but will not open: upstream drops it, here a
-- required include of it is an error in its own words.
runTest "include of a file that exists but cannot be read is an error, not a silent drop" $
let locked = etcNix </> "locked.conf"
readLocked path = Identity (if path == asciiOsPath locked then Left Config.ConfigFileUnreadable else Right "include locked.conf")
expected = "nix.conf: file '" <> T.pack locked <> "' included from '" <> T.pack systemConf <> "' cannot be read"
in assertEqual "unreadable" (Left expected) (ncSubstituters <$> runIdentity (Config.loadConfig readLocked [asciiOsPath systemConf] Nothing)),
runTest "!include of a file that exists but cannot be read is skipped" $
let locked = etcNix </> "locked.conf"
readLocked path = Identity (if path == asciiOsPath locked then Left Config.ConfigFileUnreadable else Right "!include locked.conf\nsubstituters = https://a")
in assertEqual "unreadable-optional" (Right ["https://a"]) (ncSubstituters <$> runIdentity (Config.loadConfig readLocked [asciiOsPath systemConf] Nothing)),
runTest "an include cycle is refused rather than followed" $
let files = fileMap [(systemConf, "include site.conf"), (etcNix </> "site.conf", "include nix.conf")]
in assertLeft "cycle" (substitutersOf files [asciiOsPath systemConf] Nothing),
runTest "an include with no path or two paths is a syntax error" $
assertEqual "arity" [True, True, True] (map (either (const True) (const False) . resolveTexts . pure) ["include", "include a b", "!include"]),
runTest "a relative include from NIX_CONFIG is refused as not absolute" $
let expected = "nix.conf: not an absolute path: '" <> T.pack ("." </> "rel.conf") <> "'"
in assertEqual "env-relative" (Left expected) (substitutersOf Map.empty [] (Just "include rel.conf")),
runTest "an absolute include from NIX_CONFIG is expanded" $
let files = fileMap [(etcNix </> "x.conf", "substituters = https://x")]
in assertEqual "env-absolute" (Right ["https://x"]) (substitutersOf files [] (Just ("include " <> BS8.pack (etcNix </> "x.conf")))),
-- An include target is bytes from the line to the open (#244): the
-- file its bytes name is read, never the one a lossy decode names.
runTest "an include target with no UTF-8 reading opens the file its bytes name" $
let target = latin1 <> ".conf"
including = fileMap [(systemConf, "include " <> target)]
decoy = maybe including (\name -> Map.insert (asciiOsPath etcNix OP.</> name) "substituters = https://replacement" including) (hostPathFromBytes (replaced <> ".conf"))
in case hostPathFromBytes target of
Just name ->
let files = Map.insert (asciiOsPath etcNix OP.</> name) "substituters = https://latin1" decoy
in assertEqual "include-bytes" (Right ["https://latin1"]) (substitutersOf files [asciiOsPath systemConf] Nothing)
Nothing ->
let expected = "nix.conf: file 'caf\xFFFD.conf' included from '" <> T.pack systemConf <> "' is not valid UTF-8, so it names no Windows file"
in assertEqual "include-bytes-windows" (Left expected) (substitutersOf decoy [asciiOsPath systemConf] Nothing),
runTest "!include of a target with no UTF-8 reading that names nothing goes on without it" $
let files = fileMap [(systemConf, "!include " <> latin1 <> ".conf\nsubstituters = https://a")]
in assertEqual "optional-bytes" (Right ["https://a"]) (substitutersOf files [asciiOsPath systemConf] Nothing),
-- The directories a cascade names keep their bytes too, so the
-- system file under such a NIX_CONF_DIR, and an include beside a
-- file under such a config home, are the files those bytes name.
runTest "NIX_CONF_DIR holding a byte with no UTF-8 reading names the system file by its bytes" $
let confDir = BS8.pack (etcNix ++ "-") <> latin1
located = cascade {Config.clConfDir = Just confDir, Config.clUserConfFiles = Just ""}
in case hostPathFromBytes confDir of
Just dir ->
let files = Map.fromList [(dir OP.</> nixConfName, "include site.conf"), (dir OP.</> asciiOsPath "site.conf", "substituters = https://conf-dir")]
in assertEqual "conf-dir-bytes" (Right (Just (dir OP.</> nixConfName)), Right ["https://conf-dir"]) (firstPathOf located, substitutersAt files located Nothing)
Nothing -> assertLeft "conf-dir-bytes-windows" (firstPathOf located),
runTest "an include beside a user file under a config home holding such a byte resolves beneath it" $
case hostPathFromBytes (BS8.pack (configHome ++ "-") <> latin1) of
Just home ->
let located = cascade {Config.clSystemConfDir = Nothing, Config.clConfigHome = home, Config.clConfigDirs = []}
userDir = home OP.</> asciiOsPath "nix"
files = Map.fromList [(userDir OP.</> nixConfName, "include more.conf"), (userDir OP.</> asciiOsPath "more.conf", "substituters = https://home-bytes")]
in assertEqual "home-bytes" (Right ["https://home-bytes"]) (substitutersAt files located Nothing)
Nothing -> assertEqual "home-bytes-windows" "mingw32" SI.os,
-- The cascade: which files, in which order, and who wins.
runTest "the cascade is the system file, XDG_CONFIG_DIRS back to front, then the config home" $
assertEqual "order" (Right (map asciiOsPath [systemConf, xdgConf etcXdgLocal, xdgConf etcXdg, xdgConf configHome])) (Config.configFilePaths cascade),
runTest "the config home beats XDG_CONFIG_DIRS beats the system file" $
assertEqual "home-wins" (Right ["https://home"]) (substitutersAt cascadeFiles cascade Nothing),
runTest "the first XDG_CONFIG_DIRS entry beats the later ones" $
assertEqual "xdg-first" (Right ["https://xdg"]) (substitutersAt (Map.delete (asciiOsPath (xdgConf configHome)) cascadeFiles) cascade Nothing),
runTest "a listed file that cannot be read is absent, not an error" $
assertEqual "absent" (Right ["https://system"]) (substitutersAt (Map.filterWithKey (\path _ -> path == asciiOsPath systemConf) cascadeFiles) cascade Nothing),
runTest "extra- in a stronger file widens what a weaker file set" $
let files = fileMap [(systemConf, "trusted-public-keys = k1"), (xdgConf configHome, "extra-trusted-public-keys = k2")]
in assertEqual "widen-across-files" (Right ["k1", "k2"]) (fmap ncTrustedPublicKeys (Config.configFilePaths cascade >>= \paths -> resolveWith files paths Nothing)),
runTest "NIX_CONFIG beats every file" $
assertEqual "env-wins" (Right ["https://env"]) (substitutersAt cascadeFiles cascade (Just "substituters = https://env")),
runTest "NIX_USER_CONF_FILES replaces the XDG files, first listed strongest" $
let listed = cascade {Config.clUserConfFiles = Just (listVar [etcNix </> "a.conf", etcNix </> "b.conf"])}
in assertEqual "listed" (Right (map asciiOsPath [systemConf, etcNix </> "b.conf", etcNix </> "a.conf"])) (Config.configFilePaths listed),
runTest "an empty NIX_USER_CONF_FILES names no user files" $
assertEqual "none" (Right [asciiOsPath systemConf]) (Config.configFilePaths cascade {Config.clUserConfFiles = Just ""}),
runTest "empty NIX_USER_CONF_FILES entries are dropped" $
assertEqual "empties" (Right (map asciiOsPath [systemConf, etcNix </> "a.conf"])) (Config.configFilePaths cascade {Config.clUserConfFiles = Just (listVar ["", etcNix </> "a.conf", ""])}),
runTest "NIX_CONF_DIR moves the system file" $
assertEqual "conf-dir" (Right (Just (asciiOsPath (etcXdg </> "nix.conf")))) (firstPathOf cascade {Config.clConfDir = Just (BS8.pack etcXdg)}),
runTest "an empty NIX_CONF_DIR is unset" $
assertEqual "conf-dir-empty" (Right (Just (asciiOsPath systemConf))) (firstPathOf cascade {Config.clConfDir = Just ""}),
runTest "a relative NIX_CONF_DIR is refused with upstream's complaint" $
assertEqual "conf-dir-relative" (Left "nix.conf: not an absolute path: 'rel'") (firstPathOf cascade {Config.clConfDir = Just "rel"}),
runTest "dot and dot-dot in NIX_CONF_DIR collapse, so the system file is named canonically" $
assertEqual "conf-dir-canonical" (Right (Just (asciiOsPath systemConf))) (firstPathOf cascade {Config.clConfDir = Just (BS8.pack (root </> "etc" </> "x" </> ".." </> "." </> "nix"))}),
-- A UNC directory keeps its server on Windows, where System.FilePath
-- and std::filesystem both read it as the drive; a doubled POSIX
-- root is one root, as upstream's canonPath folds it.
runTest "a UNC NIX_CONF_DIR keeps its root, and its include resolves beneath it" $
let (dir, expected) =
if SI.os == "mingw32"
then ("\\\\server\\share", "\\\\server\\share\\nix.conf")
else ("//server/share", "/server/share/nix.conf")
uncConf = takeDirectory expected </> "site.conf"
files = fileMap [(expected, "include site.conf"), (uncConf, "substituters = https://unc")]
unc = cascade {Config.clConfDir = Just (BS8.pack dir), Config.clUserConfFiles = Just ""}
in assertEqual "unc" (Right (Just (asciiOsPath expected)), Right ["https://unc"]) (firstPathOf unc, substitutersAt files unc Nothing),
runTest "a platform with no machine-wide directory has no system file" $
assertEqual "no-system-dir" (Right (map asciiOsPath [xdgConf etcXdgLocal, xdgConf etcXdg, xdgConf configHome])) (Config.configFilePaths cascade {Config.clSystemConfDir = Nothing}),
runTest "NIX_CONF_DIR names a system file even where the platform has no directory for one" $
assertEqual "conf-dir-no-default" (Right (Just (asciiOsPath (etcXdg </> "nix.conf")))) (firstPathOf cascade {Config.clSystemConfDir = Nothing, Config.clConfDir = Just (BS8.pack etcXdg)})
]
where
rejects = ["-1", "1.5", "0x10", "5X", "", "5 6"]
-- | A test path as the config expander names it. Test paths spelled
-- this way are ASCII, which 'OP.unsafeFromChar' narrows to one path unit
-- exactly on every platform.
asciiOsPath :: FilePath -> OsPath
asciiOsPath = OP.pack . map OP.unsafeFromChar
-- | Narinfo field validation gates the pipeline ahead of the signed
-- fingerprint: a malformed field must fail as a parse error before its
-- text can reach the fingerprint or anything downstream.
testNarInfoValidation :: IO [Bool]
testNarInfoValidation = do
putStrLn "substituter/narinfo-field-validation"
sequence
[ runTest "well-formed narinfo passes" $
assertEqual "valid" (Right ()) (Subst.validateNarInfoFields sigTestNarInfo),
runTest "malformed StorePath rejected" $
assertLeft "bad store path" (Subst.validateNarInfoFields sigTestNarInfo {NarInfo.niStorePath = "/nix/store/zzz"}),
runTest "derivation StorePath rejected" $
assertLeft "drv path" (Subst.validateNarInfoFields sigTestNarInfo {NarInfo.niStorePath = "/nix/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-hello-1.0.drv"}),
runTest "malformed reference rejected" $
assertLeft "bad reference" (Subst.validateNarInfoFields sigTestNarInfo {NarInfo.niReferences = ["../escape"]}),
runTest "malformed NarHash rejected" $
assertLeft "bad narhash" (Subst.validateNarInfoFields sigTestNarInfo {NarInfo.niNarHash = "sha256:nope"}),
runTest "negative NarSize rejected" $
assertLeft "negative narsize" (Subst.validateNarInfoFields sigTestNarInfo {NarInfo.niNarSize = -1}),
runTest "field validation reports ahead of signature verification" $
case sigTestSetup of
Left err -> Fail (T.pack err)
Right (cache, validSig, _) ->
case Subst.narInfoPreflight cache sigTestNarInfo {NarInfo.niStorePath = "/nix/store/zzz", NarInfo.niSigs = [validSig]} of
Left err
| "invalid narinfo" `T.isInfixOf` err -> Pass
| otherwise -> Fail ("expected the field-validation error, got: " <> err)
Right () -> Fail "expected failure, got a clean preflight"
]
-- ---------------------------------------------------------------------------
-- Tests: resolver static globals stay in sync with the root env
-- ---------------------------------------------------------------------------
-- | The names upstream 2.24.9's base environment binds with default
-- settings, recorded from its source: every @addConstant@ and @addPrimOp@
-- in @createBaseEnv@ (src/libexpr/primops.cc) and every @RegisterPrimOp@
-- in libexpr and libflake not gated on an experimental feature, under the
-- name it registers. @__importNative@ and @__exec@ need
-- @allow-unsafe-native-code-during-evaluation@ and are not here.
upstreamBaseEnvNames :: Set.Set Text
upstreamBaseEnvNames =
Set.fromList
[ "__add",
"__addDrvOutputDependencies",
"__addErrorContext",
"__all",
"__any",
"__appendContext",
"__attrNames",
"__attrValues",
"__bitAnd",
"__bitOr",
"__bitXor",
"__catAttrs",
"__ceil",
"__compareVersions",
"__concatLists",
"__concatMap",
"__concatStringsSep",
"__convertHash",
"__currentSystem",
"__currentTime",
"__deepSeq",
"__div",
"__elem",
"__elemAt",
"__fetchurl",
"__filter",
"__filterSource",
"__findFile",
"__floor",
"__foldl'",
"__fromJSON",
"__functionArgs",
"__genList",
"__genericClosure",
"__getAttr",
"__getContext",
"__getEnv",
"__groupBy",
"__hasAttr",
"__hasContext",
"__hashFile",
"__hashString",
"__head",
"__intersectAttrs",
"__isAttrs",
"__isBool",
"__isFloat",
"__isFunction",
"__isInt",
"__isList",
"__isPath",
"__isString",
"__langVersion",
"__length",
"__lessThan",
"__listToAttrs",
"__mapAttrs",
"__match",
"__mul",
"__nixPath",
"__nixVersion",
"__parseDrvName",
"__partition",
"__path",
"__pathExists",
"__readDir",
"__readFile",
"__readFileType",
"__replaceStrings",
"__seq",
"__sort",
"__split",
"__splitVersion",
"__storeDir",
"__storePath",
"__stringLength",
"__sub",
"__substring",
"__tail",
"__toFile",
"__toJSON",
"__toPath",
"__toXML",
"__trace",
"__traceVerbose",
"__tryEval",
"__typeOf",
"__unsafeDiscardOutputDependency",
"__unsafeDiscardStringContext",
"__unsafeGetAttrPos",
"__warn",
"__zipAttrsWith",
"abort",
"baseNameOf",
"break",
"builtins",
"derivation",
"derivationStrict",
"dirOf",
"false",
"fetchGit",
"fetchMercurial",
"fetchTarball",
"fromTOML",
"import",
"isNull",
"map",
"null",
"placeholder",
"removeAttrs",
"scopedImport",
"throw",
"toString",
"true"
]
-- | The two @addConstant@ calls marked @impureOnly@, which upstream skips
-- under @pure-eval@.
upstreamImpureOnlyNames :: Set.Set Text
upstreamImpureOnlyNames = Set.fromList ["__currentSystem", "__currentTime"]
-- | Binding accepts exactly the names upstream's base environment holds,
-- and the root environment binds exactly the names binding accepts, under
-- each policy, every one of them to a value that forces.
testStaticGlobalsSync :: IO [Bool]
testStaticGlobalsSync = do
putStrLn "resolve/static-globals-sync"
let pureNames = Set.difference upstreamBaseEnvNames upstreamImpureOnlyNames
unrestrictedRoot <- rootEnvNames unrestrictedPolicy
pureRoot <- rootEnvNames purePolicy
sequence
[ runTest "binding accepts upstream's base environment" $
assertSameNames "static globals" upstreamBaseEnvNames staticGlobalNames,
runTest "pure evaluation drops upstream's impure-only constants" $
assertEqual "impure-only" upstreamImpureOnlyNames impureOnlyGlobalNames
`andThen` assertSameNames "pure scope" pureNames (rootScopeNames purePolicy),
runTest "the root env binds exactly those names" $
assertSameNames "root env" upstreamBaseEnvNames unrestrictedRoot
`andThen` assertSameNames "pure root env" pureNames pureRoot,
runTest "every root env name forces" $
assertEqual
"names that fail to force"
[]
[ name
| name <- Set.toList upstreamBaseEnvNames,
evalNix ("builtins.seq " <> name <> " true") /= Right (VBool True)
]
]
where
rootEnvNames policy = case builtinEnv policy 0 [] of
Env envPtr -> do
scopePtr <- cenvLazyScope envPtr
pure (Set.fromList (attrSetKeys (AttrSet (castPtr scopePtr))))
assertSameNames label expected actual =
assertEqual
(label <> ": (missing, extra)")
([], [])
(Set.toList (Set.difference expected actual), Set.toList (Set.difference actual expected))
-- ---------------------------------------------------------------------------
-- Tests: variables are bound before evaluation (upstream's bindVars)
-- ---------------------------------------------------------------------------
-- | Assert that binding rejects a source for the named variable, before
-- anything is evaluated.
assertUnbound :: Text -> Text -> Text -> TestResult
assertUnbound label source name = case parseNix testBaseDir "<test>" source of
Left err -> assertEqual label (UndefinedVariable name) err
Right expr -> Fail (label <> ": bound, got " <> T.pack (show expr))
-- | Assert that every variable in a source binds.
assertBinds :: Text -> Text -> TestResult
assertBinds label source = assertRight label (parseNix testBaseDir "<test>" source) (const Pass)
-- | Upstream rejects a variable no scope binds and no @with@ could supply
-- while binding (nixexpr.cc, ExprVar::bindVars), wherever it sits; only a
-- name under a @with@ waits for evaluation. Each expectation here is
-- nix-instantiate 2.33.2's.
testUndefinedVariables :: IO [Bool]
testUndefinedVariables = do
putStrLn "resolve/undefined-variables"
sequence
[ runTest "an unbound variable in an unused let binding is rejected" $
assertUnbound "unused-let" "let x = y; in 1" "y",
runTest "an unbound variable on a branch not taken is rejected" $
assertUnbound "untaken-branch" "if true then 1 else y" "y",
runTest "tryEval has nothing to catch: binding fails first" $
assertUnbound "tryEval" "builtins.tryEval (let x = y; in 1)" "y",
runTest "the failure reads as upstream's" $
assertEvalError "message" "builtins.tryEval (let x = y; in 1)" "undefined variable 'y'",
runTest "the first unbound variable in source order is reported" $
assertUnbound "first" "let a = b; c = d; in 1" "b",
runTest "a name under a with binds" $
assertBinds "with-binds" "with {}; y",
runTest "a name no with supplies fails when evaluated" $
assertEvalError "with-eval" "with {}; y" "undefined variable 'y'",
runTest "an unused binding may read a name only a with could supply" $
assertEval "with-unused" "with {}; let x = y; in 1" (VInt 1),
runTest "a with supplies a name a let binding reads" $
assertEval "with-let" "with { y = 3; }; let x = y; in x" (VInt 3),
runTest "a nested let shadows the enclosing one" $
assertEval "let-shadow" "let y = 1; in let y = 2; x = y; in x" (VInt 2),
runTest "a nested rec reads the enclosing rec" $
assertEval "rec-nested" "rec { a = 1; b = rec { c = a; }.c; }.b" (VInt 1),
runTest "a rec reading a name it does not define is rejected" $
assertUnbound "rec-missing" "rec { a = b; }" "b",
runTest "a lambda formal shadows a with" $
assertEval "formal-over-with" "(x: with { x = 2; }; x) 1" (VInt 1),
runTest "a formal default reads a sibling formal" $
assertEval "formal-default" "({ a, b ? a }: b) { a = 3; }" (VInt 3),
runTest "an unbound formal default is rejected" $
assertUnbound "formal-default-unbound" "{ a ? b }: a" "b",
runTest "inherit of an unbound name in a let is rejected" $
assertUnbound "let-inherit" "let inherit x; in 1" "x",
runTest "inherit of an unbound name in a set is rejected" $
assertUnbound "set-inherit" "{ inherit x; }" "x",
runTest "inherit of an unbound name in a rec is rejected" $
assertUnbound "rec-inherit" "rec { inherit x; }" "x",
runTest "inherit reads a name only a with supplies" $
assertEval "with-inherit" "with { x = 5; }; rec { inherit x; }.x" (VInt 5),
runTest "inherit under an empty with fails only when selected" $
assertEvalError "with-inherit-missing" "with {}; { inherit x; }.x" "undefined variable 'x'",
runTest "inherit in a rec reads the enclosing binding, not its own" $
assertEval "rec-inherit-outer" "(x: rec { inherit x; y = x; }.y) 4" (VInt 4),
runTest "inherit from an unbound source is rejected" $
assertUnbound "inherit-from-unbound" "{ inherit (s) x; }" "s",
runTest "inherit from selects lazily" $
assertEval "inherit-from-lazy" "let s = {}; in builtins.attrNames { inherit (s) x; } == [ \"x\" ]" (VBool True),
runTest "inherit from fails when the attribute is selected" $
assertEvalFail "inherit-from-missing" "let s = {}; in { inherit (s) x; }.x",
runTest "an inherit clause cannot repeat a name" $
assertParseFail "inherit-repeat" "let x = 1; in { inherit x x; }",
runTest "an inherit-from clause cannot repeat a name" $
assertParseFail "inherit-from-repeat" "let s = { x = 1; }; in { inherit (s) x x; }",
runTest "__curPos is upstream syntax, not a variable" $
assertEval "curpos" "if false then __curPos else 1" (VInt 1),
runTest "inherit in a static-key rec reads the enclosing rec" $
assertEval "rec-inherit-static" "rec { q = 0; x = 1; y = rec { a = 1; inherit x; }; }.y.x" (VInt 1),
runTest "a __-prefixed builtin on a branch not taken binds" $
assertEval "prefixed-untaken" "if false then __typeOf 1 else 2" (VInt 2),
runTest "a __-prefixed builtin is the builtin" $
assertEval "prefixed-value" "__typeOf 1 == \"int\"" (VBool True),
runTest "a global is not shadowed by a with" $
assertEval "prefixed-over-with" "with { __typeOf = 1; }; __typeOf 2 == \"int\"" (VBool True),
runTest "fetchMercurial binds as a builtin" $
assertEval "fetchMercurial-binds" "builtins.typeOf fetchMercurial == \"lambda\"" (VBool True),
runTest "calling fetchMercurial fails as a builtin nova-nix lacks" $
assertEvalError "fetchMercurial-call" "fetchMercurial {}" "unknown builtin 'fetchMercurial'",
runTest "pure evaluation leaves upstream's impure-only constants unbound" $
assertEqual "pure-currentTime" (Left "undefined variable '__currentTime'") (evalNixWith purePolicy "if false then __currentTime else 1"),
runTest "pure evaluation binds the other globals" $
assertEqual "pure-typeOf" (Right (VInt 1)) (evalNixWith purePolicy "if false then __typeOf else 1")
]
-- | The same check for files: upstream binds each file as it parses it, so
-- an import fails on an unbound variable the importing code never reaches,
-- and @scopedImport@ binds its scope's names around the file. The inherit
-- cases whose regression is a self-reference run here too.
testUndefinedVariablesIO :: IO [Bool]
testUndefinedVariablesIO = do
putStrLn "resolve/undefined-variables-io"
tmpBase <- getTemporaryDirectory
let testDir = tmpBase </> "nova-nix-test-undefined-variables"
branchFile = nixQuotedPath (testDir </> "branch.nix")
scopedFile = nixQuotedPath (testDir </> "scoped.nix")
scopedWithFile = nixQuotedPath (testDir </> "scoped-with.nix")
expectError label source expected = do
result <- evalNixIO testDir source
runTest label $ case result of
Left err -> assertEqual label expected err
Right val -> Fail (label <> ": expected an error, got " <> T.pack (show val))
bracket_
( do
createDirectoryIfMissing True testDir
TIO.writeFile (testDir </> "branch.nix") "{ flag }:\nif flag then 1 else unboundName\n"
TIO.writeFile (testDir </> "scoped.nix") "if false then notInScope else fromScope\n"
TIO.writeFile (testDir </> "scoped-with.nix") "with { fromScope = \"with\"; }; fromScope\n"
)
( do
exists <- doesDirectoryExist testDir
when exists (removeDirectoryRecursive testDir)
)
$ sequence
[ expectError
"an import fails on an unbound variable on a branch not taken"
("(import " <> branchFile <> ") { flag = true; }")
"undefined variable 'unboundName'",
expectError
"tryEval cannot catch an import that fails to bind"
("builtins.tryEval (import " <> branchFile <> ")")
"undefined variable 'unboundName'",
runTestIO
"an import that is never forced does not fail"
testDir
("let f = import " <> branchFile <> "; in 1")
(VInt 1),
expectError
"scopedImport binds against its scope"
("builtins.scopedImport { fromScope = 7; } " <> scopedFile)
"undefined variable 'notInScope'",
runTestIO
"scopedImport scope names bind"
testDir
("builtins.scopedImport { fromScope = 7; notInScope = 1; } " <> scopedFile)
(VInt 7),
runTestIO
"a scopedImport scope name is not shadowed by a with"
testDir
("builtins.scopedImport { fromScope = 7; } " <> scopedWithFile)
(VInt 7),
-- Evaluated where a self-reference is caught as infinite recursion
-- rather than looping, which is what reading the inherited name
-- from the rec's own scope used to do.
runTestIO
"inherit in a dynamic-key rec reads the enclosing rec, not its own"
testDir
"rec { ${\"q\"} = 0; x = 1; y = rec { ${\"a\"} = 1; inherit x; }; }.y.x"
(VInt 1),
expectError
"inherit of a name no with supplies is undefined, not the rec's own"
"with {}; rec { ${\"a\"} = 1; inherit x; }.x"
"undefined variable 'x'"
]
-- ---------------------------------------------------------------------------
-- Main
-- ---------------------------------------------------------------------------
-- ---------------------------------------------------------------------------
-- Tests: byte-indexed string semantics (issue #34)
-- ---------------------------------------------------------------------------
-- | The pinned byte-semantics suite: a Nix string is a byte string, so
-- lengths, slices, regexes, and replaceStrings all index BYTES, and the
-- hash of a value is the hash of exactly its bytes. Multibyte content
-- enters through source literals here (the parser interns their UTF-8);
-- arbitrary/invalid bytes enter via readFile in the IO group below.
testByteStringSemantics :: IO [Bool]
testByteStringSemantics = do
putStrLn "eval/byte-strings"
sequence
[ -- stringLength / substring index bytes
runTest "stringLength counts bytes" $
assertEval "len-bytes" "builtins.stringLength \"\228\"" (VInt 2),
runTest "substring slices at byte offsets" $
assertEval "substr-bytes" "builtins.stringLength (builtins.substring 0 1 \"\228\")" (VInt 1),
runTest "mid-codepoint slices reassemble byte-exactly" $
assertEval
"substr-reassemble"
"builtins.substring 0 1 \"\228\" + builtins.substring 1 1 \"\228\" == \"\228\""
(VBool True),
-- the hash sees exactly the value's bytes
runTest "hashString of a mid-codepoint slice is the raw byte's sha256" $
assertEval
"hash-midbyte"
"builtins.hashString \"sha256\" (builtins.substring 0 1 \"\228\")"
(mkStr (Hash.bytesToHexText (sha256Digest (BS.take 1 (TE.encodeUtf8 "\228"))))),
runTest "hashString of valid UTF-8 is unchanged by the byte layer" $
assertEval
"hash-utf8-stable"
"builtins.hashString \"sha256\" \"\228\""
(mkStr (Hash.bytesToHexText (sha256Digest (TE.encodeUtf8 "\228")))),
-- regexes run over bytes ('.' matches ONE byte)
runTest "match . does not match a 2-byte char" $
assertEval "match-one-byte" "builtins.match \".\" \"\228\"" VNull,
runTest "match .. matches a 2-byte char" $
assertEval "match-two-bytes" "builtins.match \"..\" \"\228\" == []" (VBool True),
runTest "a multibyte pattern matches its own bytes" $
assertEval "match-multibyte-pattern" "builtins.match \"\228\" \"\228\" == []" (VBool True),
-- replaceStrings with an empty 'from' steps one BYTE
runTest "replaceStrings empty-from inserts between bytes" $
assertEval
"replace-empty-from"
"builtins.stringLength (builtins.replaceStrings [\"\"] [\"-\"] \"\228\")"
(VInt 5),
runTest "replaceStrings empty-from result is byte-exact" $
assertEval
"replace-empty-from-bytes"
"builtins.replaceStrings [\"\"] [\"-\"] \"\228\" == \"-\" + builtins.substring 0 1 \"\228\" + \"-\" + builtins.substring 1 1 \"\228\" + \"-\""
(VBool True),
-- strict-decode boundaries reject bytes that are not UTF-8
runTest "toJSON rejects invalid UTF-8" $
assertEvalFail "tojson-invalid" "builtins.toJSON (builtins.substring 0 1 \"\228\")",
runTest "getAttr rejects an invalid-UTF-8 attr name" $
assertEvalFail "getattr-invalid" "builtins.getAttr (builtins.substring 0 1 \"\228\") {}",
-- toXML passes bytes through raw (upstream's serializer never validates)
runTest "toXML passes a mid-codepoint byte through" $
assertEval
"toxml-bytes"
"builtins.stringLength (builtins.toXML (builtins.substring 0 1 \"\228\")) == builtins.stringLength (builtins.toXML \"x\")"
(VBool True),
-- a search-path miss is a CATCHABLE error (upstream ThrownError;
-- nixpkgs' impure.nix relies on tryEval catching it)
runTest "search-path miss is tryEval-catchable" $
assertEval
"findFile-catchable"
"(builtins.tryEval (builtins.findFile builtins.nixPath \"nope-missing\")).success"
(VBool False)
]
-- | readFile returns the file's RAW BYTES: BOMs survive, UTF-16 is not
-- transcoded, invalid UTF-8 is representable, and only NUL is rejected.
-- The expected hashes are computed from the fixture bytes themselves, so
-- the assertions pin "hash of the value = hash of the file's bytes".
testByteStringSemanticsIO :: IO [Bool]
testByteStringSemanticsIO = do
putStrLn "eval/readfile-bytes-io"
tmpDir <- getTemporaryDirectory
let testDir = tmpDir </> "nova-nix-bytefile-test"
bomBytes = BS.pack [0xEF, 0xBB, 0xBF] <> "hi"
-- UTF-16LE BOM + U+0101 (both payload bytes nonzero, so no NUL):
-- raw passthrough is observable as 4 bytes instead of a decoded char.
utf16Bytes = BS.pack [0xFF, 0xFE, 0x01, 0x01]
-- UTF-16LE ASCII interleaves NUL bytes - upstream readFile REJECTS it.
utf16AsciiBytes = BS.pack [0xFF, 0xFE, 0x68, 0x00, 0x69, 0x00]
invalidBytes = "a" <> BS.singleton 0xFF <> "b"
nulBytes = "a" <> BS.singleton 0x00 <> "b"
bracket_
( do
createDirectoryIfMissing True testDir
BS.writeFile (testDir </> "bom.bin") bomBytes
BS.writeFile (testDir </> "utf16.bin") utf16Bytes
BS.writeFile (testDir </> "utf16-ascii.bin") utf16AsciiBytes
BS.writeFile (testDir </> "invalid.bin") invalidBytes
BS.writeFile (testDir </> "nul.bin") nulBytes
BS.writeFile (testDir </> "umlaut.bin") (TE.encodeUtf8 "\228")
)
( do
exists <- doesDirectoryExist testDir
when exists (removeDirectoryRecursive testDir)
)
$ sequence
[ runTestIO
"readFile keeps a BOM (raw bytes)"
testDir
"builtins.stringLength (builtins.readFile ./bom.bin)"
(VInt 5),
runTestIO
"readFile does not transcode UTF-16"
testDir
"builtins.stringLength (builtins.readFile ./utf16.bin)"
(VInt 4),
runTestIOFail
"readFile rejects UTF-16 ASCII (its NUL bytes)"
testDir
"builtins.readFile ./utf16-ascii.bin",
runTestIO
"readFile passes invalid UTF-8 through"
testDir
"builtins.stringLength (builtins.readFile ./invalid.bin)"
(VInt 3),
runTestIO
"readFile bytes hash as read (BOM file)"
testDir
"builtins.hashString \"sha256\" (builtins.readFile ./bom.bin)"
(mkStr (Hash.bytesToHexText (sha256Digest bomBytes))),
runTestIO
"readFile bytes hash as read (UTF-16 file)"
testDir
"builtins.hashString \"sha256\" (builtins.readFile ./utf16.bin)"
(mkStr (Hash.bytesToHexText (sha256Digest utf16Bytes))),
runTestIO
"readFile of invalid UTF-8 hashes its raw bytes"
testDir
"builtins.hashString \"sha256\" (builtins.readFile ./invalid.bin)"
(mkStr (Hash.bytesToHexText (sha256Digest invalidBytes))),
runTestIO
"readFile round-trips a multibyte literal"
testDir
"builtins.readFile ./umlaut.bin == \"\228\""
(VBool True),
runTestIOFail
"readFile rejects an embedded NUL"
testDir
"builtins.readFile ./nul.bin"
]
main :: IO ()
main =
getArgs >>= \case
[flag, name] | flag == arenaGuardChildFlag -> arenaGuardChild name
[flag, source] | flag == evalChildFlag -> bracket_ arenaInit arenaDestroy (evalChild source)
_ -> withRunTempRoot (bracket_ arenaInit arenaDestroy runSuite)
-- | Give the run a temporary root of its own and point the process's
-- temporary directory at it, so every fixture the suite derives from
-- 'getTemporaryDirectory' (each under a fixed name) is this run's alone
-- and two suites running at once cannot delete each other's (#254).
-- @TMPDIR@ is what POSIX reads, @TMP@ and @TEMP@ what Windows'
-- @GetTempPath@ reads; a child process inherits them. The root is named
-- for this process, so no live run shares it, and one a crashed run left
-- under the same PID is cleared first.
withRunTempRoot :: IO a -> IO a
withRunTempRoot action = do
base <- getTemporaryDirectory
pid <- Proc.getCurrentPid
let root = base </> ("nova-nix-test-" <> show pid)
Dir.removePathForcibly root
Dir.createDirectory root
mapM_ (`setEnv` root) ["TMPDIR", "TMP", "TEMP"]
action `finally` Dir.removePathForcibly root
-- | Every group, under the one arena bracket.
runSuite :: IO ()
runSuite = do
hSetBuffering stdout LineBuffering
putStrLn "nova-nix test suite"
putStrLn "==================="
results <-
concat
<$> sequence
[ testExprTypes,
testStorePaths,
testDerivation,
testTrivialBuildIO,
testSourceDateEpochIO,
testScrubbedBuildEnvIO,
testUnpackBuildIO,
testDependentBuildIO,
testEvalFidelity,
testUpstreamConformance,
testHashHelpers,
testFetchMirrors,
testSubstituterRetry,
testPkgsFetchurl,
testNarKnownAnswer,
testFetchGitTransport,
testFetchGitShallow,
testFetchGitPins,
testPathInterp,
testOutPathCoercion,
testFetchCache,
testExecWrapper,
testAttrPath,
testScratchDirs,
testEvalLiterals,
testEvalVariables,
testEvalArithmetic,
testEvalComparison,
testEvalLogic,
testEvalStrings,
testEvalIfAssert,
testEvalLet,
testEvalAttrs,
testValuePrinter,
testCoercionErrors,
testResultPrinter,
testEvalRecAttrs,
testEvalLists,
testEvalLambda,
testEvalWith,
testEvalBuiltins,
testFromTOML,
testEvalErrors,
testListCoercion,
testEvalHigherOrder,
testLexer,
testParserExprs,
testParserErrors,
testParserIntegration,
testStaticGlobalsSync,
testUndefinedVariables,
testUndefinedVariablesIO,
testBatch1,
testBatch2,
testBatch3,
testBatch4,
testBatch5,
testBatch6,
testBatch7,
testImportPure,
testImportIO,
testBlackholeRecoveryIO,
testDerivationTraceIO,
testFirstArgumentOrderIO,
testStorePathLinksIO,
testDeepContextClosureIO,
testDerivationFields,
testDerivationPathFieldsIO,
testPathArguments,
testPathArgumentsIO,
testPathFilterIO,
testPathSymlinkIO,
testInterpolatedSymlinkIO,
testSourceErrorMessage,
testSourceReadErrorsIO,
testBatchA,
testBatchAIO,
testEnvironmentBytes,
testBatchB,
testBatchC,
testBatchCIO,
testBlackhole,
testCallDepth,
testBatchD,
testBatchE,
testBatchEIO,
testBatchF,
testBatchG,
testBatchH,
testStringContext,
testContextHelpers,
testContextPropagation,
testDrvContext,
testStructuredAttrs,
testDepGraph,
testSubstituter,
testCaseSensitiveVolumeIO,
testFoldingVolumeIO,
testPathLocks,
testExecBit,
testVerifySigs,
testNarInfoValidation,
testNixConfig,
testPushPure,
testPushClosureIO,
testBuildOrchestrator,
testStoreDB,
testParseStorePath,
testStoreOps,
testStoreDelete,
testGcPure,
testStoreGC,
testSymlinkWalksIO,
testLinkOrdering,
testFromATerm,
testBuilder,
testE2E,
testExecWrapperCLI,
testPhase4,
testPhase4IO,
testToJSONPathIO,
testByteStringSemantics,
testByteStringSemanticsIO,
testSymbol,
testCAttrSet,
testCThunk,
testArenaGuard,
testBytecodeCompile,
testBytecodeCountSpill,
testBytecodePerElement,
testValueCountWidths,
testStoreNameSinks,
testNarNameSafety,
testStoreNameSinksIO,
testClassIFollowups,
testClassIFollowupsIO,
testAbsolutePathStrings,
testEvalPolicyRules,
testEvalPolicyIO,
testEvalPolicyCLI,
testResultPrinterCLI,
testConfigBytesCLI,
testInterruptsPropagate
]
let total = length results
passed = length (filter id results)
failed = total - passed
putStrLn $ "\n" ++ show passed ++ "/" ++ show total ++ " passed"
if failed > 0
then do
putStrLn $ show failed ++ " FAILED"
exitFailure
else do
putStrLn "All tests passed."
exitSuccess
-- ---------------------------------------------------------------------------
-- Tests: evaluation policy - restricted and pure modes (#75)
-- ---------------------------------------------------------------------------
-- | A string naming a relative path is refused wherever a path is coerced
-- from a string, as upstream's coerceToPath refuses it ("string '%s'
-- doesn't represent an absolute path", observed from nix-instantiate
-- 2.33.2 in every mode). Load bearing for the access policy: a relative
-- string would be checked against one location and opened at another.
testAbsolutePathStrings :: IO [Bool]
testAbsolutePathStrings = do
putStrLn "eval/absolute-path-strings"
tmpBase <- getTemporaryDirectory
let testDir = tmpBase </> "nova-nix-test-abs-strings"
relativeRefused label source =
runTestM label $ do
result <- evalNixIO testDir source
pure $ case result of
Left err
| "string 'foo' doesn't represent an absolute path" `T.isInfixOf` err -> Pass
| otherwise -> Fail ("expected the absolute-path refusal, got: " <> err)
Right val -> Fail ("expected a refusal, got: " <> T.pack (show val))
bracket_
(createDirectoryIfMissing True testDir >> BS.writeFile (testDir </> "foo") "1\n")
(forceRemoveIfExists testDir)
$ sequence
[ relativeRefused "readFile of a relative string" "builtins.readFile \"foo\"",
relativeRefused "import of a relative string" "import \"foo\"",
relativeRefused "pathExists of a relative string is an error, not false" "builtins.pathExists \"foo\"",
relativeRefused "readDir of a relative string" "builtins.readDir \"foo\"",
relativeRefused "readFileType of a relative string" "builtins.readFileType \"foo\"",
relativeRefused "hashFile of a relative string" "builtins.hashFile \"sha256\" \"foo\"",
relativeRefused "scopedImport of a relative string" "builtins.scopedImport { } \"foo\"",
-- The search-path miss carries upstream's hint, byte for byte.
runTest "a search path miss names the hint" $
assertEqual
"miss"
(Left "file 'nope' was not found in the Nix search path (add it using $NIX_PATH or -I)")
(evalNix "<nope>")
]
-- | The policies under test.
restrictedPolicy, purePolicy :: EvalPolicy
restrictedPolicy = unrestrictedPolicy {epRestrictEval = True}
purePolicy = unrestrictedPolicy {epPureEval = True}
-- | Parse and evaluate in 'PureEval' with the given policy's builtins
-- table, for the constants the table itself decides.
evalNixWith :: EvalPolicy -> Text -> Either Text NixValue
evalNixWith policy source = case parseNixWithScope (rootScopeNames policy) testBaseDir "<test>" source of
Left err -> Left (sourceFailure err)
Right expr -> runPureEval (eval (builtinEnv policy 0 []) expr)
-- | The pure rules behind the modes, each pinned to upstream's code at
-- 2.24.9: CanonPath::isAllowed over the allow list, isAllowedURI and
-- checkURI over allowed-uris, the git input's URL form, the nix.conf
-- settings, and the builtins table under pure-eval.
testEvalPolicyRules :: IO [Bool]
testEvalPolicyRules = do
putStrLn "eval/policy-rules"
let oneRoot = allowPathIn "/a/b" noAllowedPaths
twoRoots = allowPathIn "/x" oneRoot
driveRoot = allowPathIn "C:/a/b" noAllowedPaths
github = ["https://github.com/NixOS"]
-- Successive nix.conf texts, weakest first, served to the expander
-- as files.
config texts =
let paths = [asciiOsPath ("/policy/" ++ show index ++ ".conf") | index <- [1 .. length texts]]
files = Map.fromList (zip paths texts)
readFrom path = Identity (maybe (Left Config.ConfigFileMissing) Right (Map.lookup path files))
in runIdentity (Config.loadConfig readFrom paths Nothing)
cfgPure = fmap ncPureEval . config
cfgRestrict = fmap ncRestrictEval . config
cfgUris = fmap ncAllowedUris . config
sequence
[ -- CanonPath::isAllowed
runTest "an allowed prefix admits itself" $
assertEqual "self" True (isAllowedPath oneRoot "/a/b"),
runTest "an allowed prefix admits what lies within it" $
assertEqual "within" True (isAllowedPath oneRoot "/a/b/c/d"),
runTest "an allowed prefix admits its ancestors" $
assertEqual "ancestor" True (isAllowedPath oneRoot "/a") `andThen` assertEqual "root" True (isAllowedPath oneRoot "/"),
runTest "a sibling sharing a text prefix is not within" $
assertEqual "sibling" False (isAllowedPath oneRoot "/a/bc"),
runTest "a path beside the prefix is refused" $
assertEqual "beside" False (isAllowedPath oneRoot "/a/c") `andThen` assertEqual "elsewhere" False (isAllowedPath twoRoots "/y"),
runTest "nothing allowed admits nothing, the root included" $
assertEqual "empty" False (isAllowedPath noAllowedPaths "/") `andThen` assertEqual "empty-etc" False (isAllowedPath noAllowedPaths "/etc"),
runTest "the spelling of an allowed prefix is canonicalized" $
assertEqual "canon" True (isAllowedPath (allowPathIn "/a//b/./" noAllowedPaths) "/a/b/c"),
-- The rules are platform-independent, so a Windows path value
-- (C:/..., the drive designator its first component) is decided
-- the same on every host.
runTest "a drive designator is the first component" $
assertEqual "within" True (isAllowedPath driveRoot "C:/a/b/c")
`andThen` assertEqual "self" True (isAllowedPath driveRoot "C:/a/b")
`andThen` assertEqual "drive-root" True (isAllowedPath driveRoot "C:/")
`andThen` assertEqual "beside" False (isAllowedPath driveRoot "C:/a/c")
`andThen` assertEqual "sibling" False (isAllowedPath driveRoot "C:/a/bc")
`andThen` assertEqual "other-drive" False (isAllowedPath driveRoot "D:/a/b/c")
`andThen` assertEqual "rootless" False (isAllowedPath driveRoot "/a/b/c")
`andThen` assertEqual "first" "C:/" (joinComponents (take 1 (pathComponents "C:/a/b")))
`andThen` assertEqual "first-posix" "/a" (joinComponents (take 1 (pathComponents "/a/b"))),
-- isAllowedURI
runTest "a URI equal to a prefix is allowed" $
assertEqual "equal" True (isAllowedUri github "https://github.com/NixOS"),
runTest "a URI under a prefix at a slash boundary is allowed" $
assertEqual "subpath" True (isAllowedUri github "https://github.com/NixOS/patchelf.git"),
runTest "a prefix does not admit a longer name" $
assertEqual "github.co" False (isAllowedUri ["https://github.co"] "https://github.com")
`andThen` assertEqual "NixOSx" False (isAllowedUri github "https://github.com/NixOSx"),
runTest "a prefix ending in a slash admits below it but not itself" $
assertEqual "below" True (isAllowedUri ["https://a/dir/"] "https://a/dir/x")
`andThen` assertEqual "itself" False (isAllowedUri ["https://a/dir/"] "https://a/dir"),
runTest "a bare scheme prefix admits its whole scheme" $
assertEqual "https:" True (isAllowedUri ["https:"] "https://anything/at/all")
`andThen` assertEqual "git+file:" True (isAllowedUri ["git+file:"] "git+file:///repo?exportIgnore=1")
`andThen` assertEqual "http:" False (isAllowedUri ["https:"] "http://x"),
-- checkURI
runTest "nothing is checked unless restrict-eval is on" $
assertEqual "off" (Right ()) (uriAccess purePolicy noAllowedPaths "https://x"),
runTest "a URI outside the list is refused with upstream's wording" $
assertEqual "refused" (Left "access to URI 'https://x/y' is forbidden in restricted mode") (uriAccess restrictedPolicy noAllowedPaths "https://x/y"),
runTest "a path URI is checked against the allowed paths" $
assertEqual "allowed" (Right ()) (uriAccess restrictedPolicy oneRoot "/a/b/f")
`andThen` assertEqual "refused" (Left "access to absolute path '/etc/passwd' is forbidden in restricted mode") (uriAccess restrictedPolicy oneRoot "/etc/passwd"),
runTest "a file URL is checked as its path, rooted" $
assertEqual "allowed" (Right ()) (uriAccess restrictedPolicy oneRoot "file:///a/b/f")
`andThen` assertEqual "rooted" (Left "access to absolute path '/etc/passwd' is forbidden in restricted mode") (uriAccess restrictedPolicy oneRoot "file://etc/passwd"),
runTest "a file URL with a drive is checked as that drive's path" $
assertEqual "allowed" (Right ()) (uriAccess restrictedPolicy driveRoot "file://C:/a/b/f")
`andThen` assertEqual "refused" (Left "access to absolute path 'C:/a/c' is forbidden in restricted mode") (uriAccess restrictedPolicy driveRoot "file://C:/a/c"),
runTest "the path refusal names pure mode when it is on" $
assertEqual "pure" "access to absolute path '/etc' is forbidden in pure evaluation mode (use '--impure' to override)" (forbiddenPathMessage purePolicy "/etc")
`andThen` assertEqual "both" "access to absolute path '/etc' is forbidden in pure evaluation mode (use '--impure' to override)" (forbiddenPathMessage purePolicy {epRestrictEval = True} "/etc"),
-- Input::toURLString for a git input (strings observed from
-- nix-instantiate 2.33.2, whose renderer is 2.24.9's)
runTest "an https url renders with git+ and exportIgnore" $
assertEqual "https" "git+https://github.com/NixOS/patchelf.git?exportIgnore=1" (gitInputUrl (gitInput "https://github.com/NixOS/patchelf.git")),
runTest "a ref follows exportIgnore in key order" $
assertEqual "ref" "git+https://github.com/NixOS/patchelf.git?exportIgnore=1&ref=master" (gitInputUrl (gitInput "https://github.com/NixOS/patchelf.git") {fgaRef = Just "master"}),
runTest "a rev renders lowercase after ref" $
assertEqual "rev" "git+https://h/r?exportIgnore=1&ref=main&rev=aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" (gitInputUrl (gitInput "https://h/r") {fgaRef = Just "main", fgaRev = Just "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"}),
runTest "shallow renders as a flag" $
assertEqual "shallow" "git+ssh://git@github.com/NixOS/patchelf.git?exportIgnore=1&shallow=1" (gitInputUrl (gitInput "ssh://git@github.com/NixOS/patchelf.git") {fgaShallow = True}),
runTest "submodules replaces exportIgnore" $
assertEqual "submodules" "git+https://h/r?submodules=1" (gitInputUrl (gitInput "https://h/r") {fgaSubmodules = True}),
runTest "a bare path becomes a file URL" $
assertEqual "path" "git+file:///p/repo?exportIgnore=1" (gitInputUrl (gitInput "/p/repo")),
runTest "an scp-like remote becomes ssh" $
assertEqual "scp" "git+ssh://git@github.com/NixOS/patchelf.git?exportIgnore=1" (gitInputUrl (gitInput "git@github.com:NixOS/patchelf.git")),
runTest "the git scheme keeps its name" $
assertEqual "git" "git://h/r?exportIgnore=1" (gitInputUrl (gitInput "git://h/r")),
runTest "a path is percent-encoded as upstream encodes it" $
assertEqual "space" "git+file:///p/my%20repo?exportIgnore=1" (gitInputUrl (gitInput "/p/my repo")),
-- nix.conf
runTest "pure-eval and restrict-eval parse upstream's Boolean spellings" $
assertEqual "true" (Right True) (cfgPure ["pure-eval = true"])
`andThen` assertEqual "yes" (Right True) (cfgPure ["pure-eval = yes"])
`andThen` assertEqual "1" (Right True) (cfgRestrict ["restrict-eval = 1"])
`andThen` assertEqual "false" (Right False) (cfgPure ["pure-eval = true", "pure-eval = false"])
`andThen` assertEqual "no" (Right False) (cfgRestrict ["restrict-eval = no"])
`andThen` assertEqual "0" (Right False) (cfgRestrict ["restrict-eval = 0"]),
runTest "a misspelled Boolean is an error with upstream's wording" $
assertEqual "typo" (Left "Boolean setting 'pure-eval' has invalid value 'ture'") (cfgPure ["pure-eval = ture"]),
runTest "allowed-uris is a list and extra- appends to it" $
assertEqual "uris" (Right ["https://a", "https://b", "https://c"]) (cfgUris ["allowed-uris = https://a https://b", "extra-allowed-uris = https://c"]),
runTest "extra- on a Boolean names no setting and is ignored" $
assertEqual "extra-bool" (Right False) (cfgPure ["extra-pure-eval = true"]),
runTest "the default config has both modes off" $
assertEqual "defaults" (Right (False, False, [])) ((\c -> (ncRestrictEval c, ncPureEval c, ncAllowedUris c)) <$> config []),
-- the builtins table
runTest "currentTime and currentSystem are absent under pure-eval" $
assertEqual "time" (Right (VBool False)) (evalNixWith purePolicy "builtins ? currentTime")
`andThen` assertEqual "system" (Right (VBool False)) (evalNixWith purePolicy "builtins ? currentSystem")
`andThen` assertEqual "time-restricted" (Right (VBool True)) (evalNixWith restrictedPolicy "builtins ? currentTime")
`andThen` assertEqual "time-default" (Right (VBool True)) (evalNixWith unrestrictedPolicy "builtins ? currentSystem")
]
where
gitInput url =
FetchGitArgs
{ fgaUrl = url,
fgaName = "source",
fgaRef = Nothing,
fgaRev = Nothing,
fgaSubmodules = False,
fgaShallow = False,
fgaAllRefs = False,
fgaNarHash = Nothing
}
-- | 'evalNixIO' under a policy: the roots are allowed first, and the
-- search path is what the caller passes, as the CLI would pass it.
evalPolicyIO :: EvalPolicy -> [Text] -> [Thunk] -> FilePath -> Text -> IO (Either Text NixValue)
evalPolicyIO policy roots searchPaths baseDir source = do
storeDir <- evalNixIOStoreDir
case parseNixWithScope (rootScopeNames policy) baseDir "<test>" source of
Left err -> pure (Left (T.pack (show err)))
Right expr -> do
st0 <- newEvalState storeDir baseDir
let st = st0 {esPolicy = policy, esSearchPaths = searchPaths}
mapM_ (allowEvalPath st) roots
runEvalIO st (eval (builtinEnv policy (esTimestamp st) searchPaths) expr)
-- | The battery the modes were pinned against, run through EvalIO: every
-- expression here was run through nix-instantiate under restrict-eval and
-- pure-eval, and the expected text is what upstream printed, except where
-- the oracle version (2.24.9) differs from the installed 2.33.2 and the
-- oracle's source wins (which prefix a refusal names, the fetchGit
-- wording). The fixture lives at a symlink-free root: a root behind a
-- symlinked directory is refused by upstream too, since its allow list
-- holds the spelling given and the walk resolves the link.
testEvalPolicyIO :: IO [Bool]
testEvalPolicyIO = do
putStrLn "eval/policy-io"
tmpBase <- getTemporaryDirectory >>= Dir.canonicalizePath
links <- symlinksAvailable
let root = tmpBase </> "nova-nix-test-policy"
allowed = root </> "allowed"
outside = root </> "outside"
repo = allowed </> "repo"
pathText = canonPathValue . T.pack
forbidden policy p = "access to absolute path '" <> pathText p <> "' is forbidden " <> modeText policy
modeText policy
| epPureEval policy = "in pure evaluation mode (use '--impure' to override)"
| otherwise = "in restricted mode"
-- The first prefix the walk pushes: /tmp on Linux, /private on
-- macOS, the drive root C:/ on Windows.
firstComponent = joinComponents (take 1 (pathComponents (pathText allowed)))
-- A fixture path as a path literal, relative to the base directory
-- (allowed): the one spelling that lexes as a path on every
-- platform, since a drive-letter path (C:/...) is a URI token to
-- upstream's lexer and to this one.
lit p = "../" <> pathText (makeRelative root p)
quoted p = "\"" <> pathText p <> "\""
run policy roots = evalPolicyIO policy roots [] allowed
restricted = run restrictedPolicy [pathText allowed]
pureRun = run purePolicy [pathText allowed]
withUris uris = run restrictedPolicy {epAllowedUris = uris} [pathText allowed]
expectLeft label expected action =
runTestM label $ do
result <- action
pure $ case result of
Left err -> assertEqual label expected err
Right val -> Fail (label <> ": expected a refusal, got " <> T.pack (show val))
expectRight label expected action =
runTestM label $ assertRight label <$> action <*> pure (assertEqual label expected)
expectRightWith label check action =
runTestM label $ (\r -> assertRight label r check) <$> action
repoUrl = "git+file://" <> pathText repo <> "?exportIgnore=1"
unrestricted = run unrestrictedPolicy []
symlinkMessage p = "path '" <> pathText p <> "' is a symlink"
-- A case that needs a symlink on disk, or the record of why it did
-- not run.
linked label mk = if links then mk label else runTest (label <> " (skipped: no symlinks here)") Pass
bracket_
( do
forceRemoveIfExists root
createDirectoryIfMissing True (allowed </> "sub")
createDirectoryIfMissing True outside
BS.writeFile (allowed </> "data.txt") "hello\n"
BS.writeFile (allowed </> "sub" </> "data.txt") "inner\n"
BS.writeFile (allowed </> "y.nix") "7\n"
BS.writeFile (outside </> "x.nix") "42\n"
BS.writeFile (outside </> "secret.txt") "secret\n"
when links $ do
Dir.createFileLink (outside </> "secret.txt") (allowed </> "link")
Dir.createDirectoryLink outside (allowed </> "dirlink")
Dir.createFileLink "nowhere" (allowed </> "dangling")
createDirectoryIfMissing True (allowed </> "dir")
Dir.createFileLink (outside </> "x.nix") (allowed </> "dir" </> "default.nix")
createDirectoryIfMissing True repo
_ <- fixtureGit repo ["init", "--quiet"]
BS.writeFile (repo </> "f.txt") "in repo\n"
_ <- fixtureGit repo ["add", "-A"]
_ <- fixtureGit repo ["commit", "--quiet", "-m", "init"]
pure ()
)
(forceRemoveIfExists root)
$ do
rev <- T.strip <$> fixtureGit repo ["rev-parse", "HEAD"]
-- The fetch cache writes under XdgCache; point it at the fixture for
-- the duration so the suite never touches the developer's cache.
savedCacheHome <- lookupEnv "XDG_CACHE_HOME"
setEnv "XDG_CACHE_HOME" (root </> "cache")
results <-
sequence
[ -- restricted: the allow list
expectRight "a file under an allowed root reads" (mkStr "hello\n") (restricted ("builtins.readFile " <> lit (allowed </> "data.txt"))),
expectRight "a file deeper under an allowed root reads" (mkStr "inner\n") (restricted ("builtins.readFile " <> lit (allowed </> "sub" </> "data.txt"))),
expectLeft "a file beside the allowed root is refused, naming the first prefix outside the list" (forbidden restrictedPolicy outside) (restricted ("builtins.readFile " <> lit (outside </> "secret.txt"))),
expectLeft "with nothing allowed the refusal names the first component" (forbidden restrictedPolicy (T.unpack firstComponent)) (run restrictedPolicy [] ("builtins.readFile " <> lit (allowed </> "data.txt"))),
expectLeft "a string spelling the path is refused the same way" (forbidden restrictedPolicy outside) (restricted ("builtins.readFile " <> quoted (outside </> "secret.txt"))),
expectRight "import under the root works" (VInt 7) (restricted ("import " <> lit (allowed </> "y.nix"))),
expectLeft "import beside the root is refused" (forbidden restrictedPolicy outside) (restricted ("import " <> lit (outside </> "x.nix"))),
expectRight "pathExists is true under the root" (VBool True) (restricted ("builtins.pathExists " <> lit (allowed </> "data.txt"))),
expectRight "pathExists is false beside it, not an error" (VBool False) (restricted ("builtins.pathExists " <> lit (outside </> "secret.txt"))),
expectRightWith "readDir under the root lists" (\case VAttrs attrs -> assertEqual "entries" True (attrSetSize attrs == 1); other -> Fail (T.pack (show other))) (restricted ("builtins.readDir " <> lit (allowed </> "sub"))),
expectLeft "readDir beside the root is refused" (forbidden restrictedPolicy outside) (restricted ("builtins.readDir " <> lit outside)),
expectLeft "readFileType names the path asked for, no walk" (forbidden restrictedPolicy (outside </> "secret.txt")) (restricted ("builtins.readFileType " <> lit (outside </> "secret.txt"))),
expectLeft "hashFile walks like readFile" (forbidden restrictedPolicy outside) (restricted ("builtins.hashFile \"sha256\" " <> lit (outside </> "secret.txt"))),
expectRight "getEnv answers empty" (mkStr "") (restricted "builtins.getEnv \"PATH\""),
expectRight "a toFile result is readable afterwards" (mkStr "y") (restricted "builtins.readFile (builtins.toFile \"x\" \"y\")"),
expectRightWith "a source copy under the root is allowed" (\case VStr s _ -> assertEqual "store" True (BS.isPrefixOf "/nix/store/" s); other -> Fail (T.pack (show other))) (restricted "\"${./data.txt}\""),
expectLeft "a source copy beside the root is refused" (forbidden restrictedPolicy outside) (restricted ("\"${" <> lit (outside </> "secret.txt") <> "}\"")),
expectLeft "builtins.path beside the root is refused" (forbidden restrictedPolicy outside) (restricted ("builtins.path { path = " <> lit (outside </> "secret.txt") <> "; }")),
expectLeft "filterSource beside the root is refused" (forbidden restrictedPolicy outside) (restricted ("builtins.filterSource (p: t: true) " <> lit outside)),
expectLeft "tryEval does not catch a refusal" (forbidden restrictedPolicy outside) (restricted ("builtins.tryEval (builtins.readFile " <> lit (outside </> "secret.txt") <> ")")),
linked "a symlink under the root pointing outside is refused at its target" (\label -> expectLeft label (forbidden restrictedPolicy outside) (restricted ("builtins.readFile " <> lit (allowed </> "link")))),
linked "a directory import whose default.nix is a symlink outside the root is refused at the link's target" (\label -> expectLeft label (forbidden restrictedPolicy outside) (restricted ("import " <> lit (allowed </> "dir")))),
linked "scopedImport of that directory is refused the same way" (\label -> expectLeft label (forbidden restrictedPolicy outside) (restricted ("builtins.scopedImport {} " <> lit (allowed </> "dir")))),
linked "pathExists checks a symlink to a forbidden file in place: true" (\label -> expectRight label (VBool True) (restricted ("builtins.pathExists " <> lit (allowed </> "link")))),
linked "pathExists checks a symlink to a forbidden directory in place: true" (\label -> expectRight label (VBool True) (restricted ("builtins.pathExists " <> lit (allowed </> "dirlink")))),
linked "pathExists of a dangling symlink is true" (\label -> expectRight label (VBool True) (restricted ("builtins.pathExists " <> lit (allowed </> "dangling")))),
linked "pathExists through a symlinked directory follows the ancestor, which is refused: false" (\label -> expectRight label (VBool False) (restricted ("builtins.pathExists " <> lit (allowed </> "dirlink" </> "secret.txt")))),
linked "pathExists with a trailing slash follows the final link, which is refused: false" (\label -> expectRight label (VBool False) (restricted ("builtins.pathExists \"" <> pathText (allowed </> "dirlink") <> "/\""))),
linked "readFileType through a symlinked directory is refused at the symlink" (\label -> expectLeft label (symlinkMessage (allowed </> "dirlink")) (restricted ("builtins.readFileType " <> lit (allowed </> "dirlink" </> "secret.txt")))),
linked "readFileType through a symlinked directory is refused in the default mode too" (\label -> expectLeft label (symlinkMessage (allowed </> "dirlink")) (unrestricted ("builtins.readFileType " <> lit (allowed </> "dirlink" </> "secret.txt")))),
linked "pathExists of a dangling symlink is true in the default mode too" (\label -> expectRight label (VBool True) (unrestricted ("builtins.pathExists " <> lit (allowed </> "dangling")))),
linked "builtins.path resolves a symlink root and stores its target" (\label -> expectRight label (mkStr "directory") (unrestricted ("builtins.readFileType (builtins.path { path = " <> lit (allowed </> "dirlink") <> "; })"))),
linked "filterSource resolves a symlink root and stores its target" (\label -> expectRight label (mkStr "directory") (unrestricted ("builtins.readFileType (builtins.filterSource (p: t: true) " <> lit (allowed </> "dirlink") <> ")"))),
expectRight "pathExists with a trailing slash on a file is false" (VBool False) (unrestricted ("builtins.pathExists \"" <> pathText (allowed </> "data.txt") <> "/\"")),
expectRight "pathExists with a trailing slash on a directory is true" (VBool True) (unrestricted ("builtins.pathExists \"" <> pathText (allowed </> "sub") <> "/\"")),
expectRight "pathExists with a trailing slash and dot on a directory is true" (VBool True) (unrestricted ("builtins.pathExists \"" <> pathText (allowed </> "sub") <> "/.\"")),
-- restricted: URIs
expectLeft "a fetch of an unlisted URI is refused before any download" "access to URI 'https://example.invalid/x' is forbidden in restricted mode" (restricted "builtins.fetchurl \"https://example.invalid/x\""),
expectLeft "a file URL beside the root is refused as its path" (forbidden restrictedPolicy (outside </> "secret.txt")) (restricted ("builtins.fetchurl \"file://" <> pathText (outside </> "secret.txt") <> "\"")),
expectRightWith "a file URL under the root fetches" (\case VPath p -> assertEqual "store" True (T.isPrefixOf "/nix/store/" p); other -> Fail (T.pack (show other))) (restricted ("builtins.fetchurl { url = \"file://" <> pathText (allowed </> "data.txt") <> "\"; sha256 = \"5891b5b522d5df086d0ff0b110fbd9d21bb4fc7163af34d08286a2e846f6be03\"; }")),
expectLeft "fetchTarball of an unlisted URI is refused" "access to URI 'https://example.invalid/x.tar.gz' is forbidden in restricted mode" (restricted "builtins.fetchTarball \"https://example.invalid/x.tar.gz\""),
expectLeft "an allowed-uris prefix admits only its subpaths" "access to URI 'https://example.invalid/dir2/x' is forbidden in restricted mode" (withUris ["https://example.invalid/dir"] "builtins.fetchurl { url = \"https://example.invalid/dir2/x\"; sha256 = \"5891b5b522d5df086d0ff0b110fbd9d21bb4fc7163af34d08286a2e846f6be03\"; }"),
runTestM "an allowed-uris prefix lets the fetch proceed to the network" $ do
result <- withUris ["https://example.invalid/dir"] "builtins.fetchurl { url = \"https://example.invalid/dir/x\"; sha256 = \"5891b5b522d5df086d0ff0b110fbd9d21bb4fc7163af34d08286a2e846f6be03\"; }"
pure $ case result of
Left err | "is forbidden" `T.isInfixOf` err -> Fail ("the gate refused an allowed URI: " <> err)
_ -> Pass,
expectLeft "fetchGit of an allowed path is still a URI, checked in its git+file form" ("access to URI '" <> repoUrl <> "' is forbidden in restricted mode") (restricted ("builtins.fetchGit " <> quoted repo)),
expectRight "an allowed git+file prefix admits the fetch and its tree is readable afterwards" (mkStr "in repo\n") (withUris ["git+file://" <> pathText allowed] ("builtins.readFile ((builtins.fetchGit " <> quoted repo <> ").outPath + \"/f.txt\")")),
-- restricted: the search path
expectRight "a search path root is where <name> resolves and reads" (VInt 7) (evalPolicyIO restrictedPolicy [pathText allowed] (parseNixPath (TE.encodeUtf8 ("allowed=" <> pathText allowed))) allowed "import <allowed/y.nix>"),
expectLeft "a search path miss carries the NIX_PATH hint and is catchable" "file 'nope' was not found in the Nix search path (add it using $NIX_PATH or -I)" (restricted "<nope>"),
expectRight "tryEval catches the miss" (VBool False) (restricted "(builtins.tryEval <nope>).success"),
-- pure
expectLeft "pure mode refuses with its own clause" (forbidden purePolicy outside) (pureRun ("builtins.readFile " <> lit (outside </> "secret.txt"))),
expectRight "pure mode still reads under an allowed root" (mkStr "hello\n") (pureRun ("builtins.readFile " <> lit (allowed </> "data.txt"))),
expectRight "pure mode has no currentTime" (VBool False) (pureRun "builtins ? currentTime"),
expectLeft "pure mode words the search path miss differently" "cannot look up '<nope>' in pure evaluation mode (use '--impure' to override)" (pureRun "<nope>"),
expectRight "the pure miss is catchable too" (VBool False) (pureRun "(builtins.tryEval <nope>).success"),
expectLeft "storePath is refused in pure mode before its argument is read" "'builtins.storePath' is not allowed in pure evaluation mode" (pureRun "builtins.storePath 42"),
expectLeft "fetchurl needs a hash in pure mode, checked before any download" "in pure evaluation mode, 'fetchurl' requires a 'sha256' argument" (pureRun "builtins.fetchurl \"https://example.invalid/x\""),
expectLeft "fetchTarball needs a hash in pure mode" "in pure evaluation mode, 'fetchTarball' requires a 'sha256' argument" (pureRun "builtins.fetchTarball \"https://example.invalid/x.tar.gz\""),
expectLeft "fetchGit without a rev is unlocked in pure mode" ("in pure evaluation mode, 'fetchGit' will not fetch unlocked input '" <> repoUrl <> "'") (pureRun ("builtins.fetchGit " <> quoted repo)),
expectRight "fetchGit with a rev is locked and fetches in pure mode" (mkStr "in repo\n") (pureRun ("builtins.readFile ((builtins.fetchGit { url = " <> quoted repo <> "; rev = \"" <> rev <> "\"; }).outPath + \"/f.txt\")")),
expectLeft "a home-relative literal cannot resolve in pure mode" "the path '~/x' can not be resolved in pure mode" (pureRun "~/x"),
expectRight "pure mode's getEnv answers empty" (mkStr "") (pureRun "builtins.getEnv \"PATH\""),
expectRight "a path literal is a value, read or not" (mkStr (pathText (outside </> "secret.txt"))) (pureRun ("builtins.toString " <> lit (outside </> "secret.txt"))),
-- unrestricted stays unrestricted
expectRight "the default policy reads anywhere" (mkStr "secret\n") (run unrestrictedPolicy [] ("builtins.readFile " <> lit (outside </> "secret.txt")))
]
maybe (unsetEnv "XDG_CACHE_HOME") (setEnv "XDG_CACHE_HOME") savedCacheHome
pure results
-- | The flags and settings through the binary: the modes select
-- themselves from the command line and from NIX_CONFIG, and a refusal
-- surfaces as the eval error it is.
testEvalPolicyCLI :: IO [Bool]
testEvalPolicyCLI = do
putStrLn "cli/eval-policy"
tmpBase <- getTemporaryDirectory >>= Dir.canonicalizePath
ambient <- getEnvironment
cwd <- Dir.getCurrentDirectory
let root = tmpBase </> "nova-nix-test-cli-policy"
-- Where a channel: entry would land if it were taken for a path.
cwdChannelEntry = T.unpack (canonPathValue (T.pack (cwd </> "channel:nova-probe")))
allowed = root </> "allowed"
-- A string, since a drive-letter path (C:/...) is a URI token and
-- a native spelling (C:\...) is no token at all; an absolute
-- string is coerced to a path on every platform.
outsideFile = T.unpack (canonPathValue (T.pack (root </> "outside.txt")))
isolate extraConfig =
("NIX_CONFIG", "substituters =\ntrusted-public-keys =\n" <> extraConfig)
: ("XDG_CONFIG_HOME", root </> "config")
: filter (\(key, _) -> key `notElem` ["NIX_CONFIG", "XDG_CONFIG_HOME", "NIX_PATH"]) ambient
runCLI extraConfig args =
Proc.readCreateProcessWithExitCode
((Proc.proc "cabal" (["run", "-v0", "nova-nix", "--"] ++ args)) {Proc.env = Just (isolate extraConfig)})
""
expectOut label extraConfig args expected =
runTestM ("CLI " <> label) $ do
(code, out, err) <- runCLI extraConfig args
pure $ case (code, lines out) of
(ExitSuccess, line : _) -> assertEqual label expected line
_ -> Fail ("CLI: " <> T.pack (show code) <> "; stdout=" <> T.pack out <> "; stderr=" <> T.pack err)
expectErr label extraConfig args needle =
runTestM ("CLI " <> label) $ do
(code, _, err) <- runCLI extraConfig args
pure $
if code /= ExitSuccess && needle `T.isInfixOf` T.pack err
then Pass
else Fail ("expected a failure mentioning " <> needle <> ", got " <> T.pack (show (code, err)))
bracket_
( do
forceRemoveIfExists root
createDirectoryIfMissing True allowed
BS.writeFile (allowed </> "data.txt") "hello\n"
BS.writeFile (root </> "outside.txt") "no\n"
)
(forceRemoveIfExists root)
$ sequence
[ expectOut "--pure-eval hides currentTime" "" ["eval", "--pure-eval", "--expr", "builtins ? currentTime"] "false",
expectOut "--restrict-eval empties getEnv" "" ["eval", "--restrict-eval", "--expr", "builtins.getEnv \"HOME\""] "\"\"",
expectOut "pure-eval from NIX_CONFIG" "pure-eval = true\n" ["eval", "--expr", "builtins ? currentSystem"] "false",
expectOut "a --nix-path root is readable under --restrict-eval" "" ["eval", "--restrict-eval", "--nix-path", "allowed=" ++ allowed, "--expr", "builtins.readFile <allowed/data.txt>"] "\"hello\\n\"",
expectErr "a read outside the roots fails the command" "" ["eval", "--restrict-eval", "--expr", "builtins.readFile \"" ++ outsideFile ++ "\""] "is forbidden in restricted mode",
expectErr "a channel: search path entry allows nothing" "" ["eval", "--restrict-eval", "--nix-path", "nixpkgs=channel:nova-probe", "--expr", "builtins.readFile \"" ++ cwdChannelEntry ++ "\""] "is forbidden in restricted mode",
expectOut "build accepts the flag before its target" "" ["build", "--pure-eval", "--help"] "Usage: nova-nix [--nix-path NAME=PATH] <command>"
]
-- | The eval result through the binary: stdout carries the printer's bytes
-- and a bare newline, with no text encoding or newline translation between.
testResultPrinterCLI :: IO [Bool]
testResultPrinterCLI = do
putStrLn "cli/eval-result"
tmpBase <- getTemporaryDirectory
ambient <- getEnvironment
let root = tmpBase </> "nova-nix-test-cli-result"
file = root </> "latin1"
notUtf8 = "a" <> BS.singleton 0xfc <> "b"
-- A string, as in testEvalPolicyCLI: a drive-letter path is no
-- path literal.
fileString = T.unpack (canonPathValue (T.pack file))
isolated =
("XDG_CONFIG_HOME", root </> "config")
: filter (\(key, _) -> key `notElem` ["NIX_CONFIG", "XDG_CONFIG_HOME"]) ambient
evalProcess =
(Proc.proc "cabal" ["run", "-v0", "nova-nix", "--", "eval", "--expr", "builtins.readFile \"" ++ fileString ++ "\""])
{ Proc.env = Just isolated,
Proc.std_out = Proc.CreatePipe
}
bracket_
(forceRemoveIfExists root >> createDirectoryIfMissing True root >> BS.writeFile file notUtf8)
(forceRemoveIfExists root)
$ sequence
[ runTestM "CLI eval writes a string's bytes and a bare newline" $
Proc.withCreateProcess evalProcess $ \_ stdoutPipe _ process -> case stdoutPipe of
Nothing -> pure (Fail "no stdout pipe")
Just out -> do
printed <- BS.hGetContents out
code <- Proc.waitForProcess process
pure $ case code of
ExitSuccess -> assertEqual "cli-result" ("\"" <> notUtf8 <> "\"\n") printed
ExitFailure _ -> Fail ("CLI: " <> T.pack (show code))
]
-- | nix.conf bytes through the binary (#244): an include target, the
-- system directory and NIX_CONFIG reach the file system and the settings
-- as the bytes they hold. Each case reads whether pure-eval came on,
-- which hides currentSystem. A name that is not UTF-8 exists only on a
-- volume that holds one, so a case needing such a name makes it first
-- and skips, with the reason, where the temp volume refuses it: APFS
-- refuses the name, and HFS+ holds it but opens no path beneath a
-- directory so named. A Windows name or variable is UTF-16 and holds no
-- such byte at all. The decoy cases need no such name: a file named by
-- U+FFFD's UTF-8, which a lossy decode of the byte would open instead,
-- must stay unread, as it does under nix-instantiate 2.33.2.
testConfigBytesCLI :: IO [Bool]
testConfigBytesCLI = do
putStrLn "cli/config-bytes"
tmpBase <- getTemporaryDirectory
ambient <- getEnvironment
let root = tmpBase </> "nova-nix-test-cli-config-bytes"
confDir = root </> "etc"
noConfDir = root </> "none"
configVars = ["NIX_CONFIG", "NIX_CONF_DIR", "NIX_USER_CONF_FILES", "XDG_CONFIG_DIRS"]
-- An empty NIX_USER_CONF_FILES names no user files, so only the
-- system file under NIX_CONF_DIR and NIX_CONFIG are read.
runCLI dir nixConfig =
Proc.readCreateProcessWithExitCode
( (Proc.proc "cabal" ["run", "-v0", "nova-nix", "--", "eval", "--expr", "builtins ? currentSystem"])
{ Proc.env = Just (("NIX_CONF_DIR", dir) : ("NIX_USER_CONF_FILES", "") : ("NIX_CONFIG", nixConfig) : filter ((`notElem` configVars) . fst) ambient)
}
)
""
expectAnswer label expected dir nixConfig = do
(code, out, err) <- runCLI dir nixConfig
pure $ case (code, lines out) of
(ExitSuccess, line : _) -> assertEqual label expected line
_ -> Fail ("CLI: " <> T.pack (show code) <> "; stdout=" <> T.pack out <> "; stderr=" <> T.pack err)
expectPure label = expectAnswer label "false"
expectImpure label = expectAnswer label "true"
expectRefusal nixConfig needle = do
(code, _, err) <- runCLI noConfDir nixConfig
pure $
if code /= ExitSuccess && needle `T.isInfixOf` T.pack err
then Pass
else Fail ("expected a failure mentioning " <> needle <> ", got " <> T.pack (show (code, err)))
-- A case whose name or value holds bytes, spelled as the
-- platform's strings carry them.
spelledCase label bytes check = do
spelled <- envSpelling bytes
case spelled of
Nothing -> True <$ putStrLn (" SKIP " <> T.unpack label <> ": a Windows name or variable cannot hold a byte with no UTF-8 reading")
Just spelling -> check spelling
envCase label bytes check = spelledCase label bytes (runTestM label . check)
-- A case over a file whose name holds bytes, made before the case
-- runs and skipped where the temp volume refuses it.
-- A decoy's name is UTF-8, which every volume holds.
decoyCase label bytes make check = spelledCase label bytes $ \name -> make name >> runTestM label (check name)
fileCase label bytes make check = spelledCase label bytes $ \name -> do
made <- try (make name)
case made of
-- The error string alone: the path in the full message holds
-- the very byte stdout's encoding cannot write.
Left (err :: IOException) -> True <$ putStrLn (" SKIP " <> T.unpack label <> ": the temp volume cannot hold a name that is not UTF-8 (" <> ioeGetErrorString err <> ")")
Right () -> runTestM label (check name)
latin1 = "caf\xE9" :: BS.ByteString
-- The name a lossy decode of latin1 spells: U+FFFD's UTF-8.
decoy = "caf\xEF\xBF\xBD" :: BS.ByteString
decoyDir = root </> "decoy"
bracket_
(forceRemoveIfExists root >> createDirectoryIfMissing True confDir >> createDirectoryIfMissing True decoyDir)
(forceRemoveIfExists root)
$ sequence
[ fileCase
"CLI an include target with no UTF-8 reading opens the file it names"
(latin1 <> ".conf")
( \name -> do
BS.writeFile (confDir </> name) "pure-eval = true\n"
BS.writeFile (confDir </> "nix.conf") ("include " <> latin1 <> ".conf\n")
)
(const (expectPure "include-bytes" confDir "")),
fileCase
"CLI a NIX_CONF_DIR holding a byte with no UTF-8 reading names the system file"
latin1
( \name -> do
createDirectoryIfMissing True (root </> name)
BS.writeFile (root </> name </> "nix.conf") "pure-eval = true\n"
)
(\name -> expectPure "conf-dir-bytes" (root </> name) ""),
decoyCase
"CLI an !include target with no UTF-8 reading leaves the U+FFFD-named file unread"
(decoy <> ".conf")
( \name -> do
BS.writeFile (decoyDir </> name) "pure-eval = true\n"
BS.writeFile (decoyDir </> "nix.conf") ("!include " <> latin1 <> ".conf\n")
)
(const (expectImpure "include-decoy" decoyDir "")),
spelledCase "CLI a NIX_CONF_DIR holding such a byte leaves the U+FFFD-named directory unread" latin1 $ \confName ->
decoyCase
"CLI a NIX_CONF_DIR holding such a byte leaves the U+FFFD-named directory unread"
decoy
( \name -> do
createDirectoryIfMissing True (decoyDir </> name)
BS.writeFile (decoyDir </> name </> "nix.conf") "pure-eval = true\n"
)
(const (expectImpure "conf-dir-decoy" (decoyDir </> confName) "")),
envCase
"CLI NIX_CONFIG holding such a byte in a comment and an unknown setting applies the rest"
("trusted-users = " <> latin1 <> "\npure-eval = true # " <> latin1 <> "\n")
(expectPure "env-bytes-ignored" noConfDir),
envCase
"CLI NIX_CONFIG holding such a byte in a list setting is refused"
("pure-eval = true\nextra-substituters = https://" <> latin1 <> ".example\n")
(`expectRefusal` "setting 'substituters' has invalid value"),
envCase
"CLI a Boolean ending in a no-break space is invalid, as upstream splits the line"
"pure-eval = true\xC2\xA0\n"
(`expectRefusal` "Boolean setting 'pure-eval' has invalid value")
]
-- ---------------------------------------------------------------------------
-- Tests: an interrupt stops the operation it reaches (#251)
-- ---------------------------------------------------------------------------
-- | How long 'interruptedAfterStall' lets an action run before
-- interrupting it: far longer than any of these actions takes to reach
-- the read it stalls in.
stallMicros :: Int
stallMicros = 200000
-- | Run an action in a thread of its own, deliver a user interrupt to it
-- once it has had time to stall, and report how it ended: @Left@ the
-- exception that stopped it, or @Right@ the value it returned instead.
interruptedAfterStall :: IO a -> IO (Either SomeException a)
interruptedAfterStall action =
withAsync action $ \running -> do
threadDelay stallMicros
throwTo (asyncThreadId running) UserInterrupt
waitCatch running
-- | Pass when the interrupt is what stopped the action.
interruptPropagated :: (Show a) => Either SomeException a -> TestResult
interruptPropagated outcome = case outcome of
Left err
| fromException err == Just UserInterrupt -> Pass
| otherwise -> Fail ("stopped by another exception: " <> T.pack (show err))
Right value -> Fail ("the interrupt became a value: " <> T.pack (show value))
-- | Run an action while a FIFO sits at the path with a writer that never
-- writes, so a read of the path blocks until something interrupts the
-- reader. A FIFO with no writer at all reads as empty at once, because
-- GHC opens a file non-blocking.
withStalledFifo :: FilePath -> IO a -> IO a
withStalledFifo path action =
bracket_ (Proc.callProcess "mkfifo" [path]) (Dir.removePathForcibly path) $
withBinaryFile path ReadWriteMode (const action)
-- | Each of these operations caught every exception and turned an
-- interrupt into its fallback value: an unreadable file, a cache miss, a
-- failed push. An interrupt now stops it. A file read is made to stall
-- on a FIFO ('withStalledFifo') and interrupted there from another
-- thread, so those cases need POSIX; the request a push makes stalls on
-- the loopback fixture on every platform. A fetch cache write never
-- blocks, so its interrupt is raised from inside the write. The removal
-- behind a build's cleanup neither blocks nor forces anything the caller
-- supplies, so no case reaches it.
testInterruptsPropagate :: IO [Bool]
testInterruptsPropagate = do
putStrLn "exceptions/interrupts-propagate"
tmpBase <- getTemporaryDirectory
let root = tmpBase </> "nova-nix-test-interrupts"
storeDir = StoreDir (root </> "store")
cacheHome = root </> "cache"
inStore = storePathToFilePath storeDir
pushTo base = PushConfig {pcCacheUrl = base, pcApiKey = Nothing, pcCompression = PushNone}
plainDrv =
Derivation
{ drvOutputs = [],
drvInputDrvs = Map.empty,
drvInputSrcs = [],
drvPlatform = currentPlatform,
drvBuilder = builtinUnpackBuilder,
drvArgs = [],
drvEnv = Map.empty
}
unpacking archive = plainDrv {drvEnv = Map.singleton envSrcs (TE.encodeUtf8 (storePathToText defaultStoreDir archive))}
withCacheHome =
bracket
(lookupEnv "XDG_CACHE_HOME" <* setEnv "XDG_CACHE_HOME" cacheHome)
(maybe (unsetEnv "XDG_CACHE_HOME") (setEnv "XDG_CACHE_HOME"))
. const
fifoCase name test
| SI.os == "mingw32" = True <$ putStrLn (" SKIP " ++ T.unpack name ++ ": needs a FIFO")
| otherwise = runTestM name test
forceRemoveIfExists root
createDirectoryIfMissing True (unStoreDir storeDir)
results <- bracket (openStore storeDir) closeStore $ \store ->
sequence
[ runTestM "an interrupt during a push request stops the push" $
withHttpServer (\_ _ -> Trickle) $ \base _ requested -> do
outcome <- withAsync (pushPaths (pushTo base) store [StorePath (T.replicate 32 "a") "pushed"]) $ \pushing -> do
requested
throwTo (asyncThreadId pushing) UserInterrupt
waitCatch pushing
pure (interruptPropagated outcome),
fifoCase "an interrupt serialising a path for a push stops the push" $
withHttpServer (\_ _ -> Send (httpResponse "200 OK" "")) $ \base _ _ -> do
let sp = StorePath (T.replicate 32 "b") "stalled-output"
outcome <- withStalledFifo (inStore sp) (interruptedAfterStall (pushPaths (pushTo base) store [sp]))
pure (interruptPropagated outcome),
fifoCase "an interrupt reading the API key file is not an unreadable key" $ do
let keyFile = root </> "stalled-key"
outcome <- withStalledFifo keyFile (interruptedAfterStall (loadApiKeyFile keyFile))
pure (interruptPropagated outcome),
fifoCase "an interrupt verifying a source tree on disk is not a mismatch" $ do
let sp = StorePath (T.replicate 32 "c") "stalled-source"
sources = Map.singleton (T.pack (root </> "absent-source")) (storePathToText defaultStoreDir sp)
outcome <- withStalledFifo (inStore sp) (interruptedAfterStall (materializeEvalSources store sources))
pure (interruptPropagated outcome),
fifoCase "an interrupt reading a store derivation is not a missing one" $ do
st <- newEvalState storeDir root
let sp = StorePath (T.replicate 32 "d") "stalled.drv"
outcome <- withStalledFifo (inStore sp) (interruptedAfterStall (runEvalIO st (readStoreDerivation sp)))
pure (interruptPropagated outcome),
-- The entry's path is the cache's layout: one file per key, named
-- by the key's SHA-256 (fetchCacheFile).
fifoCase "an interrupt reading the fetch cache is not a cache miss" $
withCacheHome $ do
st <- newEvalState storeDir root
let key = "stalled-entry"
entry = cacheHome </> "nova-nix" </> "fetch" </> T.unpack (Hash.bytesToHexText (sha256Digest (TE.encodeUtf8 key)))
createDirectoryIfMissing True (takeDirectory entry)
outcome <- withStalledFifo entry (interruptedAfterStall (runEvalIO st (lookupFetchCache key)))
pure (interruptPropagated outcome),
-- The entry's text is the interrupt, raised when the write forces it.
runTestM "an interrupt writing the fetch cache is not an unwritable cache" $
withCacheHome $ do
st <- newEvalState storeDir root
outcome <- try (runEvalIO st (writeFetchCache "interrupted-entry" (throw UserInterrupt)))
pure (interruptPropagated outcome),
fifoCase "an interrupt unpacking an archive is not a failed unpack" $ do
let archive = StorePath (T.replicate 32 "f") "stalled.tar"
outcome <- withStalledFifo (inStore archive) (interruptedAfterStall (runBuiltinUnpack storeDir defaultUnpackLimits (unpacking archive) [("out", root </> "stalled-out")]))
pure (interruptPropagated outcome),
fifoCase "an interrupt reading an input derivation is not an unreadable one" $ do
let input = StorePath (T.replicate 32 "g") "stalled-input.drv"
rootDrv = plainDrv {drvInputDrvs = Map.singleton input ["out"]}
config = (defaultBuildConfig storeDir) {bcTmpDir = root </> "build"}
outcome <- withStalledFifo (inStore input) (interruptedAfterStall (buildWithDeps config store rootDrv (StorePath (T.replicate 32 "h") "root.drv")))
pure (interruptPropagated outcome),
-- The failures the unpacker does catch: the zstd decoder reports a
-- corrupt frame with 'error', and a missing archive is an
-- IOException. Each is the archive's failure, not an escape.
runTestM "a corrupt zstd archive and a missing one fail the unpack" $ do
let corrupt = StorePath (T.replicate 32 "i") "corrupt.tar.zst"
missing = StorePath (T.replicate 32 "j") "missing.tar"
BS.writeFile (inStore corrupt) "not a zstd frame"
corruptOutcome <- runBuiltinUnpack storeDir defaultUnpackLimits (unpacking corrupt) [("out", root </> "corrupt-out")]
missingOutcome <- runBuiltinUnpack storeDir defaultUnpackLimits (unpacking missing) [("out", root </> "missing-out")]
pure $ case (corruptOutcome, missingOutcome) of
(Left (1, corruptMsg), Left (1, missingMsg))
| "corrupt.tar.zst" `T.isInfixOf` corruptMsg && "missing.tar" `T.isInfixOf` missingMsg -> Pass
other -> Fail ("expected both unpacks to fail: " <> T.pack (show other))
]
forceRemoveIfExists root
pure results