nova-nix-0.8.0.0: src/Nix/Substituter.hs
{-# LANGUAGE ScopedTypeVariables #-}
-- | Binary substituter - download pre-built paths from remote caches.
--
-- == How substitution works
--
-- Before building a derivation, Nix checks if the output already exists
-- in a binary cache. The protocol:
--
-- 1. Compute the output store path hash from the derivation
-- 2. @GET https:\/\/cache.example.com\/\<hash\>.narinfo@
-- 3. If 200: parse the narinfo (NAR hash, size, references, signature)
-- 4. Validate the narinfo's fields, then verify the signature against a
-- trusted public key
-- 5. @GET https:\/\/cache.example.com\/nar\/\<narhash\>.nar.xz@ and, in
-- one bounded streaming pass, decompress, hash, parse, and unpack
-- into the store path
-- 6. Verify the declared NAR hash and size against the streamed bytes,
-- then re-verify the materialized tree from disk
-- 7. Register in the store DB with references from narinfo
--
-- If the cache doesn't have it (404), fall through to building locally.
--
-- The whole sequence runs under an exclusive per-path lock
-- ('Nix.Store.Lock'), upstream's pathlocks protocol: taken before any
-- deletion or download, validity re-checked under it (another process's
-- finished path is adopted without touching disk), and held until the
-- caller's registration transaction commits.
--
-- == Cache priority
--
-- Multiple caches can be configured, checked in priority order:
--
-- @
-- substituters = https:\/\/cache.novavero.ai https:\/\/cache.nixos.org
-- trusted-public-keys = cache.novavero.ai-1:... cache.nixos.org-1:...
-- @
--
-- Our nova-cache server implements this protocol. The narinfo format,
-- NAR serialization, signature verification - all handled by the
-- @nova-cache@ library. This module orchestrates the HTTP requests
-- and store registration.
module Nix.Substituter
( -- * Substitution
SubstResult (..),
trySubstitute,
-- * Cache configuration
CacheConfig (..),
defaultCacheConfig,
-- * Failure classification
AttemptFailure (..),
attemptFailureMessage,
catchSync,
httpStatusFailure,
compressedBodyCeiling,
downloadCapFor,
-- * Pure helpers (exported for testing)
maxNarInfoBody,
readBodyCapped,
sortCaches,
tryCachesWith,
validateNarInfoFields,
narInfoPreflight,
verifySigs,
verifyNarHash,
verifyNarSize,
narInfoMatchesPath,
decompressorFor,
decompressNar,
streamingDecompressionSupported,
withDecompressedSource,
cappedBodySource,
materializeNarFromSource,
consumeNarStream,
unpackNarEntry,
unpackAndVerify,
clearStaleDestination,
parseReferences,
parseDeriver,
)
where
import Control.Applicative ((<|>))
import Control.Concurrent (threadDelay)
import Control.Exception (Exception, SomeAsyncException (..), SomeException, catch, fromException, onException, throwIO)
import Control.Monad (void)
import qualified Data.ByteString as BS
import Data.IORef (newIORef, readIORef, writeIORef)
import Data.List (sortBy)
import Data.Ord (comparing)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Word (Word64)
import qualified Network.HTTP.Client as HTTP
import qualified Network.HTTP.Client.TLS as HTTPS
import qualified Network.HTTP.Types.Status as HTTP
import Nix.Compression (NarCompression (..), parseNarCompression)
import Nix.Store (PathLock, Store (..), abortNarUnpack, acquirePathLock, finishNarUnpack, isValid, newNarUnpackSink, releasePathLock, setReadOnly, sinkNarEvent, unpackNarEntry)
import Nix.Store.DB (PathRegistration (..))
import qualified Nix.Store.ExecBit as ExecBit
import Nix.Store.Path (StoreDir, StorePath (spHash), parseStorePathBaseName, storePathHashLen, storePathToFilePath)
import qualified NovaCache.Bzip2 as Bzip2
import qualified NovaCache.Hash as Hash
import qualified NovaCache.NAR as NAR
import qualified NovaCache.NAR.Stream as Stream
import qualified NovaCache.NarInfo as NarInfo
import qualified NovaCache.Signing as Signing
import qualified NovaCache.Validate as Validate
import qualified NovaCache.Xz as Xz
import qualified NovaCache.Zstd as Zstd
import qualified System.Directory as Dir
-- ---------------------------------------------------------------------------
-- Types
-- ---------------------------------------------------------------------------
-- | Configuration for a binary cache.
data CacheConfig = CacheConfig
{ -- | Base URL of the cache (e.g. @https:\/\/cache.novavero.ai@).
ccUrl :: !Text,
-- | Trusted public keys (@name:base64key@). A narinfo is accepted
-- when ANY of them verifies a signature, matching upstream's flat
-- @trusted-public-keys@ set: the keys are not bound to a particular
-- substituter, and one signed by any trusted key is enough.
ccPublicKeys :: ![Text],
-- | Priority (lower = checked first). cache.nixos.org is 40.
ccPriority :: !Int
}
deriving (Eq, Show)
-- | Default cache configuration for cache.nixos.org.
defaultCacheConfig :: CacheConfig
defaultCacheConfig =
CacheConfig
{ ccUrl = "https://cache.nixos.org",
ccPublicKeys = ["cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY="],
ccPriority = 40
}
-- | Result of a substitution attempt.
data SubstResult
= -- | Verified and unpacked on disk, NOT yet registered: the carried
-- registration is recorded by the caller, which batches every output
-- of a derivation into one 'registerPaths' transaction so
-- cross-output reference edges are never dropped. The path's lock
-- rides along STILL HELD, because the exclusion must survive until
-- that transaction commits - released earlier, another process could
-- meet the unpacked-but-unregistered window and delete the tree the
-- row is about to describe. The caller releases it after
-- registration, on every exit path ('Nix.Builder').
SubstSuccess !PathRegistration !PathLock
| -- | The path was already valid under its lock - another process
-- registered it while this one waited - so its work is adopted:
-- nothing was downloaded, nothing touched disk, and no registration
-- is needed. The caller treats this as success. No lock rides
-- along; it was released before returning.
SubstAlreadyValid
| -- | Cache doesn't have this path.
SubstNotFound
| -- | Download or verification failed.
SubstError !Text
deriving (Eq, Show)
-- ---------------------------------------------------------------------------
-- Main substitution logic
-- ---------------------------------------------------------------------------
-- | Try to substitute a store path from configured caches.
--
-- Upstream's per-path substitution protocol: take the path's exclusive
-- lock FIRST, before any deletion or download, and re-check validity
-- under it - another process may have registered the path while this
-- one waited, and its finished work must be adopted
-- ('SubstAlreadyValid') rather than deleted and redone. The lock then
-- holds across the delete, the download, materialization, and the
-- on-disk recheck; a successful result carries it still held (see
-- 'SubstSuccess'), and every other exit releases it here.
--
-- Caches are checked in priority order; the first success stops the
-- scan and a failing cache falls through to the remaining ones. On
-- success the path is unpacked and read-only on disk but NOT
-- registered - the caller records the returned 'PathRegistration'.
trySubstitute :: Store -> [CacheConfig] -> StorePath -> IO SubstResult
trySubstitute _ [] _ = pure SubstNotFound
trySubstitute store caches sp = do
-- Reuse the process-global TLS manager (connection pooling / keep-alive)
-- rather than creating a fresh one per call and per output.
manager <- HTTPS.getGlobalManager
lock <- acquirePathLock (stDir store) sp
substituteLocked manager lock `onException` releasePathLock lock
where
substituteLocked manager lock = do
valid <- isValid store sp
if valid
then do
releasePathLock lock
pure SubstAlreadyValid
else do
result <- tryCachesWith (\cache -> tryOneCache manager store cache sp lock) (sortCaches caches)
case result of
SubstSuccess _ _ -> pure result
other -> do
releasePathLock lock
pure other
-- | Fold per-cache attempts in priority order. The first success wins and
-- stops the scan. An erroring cache falls through to the remaining ones -
-- a transient failure (DNS, TLS, HTTP 500, unsupported compression) from a
-- higher-priority cache must not mask a hit in the next - and the first
-- error, tagged with its cache URL, is reported only when no cache has the
-- path.
tryCachesWith :: (Monad m) => (CacheConfig -> m SubstResult) -> [CacheConfig] -> m SubstResult
tryCachesWith attempt = go Nothing
where
go firstErr [] = pure (maybe SubstNotFound SubstError firstErr)
go firstErr (cache : rest) = do
result <- attempt cache
case result of
SubstSuccess reg lock -> pure (SubstSuccess reg lock)
-- A path found valid mid-scan is terminal like a success:
-- there is nothing left to fetch from any cache.
SubstAlreadyValid -> pure SubstAlreadyValid
SubstNotFound -> go firstErr rest
SubstError err -> go (firstErr <|> Just (ccUrl cache <> ": " <> err)) rest
-- | Attempt substitution from a single cache. Synchronous exceptions
-- become 'SubstError', so the scan falls through to the remaining
-- caches; asynchronous exceptions propagate ('catchSync') - an
-- interrupt mid-download must abort the scan, never continue to the
-- next cache and from there to a local build.
tryOneCache :: HTTP.Manager -> Store -> CacheConfig -> StorePath -> PathLock -> IO SubstResult
tryOneCache mgr store cache sp lock =
substituteFromCache mgr store cache sp lock
`catchSync` \err -> pure (SubstError ("substitution exception: " <> T.pack (show err)))
-- | Substitution pipeline for a single cache.
--
-- Each step is a pure or IO action that produces @Either@ on failure.
-- The pipeline short-circuits on the first error via early return.
substituteFromCache :: HTTP.Manager -> Store -> CacheConfig -> StorePath -> PathLock -> IO SubstResult
substituteFromCache mgr store cache sp lock = do
-- 1. Fetch narinfo
narInfoResult <- fetchNarInfo mgr cache sp
case narInfoResult of
Left notFoundOrErr -> pure notFoundOrErr
Right narInfo
-- 1b. The served narinfo must describe the requested path. A
-- misconfigured or hostile cache could return a validly-signed narinfo
-- for a DIFFERENT path under this hash's URL.
| not (narInfoMatchesPath sp narInfo) ->
pure
( SubstError
( "narinfo identity mismatch: requested "
<> spHash sp
<> ", narinfo names "
<> NarInfo.niStorePath narInfo
)
)
| otherwise ->
-- 2-4. The pure preflight, then stream: download,
-- decompress, hash, parse, and materialize in one bounded
-- pass ('streamNarIntoStore').
case narInfoPreflight cache narInfo of
Left err -> pure (SubstError err)
Right () -> streamWithRetry mgr store cache sp narInfo lock
-- | The pure preflight the pipeline runs before any download is paid
-- for, everything decided from the narinfo alone: field validation
-- FIRST - above all before 'verifySigs' builds the signed fingerprint
-- from the fields - then the signature, then streaming decompression
-- support. Unsupported compression rejects here: the value is known
-- from the narinfo, and a multi-hundred-MB download that can only
-- fail in decompression is pure waste. The strict 'decompressorFor'
-- encodes the same support set; the suite pins their agreement.
narInfoPreflight :: CacheConfig -> NarInfo.NarInfo -> Either Text ()
narInfoPreflight cache narInfo = do
validateNarInfoFields narInfo
verifySigs cache narInfo
streamingDecompressionSupported (NarInfo.niCompression narInfo)
-- | Validate narinfo field syntax before anything consumes the fields -
-- above all before 'verifySigs' builds the signed fingerprint from them.
-- The fingerprint is delimited text (semicolons between fields, commas
-- between references), so each field must have parsed as well-formed
-- before it is spliced in; a malformed narinfo fails here as a plain
-- parse error instead of flowing onward. The checks are nova-cache's
-- 'Validate.validateNarInfo': store path, references, hash spellings,
-- sizes, and the no-@.drv@ rule.
validateNarInfoFields :: NarInfo.NarInfo -> Either Text ()
validateNarInfoFields narInfo = case Validate.validateNarInfo narInfo of
Right _ -> Right ()
Left errs ->
Left ("invalid narinfo: " <> T.intercalate "; " (map renderValidationError errs))
-- | One 'Validate.ValidationError' in the register the other
-- substitution errors use.
renderValidationError :: Validate.ValidationError -> Text
renderValidationError verr = case verr of
Validate.NegativeFileSize n -> "negative FileSize " <> T.pack (show n)
Validate.NegativeNarSize n -> "negative NarSize " <> T.pack (show n)
Validate.InvalidStorePath raw parseErr -> fieldError "StorePath" raw parseErr
Validate.InvalidFileHash raw parseErr -> fieldError "FileHash" raw parseErr
Validate.InvalidNarHash raw parseErr -> fieldError "NarHash" raw parseErr
Validate.InvalidReference raw parseErr -> fieldError "Reference" raw parseErr
Validate.NarHashMismatch expected actual ->
"NarHash mismatch: declared " <> expected <> ", computed " <> actual
Validate.FileHashMismatch expected actual ->
"FileHash mismatch: declared " <> expected <> ", computed " <> actual
Validate.SignatureInvalid sig -> "signature failed verification: " <> sig
Validate.NoSignatures -> "narinfo has no signatures"
Validate.DerivationStorePath path -> "StorePath names a derivation: " <> path
where
fieldError field raw parseErr =
field <> " '" <> raw <> "' does not parse: " <> T.pack parseErr
-- | Verify the NAR hash and size, deserialize, unpack to the store, and set
-- permissions. Returns the path's registration for the caller to record;
-- no database write happens here (see 'SubstSuccess'). The strict
-- counterpart of the streaming pipeline, kept as its differential
-- oracle: the suite materializes the same NAR through both and
-- requires identical trees. It follows the same per-path lock
-- protocol as the live pipeline: the lock is taken before the stale
-- destination is cleared, validity re-checks under it, and a success
-- carries the lock still held.
unpackAndVerify :: Store -> StorePath -> NarInfo.NarInfo -> BS.ByteString -> IO SubstResult
unpackAndVerify store sp narInfo rawNar =
-- Verify the downloaded NAR's hash matches the (signed) narinfo BEFORE
-- trusting its bytes. The NAR hash is the content-addressed integrity
-- contract; the signature only attests to the narinfo, not the body, so
-- network corruption or a compromised cache must be caught here.
-- Narinfo metadata is likewise parsed before any disk write: a malformed
-- narinfo must not leave an unpacked-but-unregistered path behind.
case verifiedInputs of
Left err -> pure (SubstError err)
Right (declared, (refs, deriver)) -> case NAR.deserialise rawNar of
Left err -> pure (SubstError ("NAR deserialisation failed: " <> T.pack err))
Right narEntry -> do
lock <- acquirePathLock (stDir store) sp
result <- unpackLocked declared refs deriver narEntry lock `onException` releasePathLock lock
case result of
SubstSuccess _ _ -> pure result
other -> do
releasePathLock lock
pure other
where
unpackLocked declared refs deriver narEntry lock = do
alreadyValid <- isValid store sp
if alreadyValid
then pure SubstAlreadyValid
else do
let destPath = storePathToFilePath (stDir store) sp
unpackResult <-
fmap
Right
( do
clearStaleDestination destPath
unpackNarEntry destPath narEntry
)
`catchSync` (pure . Left)
case (unpackResult :: Either SomeException (Either Text ())) of
Left err -> pure (SubstError ("unpack failed: " <> T.pack (show err)))
Right (Left err) -> pure (SubstError ("unpack failed: " <> err))
Right (Right ()) -> do
setReadOnly destPath
-- A path registered valid must match its recorded hash ON
-- DISK, not merely in the downloaded bytes: any divergence
-- the filesystem introduced between the NAR and the
-- materialized tree (name folding, link replication) must
-- surface here, before the row exists. A mismatching tree
-- is removed - left in place it would be adopted by
-- existence checks at this path.
onDisk <- ExecBit.serialiseFromPath destPath
case verifyNarHash narInfo (NAR.serialise onDisk) of
Left _ -> do
Dir.removePathForcibly destPath
pure
( SubstError
( "unpacked tree does not reproduce the declared NAR hash at "
<> T.pack destPath
)
)
Right _ ->
pure $
SubstSuccess
PathRegistration
{ prPath = sp,
-- The canonical spelling of the verified digest,
-- so the DB converges on one hash spelling
-- regardless of the cache's.
prNarHash = Hash.formatNixHash declared,
-- The verified actual byte count (equal to the declared
-- NarSize per 'verifyNarSize') - no Integer conversion
-- that could wrap.
prNarSize = BS.length rawNar,
prDeriver = deriver,
prReferences = refs
}
lock
verifiedInputs = do
declared <- verifyNarHash narInfo rawNar
verifyNarSize narInfo rawNar
meta <- registrationMeta
pure (declared, meta)
registrationMeta = do
refs <- parseReferences (NarInfo.niReferences narInfo)
deriver <- parseDeriver (stDir store) (NarInfo.niDeriver narInfo)
pure (refs, deriver)
-- | Verify that the downloaded NAR bytes hash to the narinfo's declared
-- NarHash, returning the decoded digest on success so registration can
-- record its canonical spelling. Compares decoded hash bytes, so any
-- valid encoding of the digest validates.
verifyNarHash :: NarInfo.NarInfo -> BS.ByteString -> Either Text Hash.NixHash
verifyNarHash narInfo rawNar =
case Hash.parseNixHash (NarInfo.niNarHash narInfo) of
Left err -> Left ("invalid narinfo NarHash: " <> T.pack err)
Right declared
| declared == actual -> Right declared
| otherwise ->
Left
( "NAR hash mismatch: narinfo declares "
<> NarInfo.niNarHash narInfo
<> " but downloaded bytes hash to "
<> Hash.formatNixHash actual
)
where
actual = Hash.hashBytes rawNar
-- | Verify that the downloaded NAR's byte count equals the narinfo's
-- declared NarSize. The hash check pins the content, but the size is a
-- separate signed claim that flows into the store DB (and from there
-- into re-pushed narinfos), so a wrong declaration must be rejected
-- rather than recorded.
verifyNarSize :: NarInfo.NarInfo -> BS.ByteString -> Either Text ()
verifyNarSize narInfo rawNar
| toInteger (BS.length rawNar) == NarInfo.niNarSize narInfo = Right ()
| otherwise =
Left
( "NAR size mismatch: narinfo declares "
<> T.pack (show (NarInfo.niNarSize narInfo))
<> " bytes but downloaded "
<> T.pack (show (BS.length rawNar))
)
-- | Whether a served narinfo describes the requested path: the hash component
-- of its declared StorePath must equal the requested path's hash. Only the
-- hash is compared, since the cache may use a different store directory.
narInfoMatchesPath :: StorePath -> NarInfo.NarInfo -> Bool
narInfoMatchesPath sp narInfo =
storePathHashOf (NarInfo.niStorePath narInfo) == Just (spHash sp)
-- | Extract the leading hash from a full store path's basename, if well-formed
-- (@\<hash\>-\<name\>@ with a hash of the expected length).
storePathHashOf :: Text -> Maybe Text
storePathHashOf path =
let base = T.takeWhileEnd (\c -> c /= '/' && c /= '\\') path
(hashPart, rest) = T.splitAt storePathHashLen base
in if T.length hashPart == storePathHashLen && T.isPrefixOf "-" rest
then Just hashPart
else Nothing
-- ---------------------------------------------------------------------------
-- HTTP fetching
-- ---------------------------------------------------------------------------
-- | HTTP status code constants.
httpOk :: Int
httpOk = 200
httpNotFound :: Int
httpNotFound = 404
-- | Cap on a narinfo response body, mirroring nova-cache's server-side
-- @maxNarInfoBodySize@ - the server bounds what it reads, and the
-- client bounds what any cache in its list can make it buffer.
-- Narinfo is small key-value text; 4 MB is far beyond any real one.
maxNarInfoBody :: Int
maxNarInfoBody = 4 * 1024 * 1024
-- | Read an HTTP response body in bounded chunks up to a byte cap -
-- 'Nothing' once the cap is exceeded, so an over-large body aborts
-- mid-stream instead of buffering without limit. The client-side
-- mirror of nova-cache's @readBodyLimited@.
readBodyCapped :: Int -> HTTP.BodyReader -> IO (Maybe BS.ByteString)
readBodyCapped cap reader = go [] 0
where
go chunks !total = do
chunk <- HTTP.brRead reader
if BS.null chunk
then pure (Just (BS.concat (reverse chunks)))
else
let newTotal = total + BS.length chunk
in if newTotal > cap
then pure Nothing
else go (chunk : chunks) newTotal
-- | Fetch a narinfo from a cache.
-- Returns @Left SubstNotFound@ on 404, @Left (SubstError msg)@ on other errors.
fetchNarInfo :: HTTP.Manager -> CacheConfig -> StorePath -> IO (Either SubstResult NarInfo.NarInfo)
fetchNarInfo mgr cache sp = do
let url = T.unpack (ccUrl cache) <> "/" <> T.unpack (spHash sp) <> ".narinfo"
request <- HTTP.parseRequest url
HTTP.withResponse request mgr $ \response -> do
let code = HTTP.statusCode (HTTP.responseStatus response)
-- Lenient decode: the body is cache-controlled bytes, and a stray
-- invalid UTF-8 sequence must surface as a narinfo parse error, not an
-- impure UnicodeException (the push side decodes the same way).
if code == httpOk
then do
body <- readBodyCapped maxNarInfoBody (HTTP.responseBody response)
case body of
Nothing ->
pure (Left (SubstError ("narinfo body exceeds " <> T.pack (show maxNarInfoBody) <> " bytes")))
Just bytes -> case NarInfo.parseNarInfo (TE.decodeUtf8Lenient bytes) of
Left err -> pure (Left (SubstError ("narinfo parse error: " <> T.pack err)))
Right ni -> pure (Right ni)
else
if code == httpNotFound
then pure (Left SubstNotFound)
else pure (Left (SubstError ("narinfo fetch failed: HTTP " <> T.pack (show code))))
-- | How many times to attempt a NAR download before giving up and letting the
-- caller fall back to a local build. Matches Nix's @download-attempts@ default.
narDownloadAttempts :: Int
narDownloadAttempts = 5
-- | Base delay between NAR download attempts, in microseconds. The delay grows
-- linearly with each retry (0.5s, 1s, ...).
narRetryBaseDelayMicros :: Int
narRetryBaseDelayMicros = 500000
-- | Stream one substitution end to end, retrying transient failures.
--
-- By the time this runs the narinfo has already been fetched and
-- signature-verified, so the cache claims to hold this path. Failures
-- carry their own retry class: a 'TransientFailure' - transport
-- errors, torn or truncated transfers, anything a fresh attempt could
-- plausibly complete - consumes retry budget with linear backoff,
-- while a 'FatalFailure' - a completed transfer that verifies wrong,
-- a body past its signed ceiling, a 4xx - ends the attempt at once:
-- retrying a deterministic failure only delays the local-build
-- fallback, and upstream's transfer layer likewise retries only the
-- transport class. Every attempt starts from a clean slate
-- ('streamNarIntoStore' clears the destination first, and every
-- failure path, exceptions included, removes what it wrote). A 404
-- on the narinfo itself (a genuine cache miss) is handled earlier in
-- 'fetchNarInfo' and never reaches here.
streamWithRetry :: HTTP.Manager -> Store -> CacheConfig -> StorePath -> NarInfo.NarInfo -> PathLock -> IO SubstResult
streamWithRetry mgr store cache sp narInfo lock = attempt narDownloadAttempts
where
attempt remaining = do
outcome <- streamNarIntoStore mgr cache store sp narInfo
case outcome of
Right registration -> pure (SubstSuccess registration lock)
Left (FatalFailure err) -> pure (SubstError err)
Left (TransientFailure err)
| remaining <= 1 -> pure (SubstError err)
| otherwise -> do
threadDelay (narRetryBaseDelayMicros * (narDownloadAttempts - remaining + 1))
attempt (remaining - 1)
-- | How one streaming attempt failed, deciding whether the retry
-- budget applies. 'TransientFailure' is a failure a fresh attempt
-- could plausibly complete; 'FatalFailure' is deterministic - the
-- same served object fails the same way every time.
data AttemptFailure
= TransientFailure !Text
| FatalFailure !Text
deriving (Eq, Show)
-- | The failure's message, independent of its retry class.
attemptFailureMessage :: AttemptFailure -> Text
attemptFailureMessage failure = case failure of
TransientFailure msg -> msg
FatalFailure msg -> msg
-- | Thrown inside the streaming pipeline where a chunk convention has
-- no error channel (the capped body source); converted back to the
-- pipeline's 'Left' at the attempt boundary in 'streamNarIntoStore'.
newtype StreamAbort = StreamAbort Text
deriving (Show)
instance Exception StreamAbort
-- | Run an action, passing only synchronous exceptions to the handler.
-- Asynchronous exceptions (a Ctrl-C, a timeout) re-throw untouched: an
-- interrupt converted into a recoverable failure would be spent as
-- retry budget, as fallthrough to the next cache, or as a local build
-- instead of aborting. Every catch-all on the substitution and build
-- paths goes through this one split.
catchSync :: IO a -> (SomeException -> IO a) -> IO a
catchSync action handler = action `catch` classify
where
classify someErr
| Just (SomeAsyncException _) <- fromException someErr = throwIO someErr
| otherwise = handler someErr
-- | Convert synchronous exceptions from one download attempt into the
-- pipeline's failure channel, so the retry budget governs them and the
-- caller's cleanup contract holds on every exit. Asynchronous
-- exceptions re-throw untouched ('catchSync'): an interrupt must
-- never be spent as retry budget.
tryAttempt :: IO (Either AttemptFailure a) -> IO (Either AttemptFailure a)
tryAttempt action = action `catchSync` handler
where
handler someErr
| Just (StreamAbort msg) <- fromException someErr =
-- A body past its ceiling: the cap derives from the signed
-- NarSize, so a longer body is the server misdeclaring, not
-- a hiccup.
pure (Left (FatalFailure msg))
| Just (httpErr :: HTTP.HttpException) <- fromException someErr =
-- Dropped connections, resets, timeouts - the class the
-- retry budget exists for.
pure (Left (TransientFailure ("HTTP transport failure: " <> T.pack (show httpErr))))
| otherwise =
-- Local failures (a full disk, a permission error) do not
-- heal by re-downloading.
pure (Left (FatalFailure ("substitution attempt failed: " <> T.pack (show (someErr :: SomeException)))))
-- | HTTP status codes whose failures a retry could plausibly outlive.
httpRequestTimeout :: Int
httpRequestTimeout = 408
httpTooManyRequests :: Int
httpTooManyRequests = 429
httpServerErrorFloor :: Int
httpServerErrorFloor = 500
-- | Classify a non-200 NAR response: server-side and rate-limit
-- statuses are transient, every other status (above all a 404 on an
-- object the narinfo just promised) is deterministic.
httpStatusFailure :: Int -> AttemptFailure
httpStatusFailure code
| code == httpRequestTimeout || code == httpTooManyRequests || code >= httpServerErrorFloor =
TransientFailure message
| otherwise = FatalFailure message
where
message = "NAR download failed: HTTP " <> T.pack (show code)
-- | One streaming substitution attempt: download, decompress, hash,
-- parse, and materialize in a single bounded pass, then verify.
-- Memory is bounded by the decoder's buffers and the parser's
-- structural-string cap, never by archive or file size.
--
-- Disk writes begin before the NAR hash can be known - the price of
-- never holding the archive, and exactly upstream's ordering - so
-- every failure path, exceptions included, removes the tree it wrote
-- ('materializeNarFromSource' owns that contract; 'tryAttempt'
-- classifies what escapes it). The narinfo metadata registration
-- needs (declared hash, references, deriver) still parses BEFORE the
-- first byte downloads: a malformed narinfo must not leave an
-- unpacked-but-unregistered path behind.
streamNarIntoStore :: HTTP.Manager -> CacheConfig -> Store -> StorePath -> NarInfo.NarInfo -> IO (Either AttemptFailure PathRegistration)
streamNarIntoStore mgr cache store sp narInfo = case preflight of
Left err -> pure (Left (FatalFailure err))
Right (declaredDigest, refs, deriver, downloadCap) -> do
let destPath = storePathToFilePath (stDir store) sp
narUrl = T.unpack (ccUrl cache) <> "/" <> T.unpack (NarInfo.niUrl narInfo)
clearStaleDestination destPath
request <- HTTP.parseRequest narUrl
tryAttempt $ HTTP.withResponse request mgr $ \response -> do
let code = HTTP.statusCode (HTTP.responseStatus response)
if code /= httpOk
then pure (Left (httpStatusFailure code))
else do
source <- cappedBodySource downloadCap (HTTP.responseBody response)
materializeNarFromSource store sp narInfo declaredDigest refs deriver source
where
preflight = do
declaredDigest <- case Hash.parseNixHash (NarInfo.niNarHash narInfo) of
Left err -> Left ("invalid narinfo NarHash: " <> T.pack err)
Right digest -> Right digest
refs <- parseReferences (NarInfo.niReferences narInfo)
deriver <- parseDeriver (stDir store) (NarInfo.niDeriver narInfo)
downloadCap <- downloadCapFor narInfo
pure (declaredDigest, refs, deriver, downloadCap)
-- | The byte cap on the compressed NAR body, derived from the SIGNED
-- NarSize: the Ed25519 fingerprint covers StorePath, NarHash, NarSize,
-- and references - not FileSize - so the unsigned FileSize may only
-- LOWER the cap, never raise it. A rewritten FileSize on an otherwise
-- validly-signed narinfo must not buy an unbounded download.
downloadCapFor :: NarInfo.NarInfo -> Either Text Int
downloadCapFor narInfo
| narSize < 0 || narSize > toInteger (maxBound :: Int) =
Left ("narinfo declares an unusable NAR size: " <> T.pack (show narSize))
| otherwise =
let signedCeiling = compressedBodyCeiling narSize
capped = maybe signedCeiling (min signedCeiling . max 0) (NarInfo.niFileSize narInfo)
in Right (fromInteger (min capped (toInteger (maxBound :: Int))))
where
narSize = NarInfo.niNarSize narInfo
-- | The most a compressed NAR body may legitimately exceed its NarSize
-- by: xz and zstd expand incompressible input by well under one
-- percent of framing overhead, so a 1/64 (~1.6%) margin plus a fixed
-- floor for small NARs is generous for any real codec, while a
-- hostile FileSize claiming orders of magnitude more is refused.
compressedBodyCeiling :: Integer -> Integer
compressedBodyCeiling narSize =
narSize + max compressionOverheadFloorBytes (narSize `div` compressionOverheadDivisor)
-- | Fixed overhead floor for small NARs, where framing dominates.
compressionOverheadFloorBytes :: Integer
compressionOverheadFloorBytes = 64 * 1024
-- | Proportional overhead margin: 1/64 of the NarSize.
compressionOverheadDivisor :: Integer
compressionOverheadDivisor = 64
-- | Materialize a NAR from a compressed chunk source into the store
-- path: decompress, hash, parse, and unpack in one pass, then verify
-- the tree on disk and build its registration. The post-download half
-- of 'streamNarIntoStore', taking a plain chunk source so the failure
-- contract is testable without HTTP.
--
-- The cleanup contract: every failing exit - the pipeline's 'Left',
-- a verification mismatch, or an exception (asynchronous included) -
-- removes the destination tree, so no partial or unverified tree ever
-- survives at the store path.
materializeNarFromSource :: Store -> StorePath -> NarInfo.NarInfo -> Hash.NixHash -> [StorePath] -> Maybe Text -> IO BS.ByteString -> IO (Either AttemptFailure PathRegistration)
materializeNarFromSource store sp narInfo declaredDigest refs deriver source =
materialize `onException` Dir.removePathForcibly destPath
where
destPath = storePathToFilePath (stDir store) sp
materialize = do
streamed <-
withDecompressedSource (NarInfo.niNarSize narInfo) (NarInfo.niCompression narInfo) source $
consumeNarStream destPath narInfo declaredDigest
case streamed of
Left err -> do
Dir.removePathForcibly destPath
pure (Left err)
Right narByteCount -> do
setReadOnly destPath
-- A path registered valid must match its recorded hash ON
-- DISK, not merely in the streamed bytes: any divergence the
-- filesystem introduced between the NAR and the materialized
-- tree must surface here, before the row exists. The recheck
-- streams too, so its memory no longer scales with the path.
-- Through 'ExecBit', not nova-cache's walk directly: on Windows
-- the sink writes the exec bit to a stream that walk cannot see,
-- and a verifier reading the flag back out of the file extension
-- would reject exactly the paths this representation exists for.
-- On Unix it is still the streaming hash.
onDiskDigest <- ExecBit.narHashOfPath destPath
if onDiskDigest /= declaredDigest
then do
Dir.removePathForcibly destPath
pure (Left (FatalFailure ("unpacked tree does not reproduce the declared NAR hash at " <> T.pack destPath)))
else
pure $
Right
PathRegistration
{ prPath = sp,
-- The canonical spelling of the verified digest,
-- so the DB converges on one hash spelling
-- regardless of the cache's.
prNarHash = Hash.formatNixHash declaredDigest,
prNarSize = narByteCount,
prDeriver = deriver,
prReferences = refs
}
-- | Drive the decompressed chunk source through incremental hashing,
-- the streaming NAR parser, and the store's streaming unpack sink,
-- returning the verified NAR byte count. The hash context folds over
-- exactly the bytes the parser consumes, so the digest is of the NAR
-- the tree was built from.
consumeNarStream :: FilePath -> NarInfo.NarInfo -> Hash.NixHash -> IO BS.ByteString -> IO (Either AttemptFailure Int)
consumeNarStream destPath narInfo declaredDigest narSource = do
sink <- newNarUnpackSink destPath
go sink Hash.hashInit 0 Stream.narStream `onException` abortNarUnpack sink
where
go sink !ctx !narBytes step = case step of
Stream.NarAwait continue -> do
chunk <- narSource
go sink (Hash.hashUpdate ctx chunk) (narBytes + BS.length chunk) (continue chunk)
Stream.NarYield event next -> do
sunk <- sinkNarEvent sink event
case sunk of
Left err -> do
abortNarUnpack sink
-- A name or shape the store refuses is a property of the
-- archive, not of this transfer.
pure (Left (FatalFailure err))
Right () -> go sink ctx narBytes next
Stream.NarFail msg -> do
abortNarUnpack sink
-- A truncated body and a torn transfer parse-fail the same
-- way, so the retry budget applies.
pure (Left (TransientFailure ("NAR stream parse failed: " <> T.pack msg)))
Stream.NarDone -> do
let digest = Hash.hashFinalize ctx
if toInteger narBytes /= NarInfo.niNarSize narInfo
then do
abortNarUnpack sink
-- The grammar completed, so the transfer was whole: a
-- size that still disagrees is the narinfo misdeclaring.
pure
( Left
( FatalFailure
( "NAR size mismatch: narinfo declares "
<> T.pack (show (NarInfo.niNarSize narInfo))
<> " bytes but the stream carried "
<> T.pack (show narBytes)
)
)
)
else
if digest /= declaredDigest
then do
abortNarUnpack sink
-- Size matched, so the transfer completed; wrong
-- bytes are deterministic corruption, not a hiccup.
pure
( Left
( FatalFailure
( "NAR hash mismatch: narinfo declares "
<> NarInfo.niNarHash narInfo
<> " but downloaded bytes hash to "
<> Hash.formatNixHash digest
)
)
)
else do
finished <- finishNarUnpack sink
case finished of
Left err -> pure (Left (FatalFailure err))
Right () -> pure (Right narBytes)
-- | Stream an HTTP body as a chunk source bounded by the download cap
-- 'downloadCapFor' derived from the signed NarSize -
-- 'readBodyCapped''s discipline without the buffering. Exceeding the
-- cap throws 'StreamAbort'; the attempt boundary converts it back to
-- the pipeline's error channel.
cappedBodySource :: Int -> HTTP.BodyReader -> IO (IO BS.ByteString)
cappedBodySource cap reader = do
countRef <- newIORef 0
pure $ do
chunk <- HTTP.brRead reader
consumed <- readIORef countRef
let total = consumed + BS.length chunk
if total > cap
then throwIO (StreamAbort ("NAR body exceeds its download ceiling (" <> T.pack (show cap) <> " bytes)"))
else do
writeIORef countRef total
pure chunk
-- | Whether the streaming pipeline can decompress a narinfo
-- @Compression@ value, decided from the value alone so unsupported
-- compression rejects before any download. Both this and the strict
-- 'decompressorFor' dispatch through 'parseNarCompression', so the
-- support set exists exactly once.
streamingDecompressionSupported :: Text -> Either Text ()
streamingDecompressionSupported = void . parseNarCompression
-- | Run a consumer over the decompressed view of a chunk source:
-- identity for 'CompressionNone', nova-cache's bounded decoders for
-- 'CompressionXz', 'CompressionZstd', and 'CompressionBzip2' (output
-- capped at the declared NarSize; thrown codec errors convert to the
-- pipeline's error channel here, carrying their retry class from
-- 'xzFailure', 'zstdFailure', and 'bzip2Failure').
withDecompressedSource :: Integer -> Text -> IO BS.ByteString -> (IO BS.ByteString -> IO (Either AttemptFailure a)) -> IO (Either AttemptFailure a)
withDecompressedSource declaredNarSize compression source consume =
case parseNarCompression compression of
Left err -> pure (Left (FatalFailure err))
Right CompressionNone -> consume source
Right CompressionXz -> case xzLimitsFor declaredNarSize of
Left err -> pure (Left (FatalFailure err))
Right limits ->
Xz.withXzSource limits source consume
`catch` \xzErr -> pure (Left (xzFailure xzErr))
Right CompressionZstd -> case zstdLimitsFor declaredNarSize of
Left err -> pure (Left (FatalFailure err))
Right limits ->
Zstd.withZstdSource limits source consume
`catch` \zstdErr -> pure (Left (zstdFailure zstdErr))
Right CompressionBzip2 -> case bzip2LimitsFor declaredNarSize of
Left err -> pure (Left (FatalFailure err))
Right limits ->
Bzip2.withBzip2Source limits source consume
`catch` \bzip2Err -> pure (Left (bzip2Failure bzip2Err))
-- | Classify a decoder failure: a stream error is how truncation and
-- torn transfers surface, so it retries; output or memory past the
-- declared bounds is the served object misdeclaring - deterministic.
xzFailure :: Xz.XzError -> AttemptFailure
xzFailure xzErr = case xzErr of
Xz.XzStreamError _ -> TransientFailure rendered
Xz.XzOutputOverBound _ -> FatalFailure rendered
Xz.XzMemoryOverBound _ -> FatalFailure rendered
where
rendered = renderXzError xzErr
-- | 'xzFailure''s zstd counterpart, under the same taxonomy.
zstdFailure :: Zstd.ZstdError -> AttemptFailure
zstdFailure zstdErr = case zstdErr of
Zstd.ZstdStreamError _ -> TransientFailure rendered
Zstd.ZstdOutputOverBound _ -> FatalFailure rendered
where
rendered = renderZstdError zstdErr
-- | 'xzFailure''s bzip2 counterpart, under the same taxonomy.
bzip2Failure :: Bzip2.Bzip2Error -> AttemptFailure
bzip2Failure bzip2Err = case bzip2Err of
Bzip2.Bzip2StreamError _ -> TransientFailure rendered
Bzip2.Bzip2OutputOverBound _ -> FatalFailure rendered
where
rendered = renderBzip2Error bzip2Err
-- ---------------------------------------------------------------------------
-- Pure helpers
-- ---------------------------------------------------------------------------
-- | Sort caches by priority (lower = first).
sortCaches :: [CacheConfig] -> [CacheConfig]
sortCaches = sortBy (comparing ccPriority)
-- | Verify narinfo signatures against the cache's trusted public keys.
-- Accepts when at least one signature verifies under at least one key,
-- upstream's any-trusted-key rule. A malformed key is an error rather
-- than a silently skipped one: upstream rejects the configuration, so a
-- typo cannot quietly narrow the trusted set to the keys that parsed.
verifySigs :: CacheConfig -> NarInfo.NarInfo -> Either Text ()
verifySigs cache narInfo =
case NarInfo.niSigs narInfo of
[] -> Left "narinfo has no signatures"
sigs -> do
keys <- traverse parseKey (ccPublicKeys cache)
if any (\key -> any (Signing.verify key narInfo) sigs) keys
then Right ()
else Left "no valid signature found"
where
parseKey raw = case Signing.parsePublicKey raw of
Left err -> Left ("invalid public key: " <> T.pack err)
Right pubKey -> Right pubKey
-- | The whole-buffer decompressor for a narinfo @Compression@ value,
-- decided from the narinfo's declared values alone so unsupported
-- compression rejects before any download. 'CompressionNone' is
-- identity; 'CompressionXz' (cache.nixos.org's format),
-- 'CompressionZstd' (the modern caches'), and 'CompressionBzip2' (the
-- historical caches', and what an absent field means) decompress
-- bounded by the declared NarSize, a signed claim the caller validates
-- before resolving the decompressor. The resolved function runs in IO
-- because the zstd and bzip2 decoders are IO-native (see
-- 'NovaCache.Zstd' and 'NovaCache.Bzip2'); the strict shape follows its
-- codecs. Dispatches through 'parseNarCompression' like the streaming
-- path, so the support set exists exactly once.
decompressorFor :: Integer -> Text -> Either Text (BS.ByteString -> IO (Either Text BS.ByteString))
decompressorFor declaredNarSize compression = do
kind <- parseNarCompression compression
case kind of
CompressionNone -> Right (pure . Right)
CompressionXz -> do
limits <- xzLimitsFor declaredNarSize
Right (pure . either (Left . renderXzError) Right . Xz.decompress limits)
CompressionZstd -> do
limits <- zstdLimitsFor declaredNarSize
Right (fmap (either (Left . renderZstdError) Right) . Zstd.decompress limits)
CompressionBzip2 -> do
limits <- bzip2LimitsFor declaredNarSize
Right (fmap (either (Left . renderBzip2Error) Right) . Bzip2.decompress limits)
-- | Decompress NAR data based on the compression type from narinfo,
-- bounded by the declared NarSize. Support is decided by
-- 'decompressorFor'; this applies the result.
decompressNar :: Integer -> Text -> BS.ByteString -> IO (Either Text BS.ByteString)
decompressNar declaredNarSize compression narData =
case decompressorFor declaredNarSize compression of
Left err -> pure (Left err)
Right decompress -> decompress narData
-- | The bounds for one xz decode: output capped at the narinfo's
-- declared NarSize, decoder memory at nova-cache's default, so a
-- hostile stream can expand to neither more output nor more decoder
-- state than the narinfo promised. Narinfo validation upstream
-- already rejected a negative size; the guard keeps the function
-- total for direct callers, and a size past Word64 cannot name a
-- real NAR.
xzLimitsFor :: Integer -> Either Text Xz.XzLimits
xzLimitsFor declaredNarSize
| declaredNarSize < 0 || declaredNarSize > toInteger (maxBound :: Word64) =
Left ("xz decompression bound out of range: " <> T.pack (show declaredNarSize))
| otherwise =
Right
Xz.XzLimits
{ Xz.xzMaxOutputBytes = fromInteger declaredNarSize,
Xz.xzMaxDecoderMemoryBytes = Xz.defaultXzDecoderMemoryBytes
}
-- | One 'Xz.XzError' in the register the other substitution errors use.
renderXzError :: Xz.XzError -> Text
renderXzError xzErr = case xzErr of
Xz.XzStreamError msg -> "xz stream error: " <> T.pack msg
Xz.XzOutputOverBound bound ->
"xz output exceeds the declared NarSize (" <> T.pack (show bound) <> " bytes)"
Xz.XzMemoryOverBound bound ->
"xz decoder memory over its cap (" <> T.pack (show bound) <> " bytes)"
-- | The bounds for one zstd decode: output capped at the narinfo's
-- declared NarSize; decoder state rides libzstd's built-in window
-- limit (see 'NovaCache.Zstd'). The same totality guard as
-- 'xzLimitsFor'.
zstdLimitsFor :: Integer -> Either Text Zstd.ZstdLimits
zstdLimitsFor declaredNarSize
| declaredNarSize < 0 || declaredNarSize > toInteger (maxBound :: Word64) =
Left ("zstd decompression bound out of range: " <> T.pack (show declaredNarSize))
| otherwise = Right Zstd.ZstdLimits {Zstd.zstdMaxOutputBytes = fromInteger declaredNarSize}
-- | One 'Zstd.ZstdError' in the register the other substitution
-- errors use.
renderZstdError :: Zstd.ZstdError -> Text
renderZstdError zstdErr = case zstdErr of
Zstd.ZstdStreamError msg -> "zstd stream error: " <> T.pack msg
Zstd.ZstdOutputOverBound bound ->
"zstd output exceeds the declared NarSize (" <> T.pack (show bound) <> " bytes)"
-- | The bounds for one bzip2 decode: output capped at the narinfo's
-- declared NarSize. There is no decoder-memory knob to set - bzip2
-- carries no attacker-chosen dictionary size, so decoder state is a
-- small constant of the format (see 'NovaCache.Bzip2'). The same
-- totality guard as 'xzLimitsFor'.
bzip2LimitsFor :: Integer -> Either Text Bzip2.Bzip2Limits
bzip2LimitsFor declaredNarSize
| declaredNarSize < 0 || declaredNarSize > toInteger (maxBound :: Word64) =
Left ("bzip2 decompression bound out of range: " <> T.pack (show declaredNarSize))
| otherwise = Right Bzip2.Bzip2Limits {Bzip2.bzip2MaxOutputBytes = fromInteger declaredNarSize}
-- | One 'Bzip2.Bzip2Error' in the register the other substitution
-- errors use.
renderBzip2Error :: Bzip2.Bzip2Error -> Text
renderBzip2Error bzip2Err = case bzip2Err of
Bzip2.Bzip2StreamError msg -> "bzip2 stream error: " <> T.pack msg
Bzip2.Bzip2OutputOverBound bound ->
"bzip2 output exceeds the declared NarSize (" <> T.pack (show bound) <> " bytes)"
-- | Parse narinfo references (store path basenames, e.g.
-- @abc...-glibc-2.40@) into StorePaths. A malformed token is an error,
-- not filtered: silently dropping a reference registers the path with a
-- hole in its closure, which re-push then publishes as a signed narinfo
-- missing runtime deps, and GC reads as permission to delete them.
parseReferences :: [Text] -> Either Text [StorePath]
parseReferences = traverse parseRef
where
parseRef ref =
maybe (Left ("malformed narinfo reference: " <> ref)) Right (parseStorePathBaseName ref)
-- | The sentinel upstream caches emit for a path whose deriver is unknown.
unknownDeriverSentinel :: Text
unknownDeriverSentinel = "unknown-deriver"
-- | Parse a narinfo Deriver - a store path basename on the wire, or the
-- @unknown-deriver@ sentinel - into the full path text the store DB
-- records (the form 'Nix.Push' parses back with 'parseStorePath').
parseDeriver :: StoreDir -> Maybe Text -> Either Text (Maybe Text)
parseDeriver _ Nothing = Right Nothing
parseDeriver storeDir (Just txt)
| txt == unknownDeriverSentinel = Right Nothing
| otherwise = case parseStorePathBaseName txt of
Just sp -> Right (Just (T.pack (storePathToFilePath storeDir sp)))
Nothing -> Left ("malformed narinfo deriver: " <> txt)
-- ---------------------------------------------------------------------------
-- NAR unpacking
-- ---------------------------------------------------------------------------
-- | Remove a leftover destination tree before unpacking. A crash (or a
-- failed registration) between 'setReadOnly' here and the caller's
-- 'Nix.Store.DB.registerPaths' leaves a read-only, unregistered tree;
-- unpacking over it would then fail with permission-denied on every
-- retry, permanently wedging substitution of that path.
-- 'Dir.removePathForcibly' clears read-only marks and accepts a missing
-- path, so the fresh unpack always starts from a clean slate.
-- Substitution callers reach this only holding the path's exclusive
-- lock ('trySubstitute', 'unpackAndVerify'): unlocked, this deletion is
-- exactly the race that lets one process remove a tree another just
-- registered.
clearStaleDestination :: FilePath -> IO ()
clearStaleDestination = Dir.removePathForcibly
-- unpackNarEntry lives in 'Nix.Store' (one tree-materializer for the
-- codebase) and is re-exported here for its historical callers and tests.