nova-cache 0.4.2.1 → 0.5.0.0

raw patch · 16 files changed

+1289/−622 lines, 16 filesdep −lzmaPVP ok

version bump matches the API change (PVP)

Dependencies removed: lzma

API changes (from Hackage documentation)

Files

• CHANGELOG.md +19/−0
• NOTICE +6/−0
• README.md +13/−9
• exe/LandingPage.hs +110/−0
• exe/Main.hs +69/−404
• nova-cache.cabal +10/−30
• src/NovaCache/Compression.hs +0/−35
• src/NovaCache/NAR.hs +9/−1
• src/NovaCache/NarInfo.hs +26/−14
• src/NovaCache/Server.hs +414/−0
• src/NovaCache/Signing.hs +16/−4
• src/NovaCache/Store.hs +53/−0
• src/NovaCache/StorePath.hs +34/−3
• src/NovaCache/Validate.hs +27/−14
• test/CompressionTest.hs +0/−88
• test/Main.hs +483/−20

@@ -1,5 +1,24 @@ # Changelog +## 0.5.0.0 - 2026-07-12++- **Signing: fingerprints sort and deduplicate references.** C++ Nix computes and verifies narinfo fingerprints over a sorted, deduplicated store-path set; signing in the narinfo's file order produced signatures real Nix clients reject while nova-cache's own `verify` (recomputing from the same order) passed and masked the divergence. References are now sorted by basename and deduplicated before signing.+- **Removed `NovaCache.Compression`, the `compression` flag, and the `lzma` dependency.** The module had no consumer, and the default-on manual flag made every Hackage install require system liblzma dev files, which plain Windows and minimal Linux machines lack - `cabal install` of downstream packages failed while CI (which pins the flag off inside the repo) stayed green. xz support returns with its first real consumer as a size-bounded decoder suitable for untrusted cache data.+- **Wire-format strictness now matches upstream Nix.** `validateNarInfo` requires the StorePath field to be absolute and references to be bare basenames (the other spellings produce narinfos real clients reject at parse time, and a bare StorePath also derived an empty store dir inside the signed fingerprint); store-path names are ASCII-only and capped at 211 characters; NAR parsing rejects backslashes in entry names (the Windows traversal vector) and nonzero string padding; and key parsing rejects an empty name or empty key material at load time instead of producing signatures no trust anchor can match. New `parseStorePathBaseName` and `parseAbsoluteStorePath` expose the per-field parsers.+- **Upstream-optional narinfo fields are now optional.** Only StorePath, URL, NarHash, and NarSize are required; `Compression` defaults to bzip2 as upstream, and `FileHash`/`FileSize` are `Maybe` (breaking record change, covered by the major bump). Valid narinfos from foreign caches no longer fail to parse over absent optional fields.+- **New `NovaCache.Server` module: the cache's HTTP protocol as a WAI `Application`.** Routing, write authentication, request-body limits, and the narinfo validation/signing pipeline move from the server executable into tested library API. Deployment branding stays out of the library: embedders supply their own root-page response, and the bundled executable carries its landing page itself. Adds `wai` and `http-types` to the library dependencies.+- **`GET /narinfo-hashes` requires the write key and is `Cache-Control: no-store`.** The listing enumerates the whole store - something the public cache protocol deliberately never offers - and lists a directory per hit; it exists only for the push tool, which already holds the write key.+- **NAR bodies no longer transit memory.** Uploads stream to a temp file under a running size cap and rename into place atomically (`NovaCache.Store.writeNarStreaming`); downloads are served from disk via WAI's `responseFile` (`NovaCache.Store.narFilePath`). A multi-GB NAR previously occupied that much RAM per request in both directions.+- **`HEAD` is answered wherever `GET` is.** Clients probing narinfo existence with `HEAD` previously got 404.+- **The server refuses to start when `CACHE_API_KEY` normalizes to empty** (BOM or whitespace only - the copy-paste artifact). An empty armed key would authenticate an empty bearer token.+- **The server refuses to start when a configured signing key fails to load.** It previously logged a warning and ran unsigned, persisting narinfos no trust anchor can verify - the same misconfiguration class the key parser now rejects, closed at the process boundary too.+- **Configurable bind host: `--host` / `HOST`.** The default stays all interfaces, so existing deployments do not silently rebind.+- The deploy workflow pins cloudflared by version and checksum instead of pulling `latest`, and builds the server on GitHub's hosted arm64 image (same Ubuntu as the production box), shipping the binary over the Access tunnel - the production host deliberately carries no compiler toolchain.+- **The sdist ships `NOTICE`.** Apache-2.0 section 4(d) asks redistributions to carry it; the file existed in the repo but not in the released tarball.+- **CI builds from the sdist in isolation**, so tree-vs-tarball divergences (files missing from the tarball, dev-only project settings) fail the pipeline instead of surfacing at install time. CI also compiles the server executable and test suites under `-Werror` on every platform.+- Dropped the server executable's unused `crypton` dependency.+- Workflows run with a read-only `GITHUB_TOKEN`.+ ## 0.4.2.1 - 2026-06-12  - **Relicensed from BSD-3-Clause to Apache-2.0.** Apache adds an explicit patent grant and trademark terms, and a `NOTICE` file now carries the copyright (Novavero AI Inc.). Earlier releases on Hackage remain under their original licenses.

@@ -0,0 +1,6 @@+nova-cache+Copyright 2026 Novavero AI Inc.++This product is licensed under the Apache License, Version 2.0.+A copy of the License is provided in the LICENSE file, or at+http://www.apache.org/licenses/LICENSE-2.0

@@ -1,7 +1,7 @@ <div align="center"> <h1>nova-cache</h1> <p><strong>The Nix binary cache protocol, in Haskell.</strong></p>-<p>nix-base32, NAR archives, narinfo, store paths, and Ed25519 signing - with an optional WAI cache server. A pure core; IO is confined to the compression, storage, and server boundaries.</p>+<p>nix-base32, NAR archives, narinfo, store paths, and Ed25519 signing - with an optional WAI cache server. A pure core; IO is confined to the storage and server boundaries.</p>  [![CI](https://github.com/Novavero-AI/nova-cache/actions/workflows/ci.yml/badge.svg)](https://github.com/Novavero-AI/nova-cache/actions/workflows/ci.yml) [![Hackage](https://img.shields.io/hackage/v/nova-cache.svg)](https://hackage.haskell.org/package/nova-cache)@@ -18,9 +18,6 @@ build-depends: nova-cache ``` -The `compression` flag (on by default) requires the system `liblzma`. Build-with `-f-compression` if you only need hashing, NAR, or narinfo.- ## Usage  ```haskell@@ -57,11 +54,16 @@ cabal run --flag server nova-cache-server -- --port 5000 --store ./nix-cache ``` +The protocol itself lives in the `NovaCache.Server` library module as a WAI+`Application`, so any operator can embed the cache in their own server with+their own root page; the bundled executable is one such embedding.+ ### Configuration  | Variable | Description | | --- | --- |-| `PORT` | Listen port (default: 5000) |+| `PORT` | Listen port (default: 5000; also `--port`) |+| `HOST` | Bind host (default: all interfaces; also `--host`) | | `NIX_CACHE_DIR` | Store directory (default: `./nix-cache`) | | `CACHE_API_KEY` | Bearer token required for `PUT`. The server refuses to start without it unless `--allow-open-writes` is passed. | | `SIGNING_KEY_FILE` | Ed25519 secret key file for server-side narinfo signing |@@ -73,12 +75,14 @@ | --- | --- | --- | | `GET` | `/` | Landing page: live stats and the cache public key | | `GET` | `/nix-cache-info` | Cache metadata |-| `GET` | `/narinfo-hashes` | All cached narinfo hashes, newline-delimited |+| `GET` | `/narinfo-hashes` | All cached narinfo hashes, newline-delimited (authenticated) | | `GET` | `/<hash>.narinfo` | Fetch a narinfo |-| `GET` | `/nar/<file>` | Fetch a NAR |+| `GET` | `/nar/<file>` | Fetch a NAR (streamed from disk) | | `PUT` | `/<hash>.narinfo` | Upload a narinfo (authenticated, validated) |-| `PUT` | `/nar/<file>` | Upload a NAR (authenticated) |+| `PUT` | `/nar/<file>` | Upload a NAR (authenticated, streamed to disk) | +`HEAD` is answered wherever `GET` is.+ ### Public cache  A public instance runs at `cache.novavero.ai`:@@ -95,7 +99,7 @@ cabal test ``` -Optional flags: `-f-compression` skips the `liblzma` dependency, and `--flag server` builds the cache server. Requires GHC 9.8+ and cabal-install 3.10+.+Optional flag: `--flag server` builds the cache server. Requires GHC 9.8+ and cabal-install 3.10+.  --- 

@@ -0,0 +1,110 @@+-- | The cache.novavero.ai landing page.+--+-- Deployment branding lives here, in the executable: the+-- "NovaCache.Server" library is brand-free, taking whatever root+-- response its embedder supplies, so other operators running their own+-- cache never ship this page.+module LandingPage (landingResponse) where++import qualified Data.ByteString.Lazy as BL+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Network.HTTP.Types as HTTP+import Network.Wai (Response, responseLBS)+import NovaCache.Store (CacheInfo (..), FileStore, getCacheInfo, listNarInfoHashes)++-- | Build the @GET \/@ response: the branded page around live values+-- (store-path count, store dir, signing status, public key).+landingResponse :: FileStore -> Bool -> Maybe Text -> IO Response+landingResponse store signingEnabled pubKey = do+  pathCount <- length <$> listNarInfoHashes store+  let body = TE.encodeUtf8 (landingHtml (getCacheInfo store) signingEnabled pubKey pathCount)+  pure (responseLBS HTTP.status200 htmlHeaders (BL.fromStrict body))++-- | The landing page markup.  Static apart from four live values; styled+-- to match novavero.ai.  Nothing user-supplied is interpolated - the key+-- line is operator configuration - so no escaping is needed.+landingHtml :: CacheInfo -> Bool -> Maybe Text -> Int -> Text+landingHtml info signingEnabled pubKey pathCount =+  T.unlines+    [ "<!DOCTYPE html>",+      "<html lang=\"en\">",+      "<head>",+      "<meta charset=\"UTF-8\" />",+      "<meta name=\"viewport\" content=\"width=device-width, initial-scale=1.0\" />",+      "<title>cache.novavero.ai - Nix binary cache</title>",+      "<meta name=\"description\" content=\"The Novavero Nix binary cache, serving store paths for nova-nix - the Windows-native Nix.\" />",+      "<link rel=\"icon\" type=\"image/svg+xml\" href=\"data:image/svg+xml," <> novaveroLogoSvgEscaped <> "\" />",+      "<style>",+      "* { margin: 0; padding: 0; box-sizing: border-box; }",+      "body { background: #0a0b0e; color: #d6d9de; -webkit-font-smoothing: antialiased; font-family: 'Inter', system-ui, sans-serif; line-height: 1.75; }",+      "body::before { content: ''; position: fixed; inset: 0 0 auto 0; height: 320px; pointer-events: none; background: radial-gradient(ellipse 70% 100% at 50% -20%, rgba(52,211,153,0.07), transparent 70%); }",+      ".container { max-width: 720px; margin: 0 auto; padding: 80px 24px; position: relative; }",+      "a { color: #34d399; text-decoration: none; }",+      "a:hover { text-decoration: underline; }",+      ".brand { display: flex; align-items: center; gap: 14px; margin-bottom: 0.75rem; }",+      ".brand svg { width: 44px; height: 44px; border-radius: 10px; }",+      "h1 { color: #fff; font-size: 1.6rem; font-family: ui-monospace, Consolas, monospace; }",+      ".tagline { color: #9ca3af; margin-bottom: 2.5rem; }",+      ".stats { display: grid; grid-template-columns: repeat(auto-fit, minmax(140px, 1fr)); gap: 12px; margin-bottom: 2.5rem; }",+      ".stat { padding: 16px; border: 1px solid #232733; border-radius: 12px; text-align: center; }",+      ".stat .value { color: #fff; font-size: 1.4rem; font-weight: 600; }",+      ".stat .label { color: #6b7280; font-size: 0.75rem; text-transform: uppercase; letter-spacing: 0.05em; }",+      "h2 { color: #fff; font-size: 1rem; margin: 2rem 0 0.5rem; }",+      "p { font-size: 0.9rem; margin-bottom: 0.75rem; }",+      "pre { background: #0d0f14; border: 1px solid #232733; border-radius: 8px; padding: 14px; white-space: pre-wrap; word-break: break-all; margin: 0.75rem 0; }",+      "code { font-family: ui-monospace, Consolas, monospace; font-size: 0.85rem; color: #e5e7eb; }",+      ".footer { margin-top: 3rem; padding-top: 1.5rem; border-top: 1px solid #232733; font-size: 0.85rem; color: #6b7280; }",+      "</style>",+      "</head>",+      "<body>",+      "<div class=\"container\">",+      "<div class=\"brand\">" <> novaveroLogoSvg <> "<h1>cache.novavero.ai</h1></div>",+      "<p class=\"tagline\">Nix binary cache - serving store paths for <a href=\"https://github.com/Novavero-AI/nova-nix\">nova-nix</a>, the Windows-native Nix.</p>",+      "<div class=\"stats\">",+      "<div class=\"stat\"><div class=\"value\">" <> T.pack (show pathCount) <> "</div><div class=\"label\">store paths</div></div>",+      "<div class=\"stat\"><div class=\"value\">" <> (if signingEnabled then "ed25519" else "off") <> "</div><div class=\"label\">signing</div></div>",+      "<div class=\"stat\"><div class=\"value\">" <> T.pack (show (ciPriority info)) <> "</div><div class=\"label\">priority</div></div>",+      "</div>",+      "<h2>Use it</h2>",+      "<pre><code>substituters = https://cache.novavero.ai" <> trustAnchorLine <> "</code></pre>",+      "<p>Store dir: <code>" <> ciStoreDir info <> "</code> &middot; protocol endpoints: <code>/nix-cache-info</code>, <code>/&lt;hash&gt;.narinfo</code>, <code>/nar/&lt;file&gt;</code></p>",+      "<h2>What this is</h2>",+      "<p>The binary cache behind the Novavero Nix toolchain. Powered by <a href=\"https://github.com/Novavero-AI/nova-cache\">nova-cache</a>, a Haskell implementation of the Nix binary cache protocol. Read about the first package built by Nix natively on Windows on <a href=\"https://novavero.ai/blog/first-native-windows-nix-build.html\">the blog</a>.</p>",+      "<div class=\"footer\"><a href=\"https://novavero.ai\">Novavero AI</a> &middot; Waterloo, Canada</div>",+      "</div>",+      "</body>",+      "</html>"+    ]+  where+    trustAnchorLine = maybe "" ("\ntrusted-public-keys = " <>) pubKey++-- | The Novavero mark (the novavero.ai favicon), inlined so the page stays+-- a single self-contained response with no external assets.+novaveroLogoSvg :: Text+novaveroLogoSvg =+  "<svg xmlns=\"http://www.w3.org/2000/svg\" viewBox=\"0 0 64 64\" role=\"img\" aria-label=\"Novavero\">"+    <> "<g fill=\"#0a0f1a\"><rect width=\"64\" height=\"64\" rx=\"14\" ry=\"14\"/></g>"+    <> "<g fill=\"#ffffff\"><path d=\"M12 54L19 54L23 10L16 10Z\"/><path d=\"M16 10L23 10L48 54L41 54Z\"/><path d=\"M41 54L48 54L52 10L45 10Z\"/></g>"+    <> "</svg>"++-- | The same mark, URL-escaped for a data-URI favicon link.+novaveroLogoSvgEscaped :: Text+novaveroLogoSvgEscaped =+  T.concatMap escapeForDataUri novaveroLogoSvg+  where+    escapeForDataUri c = case c of+      '<' -> "%3C"+      '>' -> "%3E"+      '"' -> "%22"+      '#' -> "%23"+      other -> T.singleton other++-- | Content-Type and caching headers for the landing page.  Stats change as+-- paths are added, so it stays briefly cacheable but revalidates.+htmlHeaders :: HTTP.ResponseHeaders+htmlHeaders =+  [ (HTTP.hContentType, "text/html; charset=utf-8"),+    (HTTP.hCacheControl, "public, max-age=300, must-revalidate")+  ]

@@ -1,36 +1,19 @@ module Main (main) where -import Control.Exception (SomeException)+import Control.Applicative ((<|>)) import Data.Bifunctor (first)-import Data.ByteArray (constEq) import qualified Data.ByteString as BS-import qualified Data.ByteString.Char8 as BS8-import qualified Data.ByteString.Lazy as BL import Data.Maybe (fromMaybe, isJust)+import Data.String (fromString) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as TE-import qualified Network.HTTP.Types as HTTP-import Network.Wai-  ( Application,-    Request,-    RequestBodyLength (..),-    Response,-    ResponseReceived,-    getRequestBodyChunk,-    pathInfo,-    requestBodyLength,-    requestHeaders,-    requestMethod,-    responseLBS,-  )+import LandingPage (landingResponse) import qualified Network.Wai.Handler.Warp as Warp import Network.Wai.Middleware.RequestLogger (logStdout)-import NovaCache.NarInfo (NarInfo (..), parseNarInfo, renderNarInfo)-import NovaCache.Signing (SecretKey, normalizeKeyText, parseSecretKey, renderPublicKey, sign, toPublicKey)-import NovaCache.Store (CacheInfo (..), FileStore, getCacheInfo, listNarInfoHashes, newFileStore, readNar, readNarInfo, writeNar, writeNarInfo)-import NovaCache.StorePath (defaultStoreDir, parseStorePath, storePathHashString)-import NovaCache.Validate (validateNarInfo)+import NovaCache.Server (ServerConfig (..), cacheApp, onExceptionResponse)+import NovaCache.Signing (SecretKey, normalizeKeyText, parseSecretKey, renderPublicKey, toPublicKey)+import NovaCache.Store (newFileStore) import System.Environment (getArgs, lookupEnv) import System.Exit (exitFailure) import System.IO (hPutStrLn, stderr)@@ -44,10 +27,29 @@ defaultPort :: Int defaultPort = 5000 +-- | Default bind host.  @*@ binds every interface - the server's+-- historical behavior, kept as the default so existing deployments do+-- not silently rebind; a deployment opts into loopback itself via+-- @--host@ or @HOST@.+defaultBindHost :: String+defaultBindHost = "*"+ -- | Default store directory. defaultStoreRoot :: FilePath defaultStoreRoot = "./nix-cache" +-- | Environment variable for the server port.+portEnvVar :: String+portEnvVar = "PORT"++-- | Environment variable for the bind host.+hostEnvVar :: String+hostEnvVar = "HOST"++-- | Environment variable for the store root directory.+storeEnvVar :: String+storeEnvVar = "NIX_CACHE_DIR"+ -- | Environment variable for the write API key. apiKeyEnvVar :: String apiKeyEnvVar = "CACHE_API_KEY"@@ -60,39 +62,16 @@ requestLogEnvVar :: String requestLogEnvVar = "LOG_REQUESTS" --- | Maximum narinfo request body - narinfo is small text, so a tight cap.-maxNarInfoBodySize :: Int-maxNarInfoBodySize = 4 * 1024 * 1024 -- 4 MB---- | Maximum NAR request body.  A real store path's NAR can be very large--- (toolchains, GHC, LLVM), so this is far higher than the narinfo cap while--- still bounding memory.-maxNarBodySize :: Int-maxNarBodySize = 4 * 1024 * 1024 * 1024 -- 4 GB- -- ------------------------------------------------------------------------------ Server configuration--- ------------------------------------------------------------------------------- | Runtime server configuration.-data Config = Config-  { cfgStore :: !FileStore,-    cfgApiKey :: !(Maybe BS.ByteString),-    cfgSigningKey :: !(Maybe SecretKey),-    -- | The rendered @name:base64@ public key line, derived from the-    -- signing key at startup; shown on the landing page.-    cfgPublicKey :: !(Maybe Text)-  }---- --------------------------------------------------------------------------- -- Main -- ---------------------------------------------------------------------------  main :: IO () main = do   args <- getArgs-  portEnv <- lookupEnv "PORT"-  storeEnv <- lookupEnv "NIX_CACHE_DIR"+  portEnv <- lookupEnv portEnvVar+  hostEnv <- lookupEnv hostEnvVar+  storeEnv <- lookupEnv storeEnvVar   apiKeyEnv <- lookupEnv apiKeyEnvVar   sigKeyPath <- lookupEnv signingKeyEnvVar   logRequestsEnv <- lookupEnv requestLogEnvVar@@ -105,32 +84,34 @@       port = case argValue "--port" >>= readMaybe of         Just p -> p         Nothing -> maybe defaultPort (fromMaybe defaultPort . readMaybe) portEnv+      bindHost = fromMaybe defaultBindHost (argValue "--host" <|> hostEnv)       storeRoot = fromMaybe (fromMaybe defaultStoreRoot storeEnv) (argValue "--store")       allowOpenWrites = "--allow-open-writes" `elem` args    store <- newFileStore storeRoot+  apiKey <- loadApiKey apiKeyEnv   sigKey <- loadSigningKey sigKeyPath   pubKey <- derivePublicKeyLine sigKey    let cfg =-        Config-          { cfgStore = store,-            cfgApiKey = TE.encodeUtf8 . normalizeKeyText . T.pack <$> apiKeyEnv,-            cfgSigningKey = sigKey,-            cfgPublicKey = pubKey+        ServerConfig+          { scStore = store,+            scApiKey = apiKey,+            scSigningKey = sigKey,+            scRootResponse = landingResponse store (isJust sigKey) pubKey           }    let logRequests = logRequestsEnv /= Just "0"       requestLogger = if logRequests then logStdout else id -  putStrLn ("nova-cache-server listening on port " ++ show port)+  putStrLn ("nova-cache-server listening on " ++ bindHost ++ ":" ++ show port)   putStrLn ("store root: " ++ storeRoot)   putStrLn ("signing: " ++ maybe "disabled" (const "enabled") sigKey)   mapM_ (\k -> putStrLn ("public key: " ++ T.unpack k)) pubKey-  putStrLn ("write auth: " ++ maybe "disabled (open writes!)" (const "enabled") (cfgApiKey cfg))+  putStrLn ("write auth: " ++ maybe "disabled (open writes!)" (const "enabled") apiKey)   putStrLn ("request logging: " ++ if logRequests then "enabled" else "disabled (LOG_REQUESTS=0)") -  case cfgApiKey cfg of+  case apiKey of     Nothing       | not allowOpenWrites -> do           hPutStrLn stderr $@@ -144,19 +125,44 @@     _ -> pure ()    let settings =-        Warp.setPort port $-          Warp.setOnExceptionResponse onExceptionResponse Warp.defaultSettings-  Warp.runSettings settings (requestLogger (app cfg))+        Warp.setHost (fromString bindHost) $+          Warp.setPort port $+            Warp.setOnExceptionResponse onExceptionResponse Warp.defaultSettings+  Warp.runSettings settings (requestLogger (cacheApp cfg)) --- | Load a signing key from a file, if configured.+-- ---------------------------------------------------------------------------+-- Credential loading+-- ---------------------------------------------------------------------------++-- | Normalize and validate the write API key.  A key that normalizes to+-- empty (BOM or whitespace only - the classic copy-paste artifact) would+-- arm the auth gate with an empty secret that an empty bearer token+-- matches, so it is a startup error, never an armed guard.+loadApiKey :: Maybe String -> IO (Maybe BS.ByteString)+loadApiKey Nothing = pure Nothing+loadApiKey (Just raw)+  | T.null normalized = do+      hPutStrLn stderr $+        "FATAL: "+          ++ apiKeyEnvVar+          ++ " is set but empty after normalization - refusing to arm write auth with an empty key. "+          ++ "Set a real key, or unset it and pass --allow-open-writes to run open."+      exitFailure+  | otherwise = pure (Just (TE.encodeUtf8 normalized))+  where+    normalized = normalizeKeyText (T.pack raw)++-- | Load a signing key from a file, if configured.  A configured key that+-- fails to load is FATAL: falling back to unsigned would persist narinfos+-- no trust anchor can verify (the same fail-closed policy as signing). loadSigningKey :: Maybe FilePath -> IO (Maybe SecretKey) loadSigningKey Nothing = pure Nothing loadSigningKey (Just path) = do   raw <- BS.readFile path   case first show (TE.decodeUtf8' raw) >>= parseSecretKey . normalizeKeyText of     Left err -> do-      hPutStrLn stderr ("WARNING: failed to load signing key: " ++ err)-      pure Nothing+      hPutStrLn stderr ("FATAL: cannot load the signing key from " ++ path ++ ": " ++ err)+      exitFailure     Right sk -> pure (Just sk)  -- | Derive the rendered public key line from the signing key, if any.@@ -169,344 +175,3 @@     hPutStrLn stderr ("WARNING: cannot derive the public key from the signing key: " ++ err)     pure Nothing   Right pk -> pure (Just (renderPublicKey pk))---- ------------------------------------------------------------------------------ WAI application--- ------------------------------------------------------------------------------- | WAI application implementing the Nix binary cache HTTP protocol.-app :: Config -> Application-app cfg req respond = case (requestMethod req, pathInfo req) of-  -- GET / - human-facing landing page (the protocol lives at the other routes)-  ("GET", []) -> do-    pathCount <- length <$> listNarInfoHashes (cfgStore cfg)-    let info = getCacheInfo (cfgStore cfg)-        signingEnabled = isJust (cfgSigningKey cfg)-        body = TE.encodeUtf8 (landingHtml info signingEnabled (cfgPublicKey cfg) pathCount)-    respond (responseLBS HTTP.status200 htmlHeaders (BL.fromStrict body))-  -- GET /nix-cache-info-  ("GET", ["nix-cache-info"]) ->-    respond (responseLBS HTTP.status200 textHeaders (BL.fromStrict (renderCacheInfo (cfgStore cfg))))-  -- GET /narinfo-hashes-  ("GET", ["narinfo-hashes"]) -> do-    hashes <- listNarInfoHashes (cfgStore cfg)-    let body = TE.encodeUtf8 (T.unlines hashes)-    respond (responseLBS HTTP.status200 textHeaders (BL.fromStrict body))-  -- GET /<hash>.narinfo-  ("GET", [hashNarinfo])-    | Just hashKey <- T.stripSuffix ".narinfo" hashNarinfo -> do-        result <- readNarInfo (cfgStore cfg) hashKey-        case result of-          Just content ->-            respond (responseLBS HTTP.status200 narInfoHeaders (BL.fromStrict content))-          Nothing ->-            respond notFound-  -- GET /nar/<file>-  ("GET", ["nar", fileName]) -> do-    result <- readNar (cfgStore cfg) fileName-    case result of-      Just content ->-        respond (responseLBS HTTP.status200 octetHeaders (BL.fromStrict content))-      Nothing ->-        respond notFound-  -- PUT /<hash>.narinfo (auth required, validated)-  ("PUT", [hashNarinfo])-    | Just hashKey <- T.stripSuffix ".narinfo" hashNarinfo ->-        requireAuth cfg req respond $-          withLimitedBody maxNarInfoBodySize req respond $ \body ->-            case decodeAndValidate body of-              Left err -> do-                logWarn req ("INVALID: " <> T.unpack err)-                respond (badRequest err)-              Right ni-                | not (narInfoHashMatches hashKey ni) -> do-                    logWarn req "HASHMISMATCH"-                    respond (badRequest "narinfo StorePath hash does not match request")-                | otherwise -> do-                    signedResult <- signNarInfo (cfgSigningKey cfg) ni-                    case signedResult of-                      Left err -> do-                        logWarn req ("SIGNFAIL: " <> err)-                        respond (responseLBS HTTP.status500 textHeaders "signing failed")-                      Right signed -> do-                        ok <- writeNarInfo (cfgStore cfg) hashKey signed-                        if ok-                          then respond (responseLBS HTTP.status200 textHeaders "ok")-                          else do-                            logWarn req "BADPATH"-                            respond (badRequest "invalid path")-  -- PUT /nar/<file> (auth required)-  ("PUT", ["nar", fileName]) ->-    requireAuth cfg req respond $-      withLimitedBody maxNarBodySize req respond $ \body -> do-        ok <- writeNar (cfgStore cfg) fileName body-        if ok-          then respond (responseLBS HTTP.status200 textHeaders "ok")-          else do-            logWarn req "BADPATH"-            respond (badRequest "invalid path")-  -- Fallback-  _ ->-    respond notFound---- ------------------------------------------------------------------------------ Validation pipeline--- ------------------------------------------------------------------------------- | Decode a raw narinfo body and validate it in a single pure pipeline.------ Composes UTF-8 decoding, narinfo parsing, and field validation. Returns--- the validated 'NarInfo' on success, or a user-facing error message.-decodeAndValidate :: BS.ByteString -> Either Text NarInfo-decodeAndValidate body = do-  decoded <- first (const "request body is not valid UTF-8") (TE.decodeUtf8' body)-  ni <- first T.pack (parseNarInfo decoded)-  first (T.unlines . map (T.pack . show)) (validateNarInfo ni)---- | Whether the narinfo's declared StorePath actually carries the requested--- hash - so an authenticated writer cannot store a narinfo describing path X--- under path Y's key (a cache-poisoning / confused-deputy shape).-narInfoHashMatches :: Text -> NarInfo -> Bool-narInfoHashMatches hashKey ni =-  case parseStorePath defaultStoreDir (niStorePath ni) of-    Right sp -> storePathHashString sp == hashKey-    Left _ -> False---- ------------------------------------------------------------------------------ Request body limiting--- ------------------------------------------------------------------------------- | Read the request body, rejecting payloads over the given limit.------ A declared @Content-Length@ over the limit is rejected up front; otherwise--- (including unsized/chunked transfers) the body is read in bounded chunks with--- a running size check that aborts before exceeding the limit, so memory stays--- bounded regardless of the declared length.-readBodyLimited :: Int -> Request -> IO (Maybe BS.ByteString)-readBodyLimited limit req = case requestBodyLength req of-  KnownLength len-    | len > fromIntegral limit -> pure Nothing-  _ -> readChunks [] 0-  where-    readChunks acc total = do-      chunk <- getRequestBodyChunk req-      if BS.null chunk-        then pure (Just (BS.concat (reverse acc)))-        else-          let newTotal = total + BS.length chunk-           in if newTotal > limit-                then pure Nothing-                else readChunks (chunk : acc) newTotal---- | Run an action with the limited request body, responding 413 if too large.-withLimitedBody :: Int -> Request -> (Response -> IO ResponseReceived) -> (BS.ByteString -> IO ResponseReceived) -> IO ResponseReceived-withLimitedBody limit req respond action = do-  bodyResult <- readBodyLimited limit req-  case bodyResult of-    Nothing -> do-      logWarn req "OVERLIMIT"-      respond (responseLBS HTTP.status413 textHeaders "request body too large")-    Just body -> action body---- ------------------------------------------------------------------------------ Auth--- ------------------------------------------------------------------------------- | Gate a handler behind API key authentication.------ If no key is configured, all writes are permitted (open mode).--- Otherwise the request must carry @Authorization: Bearer \<key\>@.--- Uses constant-time comparison to prevent timing attacks.-requireAuth :: Config -> Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived -> IO ResponseReceived-requireAuth cfg req respond action = case cfgApiKey cfg of-  Nothing -> action-  Just expected ->-    let provided = lookup HTTP.hAuthorization (requestHeaders req)-        expectedHeader = "Bearer " <> expected-     in if maybe False (constEq expectedHeader) provided-          then action-          else do-            logWarn req "REJECTED"-            respond (responseLBS HTTP.status401 textHeaders "unauthorized")---- ------------------------------------------------------------------------------ Signing--- ------------------------------------------------------------------------------- | Sign a validated 'NarInfo' if a signing key is configured.------ With no key, returns the unsigned rendering (intentional - the operator--- configured none).  With a key, FAILS CLOSED: a signing error returns 'Left'--- so the handler refuses the write rather than persisting an unsigned narinfo--- on a cache that is supposed to sign.-signNarInfo :: Maybe SecretKey -> NarInfo -> IO (Either String BS.ByteString)-signNarInfo Nothing ni = pure (Right (renderNarInfoBytes ni))-signNarInfo (Just sk) ni = case sign sk ni of-  Left err -> do-    hPutStrLn stderr ("ERROR: signNarInfo: sign failed: " ++ err)-    pure (Left err)-  Right sig ->-    let signed = ni {niSigs = niSigs ni ++ [sig]}-     in pure (Right (renderNarInfoBytes signed))---- | Render a 'NarInfo' to its UTF-8 encoded wire format.-renderNarInfoBytes :: NarInfo -> BS.ByteString-renderNarInfoBytes = TE.encodeUtf8 . renderNarInfo---- ------------------------------------------------------------------------------ Logging--- ------------------------------------------------------------------------------- | Log a server-side warning to stderr with request context.-logWarn :: Request -> String -> IO ()-logWarn req msg =-  hPutStrLn stderr $-    msg-      <> " "-      <> BS8.unpack (requestMethod req)-      <> " /"-      <> T.unpack (T.intercalate "/" (pathInfo req))---- ------------------------------------------------------------------------------ Response helpers--- ------------------------------------------------------------------------------- | Render the nix-cache-info response body.-renderCacheInfo :: FileStore -> BS.ByteString-renderCacheInfo store =-  let info = getCacheInfo store-   in TE.encodeUtf8 $-        T.unlines-          [ "StoreDir: " <> ciStoreDir info,-            "WantMassQuery: " <> boolText (ciWantMassQuery info),-            "Priority: " <> T.pack (show (ciPriority info))-          ]---- | Render a Bool as @1@ or @0@.-boolText :: Bool -> Text-boolText True = "1"-boolText False = "0"---- | The landing page served at @GET /@.  Static apart from four live--- values (store-path count, store dir, signing status, public key); styled--- to match novavero.ai.  Nothing user-supplied is interpolated - the key--- line is operator configuration - so no escaping is needed.-landingHtml :: CacheInfo -> Bool -> Maybe Text -> Int -> Text-landingHtml info signingEnabled pubKey pathCount =-  T.unlines-    [ "<!DOCTYPE html>",-      "<html lang=\"en\">",-      "<head>",-      "<meta charset=\"UTF-8\" />",-      "<meta name=\"viewport\" content=\"width=device-width, initial-scale=1.0\" />",-      "<title>cache.novavero.ai - Nix binary cache</title>",-      "<meta name=\"description\" content=\"The Novavero Nix binary cache, serving store paths for nova-nix - the Windows-native Nix.\" />",-      "<link rel=\"icon\" type=\"image/svg+xml\" href=\"data:image/svg+xml," <> novaveroLogoSvgEscaped <> "\" />",-      "<style>",-      "* { margin: 0; padding: 0; box-sizing: border-box; }",-      "body { background: #0a0b0e; color: #d6d9de; -webkit-font-smoothing: antialiased; font-family: 'Inter', system-ui, sans-serif; line-height: 1.75; }",-      "body::before { content: ''; position: fixed; inset: 0 0 auto 0; height: 320px; pointer-events: none; background: radial-gradient(ellipse 70% 100% at 50% -20%, rgba(52,211,153,0.07), transparent 70%); }",-      ".container { max-width: 720px; margin: 0 auto; padding: 80px 24px; position: relative; }",-      "a { color: #34d399; text-decoration: none; }",-      "a:hover { text-decoration: underline; }",-      ".brand { display: flex; align-items: center; gap: 14px; margin-bottom: 0.75rem; }",-      ".brand svg { width: 44px; height: 44px; border-radius: 10px; }",-      "h1 { color: #fff; font-size: 1.6rem; font-family: ui-monospace, Consolas, monospace; }",-      ".tagline { color: #9ca3af; margin-bottom: 2.5rem; }",-      ".stats { display: grid; grid-template-columns: repeat(auto-fit, minmax(140px, 1fr)); gap: 12px; margin-bottom: 2.5rem; }",-      ".stat { padding: 16px; border: 1px solid #232733; border-radius: 12px; text-align: center; }",-      ".stat .value { color: #fff; font-size: 1.4rem; font-weight: 600; }",-      ".stat .label { color: #6b7280; font-size: 0.75rem; text-transform: uppercase; letter-spacing: 0.05em; }",-      "h2 { color: #fff; font-size: 1rem; margin: 2rem 0 0.5rem; }",-      "p { font-size: 0.9rem; margin-bottom: 0.75rem; }",-      "pre { background: #0d0f14; border: 1px solid #232733; border-radius: 8px; padding: 14px; white-space: pre-wrap; word-break: break-all; margin: 0.75rem 0; }",-      "code { font-family: ui-monospace, Consolas, monospace; font-size: 0.85rem; color: #e5e7eb; }",-      ".footer { margin-top: 3rem; padding-top: 1.5rem; border-top: 1px solid #232733; font-size: 0.85rem; color: #6b7280; }",-      "</style>",-      "</head>",-      "<body>",-      "<div class=\"container\">",-      "<div class=\"brand\">" <> novaveroLogoSvg <> "<h1>cache.novavero.ai</h1></div>",-      "<p class=\"tagline\">Nix binary cache - serving store paths for <a href=\"https://github.com/Novavero-AI/nova-nix\">nova-nix</a>, the Windows-native Nix.</p>",-      "<div class=\"stats\">",-      "<div class=\"stat\"><div class=\"value\">" <> T.pack (show pathCount) <> "</div><div class=\"label\">store paths</div></div>",-      "<div class=\"stat\"><div class=\"value\">" <> (if signingEnabled then "ed25519" else "off") <> "</div><div class=\"label\">signing</div></div>",-      "<div class=\"stat\"><div class=\"value\">" <> T.pack (show (ciPriority info)) <> "</div><div class=\"label\">priority</div></div>",-      "</div>",-      "<h2>Use it</h2>",-      "<pre><code>substituters = https://cache.novavero.ai" <> trustAnchorLine <> "</code></pre>",-      "<p>Store dir: <code>" <> ciStoreDir info <> "</code> &middot; protocol endpoints: <code>/nix-cache-info</code>, <code>/&lt;hash&gt;.narinfo</code>, <code>/nar/&lt;file&gt;</code></p>",-      "<h2>What this is</h2>",-      "<p>The binary cache behind the Novavero Nix toolchain. Powered by <a href=\"https://github.com/Novavero-AI/nova-cache\">nova-cache</a>, a Haskell implementation of the Nix binary cache protocol. Read about the first package built by Nix natively on Windows on <a href=\"https://novavero.ai/blog/first-native-windows-nix-build.html\">the blog</a>.</p>",-      "<div class=\"footer\"><a href=\"https://novavero.ai\">Novavero AI</a> &middot; Waterloo, Canada</div>",-      "</div>",-      "</body>",-      "</html>"-    ]-  where-    trustAnchorLine = maybe "" ("\ntrusted-public-keys = " <>) pubKey---- | The Novavero mark (the novavero.ai favicon), inlined so the page stays--- a single self-contained response with no external assets.-novaveroLogoSvg :: Text-novaveroLogoSvg =-  "<svg xmlns=\"http://www.w3.org/2000/svg\" viewBox=\"0 0 64 64\" role=\"img\" aria-label=\"Novavero\">"-    <> "<g fill=\"#0a0f1a\"><rect width=\"64\" height=\"64\" rx=\"14\" ry=\"14\"/></g>"-    <> "<g fill=\"#ffffff\"><path d=\"M12 54L19 54L23 10L16 10Z\"/><path d=\"M16 10L23 10L48 54L41 54Z\"/><path d=\"M41 54L48 54L52 10L45 10Z\"/></g>"-    <> "</svg>"---- | The same mark, URL-escaped for a data-URI favicon link.-novaveroLogoSvgEscaped :: Text-novaveroLogoSvgEscaped =-  T.concatMap escapeForDataUri novaveroLogoSvg-  where-    escapeForDataUri c = case c of-      '<' -> "%3C"-      '>' -> "%3E"-      '"' -> "%22"-      '#' -> "%23"-      other -> T.singleton other---- | Content-Type and caching headers for the landing page.  Stats change as--- paths are added, so it stays briefly cacheable but revalidates.-htmlHeaders :: HTTP.ResponseHeaders-htmlHeaders =-  [ (HTTP.hContentType, "text/html; charset=utf-8"),-    (HTTP.hCacheControl, "public, max-age=300, must-revalidate")-  ]---- | 404 Not Found response.-notFound :: Response-notFound = responseLBS HTTP.status404 textHeaders "not found"---- | 400 Bad Request with a text error message.-badRequest :: Text -> Response-badRequest msg = responseLBS HTTP.status400 textHeaders (BL.fromStrict (TE.encodeUtf8 msg))---- | Map any uncaught handler exception to a generic 500, so internal error--- detail (filesystem paths, exception text) is never leaked to clients.-onExceptionResponse :: SomeException -> Response-onExceptionResponse _ = responseLBS HTTP.status500 textHeaders "internal server error"---- | Content-Type: text/plain headers.-textHeaders :: HTTP.ResponseHeaders-textHeaders = [(HTTP.hContentType, "text/plain")]---- | Content-Type and caching headers for a narinfo response.--- A narinfo body is NOT immutable for a fixed key - re-uploading the same store--- path to add or rotate a signature changes it - so it is cacheable but must--- stay revalidatable (no @immutable@).-narInfoHeaders :: HTTP.ResponseHeaders-narInfoHeaders =-  [ (HTTP.hContentType, "text/x-nix-narinfo"),-    (HTTP.hCacheControl, "public, max-age=3600, must-revalidate")-  ]---- | Content-Type: application/octet-stream headers.--- NAR files are content-addressed (keyed by content hash) and immutable--- once written, so they are safe to cache indefinitely at the CDN edge.-octetHeaders :: HTTP.ResponseHeaders-octetHeaders =-  [ (HTTP.hContentType, "application/octet-stream"),-    (HTTP.hCacheControl, "public, max-age=31536000, immutable")-  ]

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               nova-cache-version:            0.4.2.1+version:            0.5.0.0 synopsis:           Pure-first Nix binary cache protocol library description:   A pure-first library implementing the Nix binary cache protocol -@@ -20,18 +20,14 @@ tested-with:        GHC == 9.8.4 extra-doc-files:     CHANGELOG.md+    NOTICE     README.md  flag server-  description: Build the cache server executable (pulls in warp/wai)+  description: Build the cache server executable (pulls in warp and wai-extra)   default:     False   manual:      True -flag compression-  description: Enable LZMA/XZ compression (requires system liblzma)-  default:     True-  manual:      True- library   exposed-modules:     NovaCache.Base32@@ -39,15 +35,12 @@     NovaCache.Hash     NovaCache.NAR     NovaCache.NarInfo+    NovaCache.Server     NovaCache.Signing     NovaCache.Store     NovaCache.StorePath     NovaCache.Validate -  if flag(compression)-    exposed-modules: NovaCache.Compression-    build-depends:   lzma >= 0.0.1 && < 0.1-   build-depends:       base                >= 4.16 && < 5     , base64-bytestring   >= 1.2 && < 1.3@@ -56,9 +49,11 @@     , crypton             >= 1.1 && < 2     , directory           >= 1.3 && < 1.4     , filepath            >= 1.4 && < 1.6+    , http-types          >= 0.12 && < 0.13     , ram                 >= 0.20 && < 1     , text                >= 2.0 && < 2.2     , vector              >= 0.12 && < 0.14+    , wai                 >= 3.2 && < 3.3     hs-source-dirs:   src@@ -77,6 +72,7 @@     buildable: False    main-is:          Main.hs+  other-modules:    LandingPage   hs-source-dirs:   exe   default-language:  Haskell2010   default-extensions:@@ -86,9 +82,7 @@   build-depends:       base                >= 4.16 && < 5     , bytestring          >= 0.11 && < 0.13-    , crypton             >= 1.1 && < 2     , nova-cache-    , ram                 >= 0.20 && < 1     , http-types          >= 0.12 && < 0.13     , text                >= 2.0 && < 2.2     , wai                 >= 3.2 && < 3.3@@ -110,26 +104,12 @@     , bytestring          >= 0.11 && < 0.13     , crypton             >= 1.1 && < 2     , directory           >= 1.3 && < 1.4+    , http-types          >= 0.12 && < 0.13     , nova-cache     , ram                 >= 0.20 && < 1     , text                >= 2.0 && < 2.2--test-suite nova-cache-compression-test-  if !flag(compression)-    buildable: False--  type:             exitcode-stdio-1.0-  main-is:          CompressionTest.hs-  hs-source-dirs:   test-  default-language: Haskell2010-  default-extensions:-    OverloadedStrings-  ghc-options:      -Wall -Wcompat--  build-depends:-      base                >= 4.16 && < 5-    , bytestring          >= 0.11 && < 0.13-    , nova-cache+    , wai                 >= 3.2 && < 3.3+    , wai-extra           >= 3.1 && < 3.2  source-repository head   type:     git

@@ -1,35 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}---- | xz compression and decompression for NAR files.------ Thin wrappers around the @lzma@ package, converting between strict--- 'ByteString' and the underlying lazy interface.-module NovaCache.Compression-  ( compressXz,-    decompressXz,-  )-where--import qualified Codec.Compression.Lzma as Lzma-import Control.Exception (SomeAsyncException, SomeException, evaluate, fromException, throwIO, try)-import Data.ByteString (ByteString)-import qualified Data.ByteString.Lazy as BL---- | Compress a strict 'ByteString' with xz.-compressXz :: ByteString -> ByteString-compressXz = BL.toStrict . Lzma.compress . BL.fromStrict---- | Decompress an xz-compressed strict 'ByteString'.------ Returns 'Left' with an error message if the input is not valid xz data.-decompressXz :: ByteString -> IO (Either String ByteString)-decompressXz bs = do-  result <- try (evaluate (BL.toStrict (Lzma.decompress (BL.fromStrict bs))))-  case result of-    Right decompressed -> pure (Right decompressed)-    -- Catch only SYNCHRONOUS failures; re-raise async exceptions (timeout,-    -- ThreadKilled) so a caller's timeout/cancellation still works on this-    -- untrusted-input decoder.-    Left err-      | Just (_ :: SomeAsyncException) <- fromException err -> throwIO err-      | otherwise -> pure (Left ("xz decompression failed: " ++ show (err :: SomeException)))

@@ -254,7 +254,10 @@     -- path-traversal surface for any future NAR-extraction consumer.     checkName prev name       | T.null name = Left "empty NAR directory entry name"-      | name == "." || name == ".." || T.any (\c -> c == '/' || c == '\0') name =+      -- Backslash is a directory separator on Windows - this library's+      -- primary consumer - so a name like "..\out.exe" is as much a+      -- traversal vector as one with '/'.+      | name == "." || name == ".." || T.any (\c -> c == '/' || c == '\\' || c == '\0') name =           Left ("unsafe NAR directory entry name: " ++ T.unpack name)       | Just p <- prev,         name <= p =@@ -287,12 +290,17 @@             ++ " exceeds remaining "             ++ show (BS.length payload)         )+  -- Nix's reader rejects nonzero padding; accepting it would let archives+  -- that upstream tooling refuses round-trip through this library.+  | BS.any (/= 0) padding =+      Left "nonzero padding bytes in NAR string"   | otherwise =       Right (BS.take (fromIntegral len) payload, BS.drop totalLen payload)   where     len = readWord64LE bs     payload = BS.drop wordSize bs     totalLen = fromIntegral len + narPad (fromIntegral len)+    padding = BS.take (totalLen - fromIntegral len) (BS.drop (fromIntegral len) payload)  -- | Read a little-endian 'Word64' from the first 8 bytes. readWord64LE :: ByteString -> Word64

@@ -21,12 +21,17 @@ -- ---------------------------------------------------------------------------  -- | A parsed @.narinfo@ record. All fields are strict.+--+-- Field optionality mirrors upstream Nix's parser: only StorePath, URL,+-- NarHash, and NarSize are mandatory; Compression defaults to bzip2 when+-- absent, and FileHash\/FileSize describe the compressed blob only when+-- the cache provides them. data NarInfo = NarInfo   { niStorePath :: !Text,     niUrl :: !Text,     niCompression :: !Text,-    niFileHash :: !Text,-    niFileSize :: !Integer,+    niFileHash :: !(Maybe Text),+    niFileSize :: !(Maybe Integer),     niNarHash :: !Text,     niNarSize :: !Integer,     niReferences :: ![Text],@@ -69,23 +74,29 @@ -- Parsing -- --------------------------------------------------------------------------- --- | Parse a narinfo text body into a 'NarInfo'.+-- | Compression assumed when the narinfo omits the field, as upstream's+-- parser does.+defaultCompression :: Text+defaultCompression = "bzip2"++-- | Parse a narinfo text body into a 'NarInfo'.  Only StorePath, URL,+-- NarHash, and NarSize are required, matching upstream Nix; a valid+-- narinfo from a foreign cache must not be rejected over an absent+-- optional field. parseNarInfo :: Text -> Either String NarInfo parseNarInfo txt = do   let kvs = mapMaybe parseLine (T.lines txt)   storePath <- require keyStorePath kvs   url <- require keyUrl kvs-  compression <- require keyCompression kvs-  fileHash <- require keyFileHash kvs-  fileSize <- require keyFileSize kvs >>= parseInteger keyFileSize+  fileSize <- traverse (parseInteger keyFileSize) (lookupFirst keyFileSize kvs)   narHashVal <- require keyNarHash kvs   narSize <- require keyNarSize kvs >>= parseInteger keyNarSize   pure     NarInfo       { niStorePath = storePath,         niUrl = url,-        niCompression = compression,-        niFileHash = fileHash,+        niCompression = fromMaybe defaultCompression (lookupFirst keyCompression kvs),+        niFileHash = lookupFirst keyFileHash kvs,         niFileSize = fileSize,         niNarHash = narHashVal,         niNarSize = narSize,@@ -112,13 +123,14 @@   T.unlines $     [ kv keyStorePath (niStorePath ni),       kv keyUrl (niUrl ni),-      kv keyCompression (niCompression ni),-      kv keyFileHash (niFileHash ni),-      kv keyFileSize (showT (niFileSize ni)),-      kv keyNarHash (niNarHash ni),-      kv keyNarSize (showT (niNarSize ni)),-      kv keyReferences (T.unwords (niReferences ni))+      kv keyCompression (niCompression ni)     ]+      ++ optionalKV keyFileHash (niFileHash ni)+      ++ optionalKV keyFileSize (showT <$> niFileSize ni)+      ++ [ kv keyNarHash (niNarHash ni),+           kv keyNarSize (showT (niNarSize ni)),+           kv keyReferences (T.unwords (niReferences ni))+         ]       ++ optionalKV keyDeriver (niDeriver ni)       ++ map (kv keySig) (niSigs ni)       ++ optionalKV keyCA (niCA ni)

@@ -0,0 +1,414 @@+-- | The Nix binary cache HTTP protocol as a WAI 'Network.Wai.Application'.+--+-- An IO-boundary module like "NovaCache.Store": routing, write+-- authentication, request-body limits, and the narinfo+-- validation\/signing pipeline of a cache server.  Deployment identity+-- stays out of the library: the root page is supplied per deployment via+-- 'scRootResponse' ('defaultRootResponse' otherwise), so the published+-- package carries no operator branding.+--+-- Protocol surface:+--+-- @+-- GET  \/nix-cache-info      cache metadata+-- GET  \/\<hash\>.narinfo      narinfo by store-path hash+-- GET  \/nar\/\<file\>          NAR payload (streamed from disk)+-- GET  \/narinfo-hashes      stored-hash listing (authenticated; push-tool plumbing)+-- PUT  \/\<hash\>.narinfo      validated, signed, stored (authenticated)+-- PUT  \/nar\/\<file\>          streamed to disk under a size cap (authenticated)+-- @+--+-- HEAD is answered wherever GET is: routing treats the two identically+-- and Warp elides the body while keeping the status and headers.+module NovaCache.Server+  ( -- * Configuration+    ServerConfig (..),+    defaultRootResponse,++    -- * Application+    cacheApp,+    onExceptionResponse,++    -- * Body limits+    maxNarInfoBodySize,+    maxNarBodySize,++    -- * Handler pieces (exported for tests)+    requireAuth,+    readBodyLimited,+    withLimitedBody,+    decodeAndValidate,+    narInfoHashMatches,+    signNarInfo,+    renderCacheInfo,+  )+where++import Data.Bifunctor (first)+import Data.ByteArray (constEq)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy as BL+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Network.HTTP.Types as HTTP+import Network.Wai+  ( Application,+    Request,+    RequestBodyLength (..),+    Response,+    ResponseReceived,+    getRequestBodyChunk,+    pathInfo,+    requestBodyLength,+    requestHeaders,+    requestMethod,+    responseFile,+    responseLBS,+  )+import NovaCache.NarInfo (NarInfo (..), parseNarInfo, renderNarInfo)+import NovaCache.Signing (SecretKey, sign)+import NovaCache.Store+  ( CacheInfo (..),+    FileStore,+    NarWriteResult (..),+    getCacheInfo,+    listNarInfoHashes,+    narFilePath,+    readNarInfo,+    writeNarInfo,+    writeNarStreaming,+  )+import NovaCache.StorePath (defaultStoreDir, parseStorePath, storePathHashString)+import NovaCache.Validate (validateNarInfo)+import System.IO (hPutStrLn, stderr)++-- ---------------------------------------------------------------------------+-- Constants+-- ---------------------------------------------------------------------------++-- | Maximum narinfo request body - narinfo is small text, so a tight cap.+maxNarInfoBodySize :: Int+maxNarInfoBodySize = 4 * 1024 * 1024 -- 4 MB++-- | Maximum NAR request body.  A real store path's NAR can be very large+-- (toolchains, GHC, LLVM), so this is far higher than the narinfo cap.+-- Uploads stream to disk, so the cap bounds storage abuse, not memory.+maxNarBodySize :: Int+maxNarBodySize = 4 * 1024 * 1024 * 1024 -- 4 GB++-- | Suffix of narinfo request paths (@\/\<hash\>.narinfo@).+narInfoSuffix :: Text+narInfoSuffix = ".narinfo"++-- ---------------------------------------------------------------------------+-- Configuration+-- ---------------------------------------------------------------------------++-- | Server configuration: the store, the write credential, the signing+-- key, and the deployment's root page.+data ServerConfig = ServerConfig+  { scStore :: !FileStore,+    -- | Write API key.  'Nothing' permits unauthenticated writes (open+    -- mode); arming it with an empty key is the embedder's bug to+    -- prevent - an empty bearer token would then authenticate.+    scApiKey :: !(Maybe ByteString),+    -- | Narinfo signing key.  'Nothing' stores uploads unsigned.+    scSigningKey :: !(Maybe SecretKey),+    -- | Response for @GET \/@, recomputed per request so it can carry+    -- live stats.  Branding belongs to the embedding executable, never+    -- this library.+    scRootResponse :: !(IO Response)+  }++-- | Root response for embedders that do not supply a landing page:+-- enough for a human to identify the service, nothing else.+defaultRootResponse :: IO Response+defaultRootResponse =+  pure (responseLBS HTTP.status200 textHeaders "nova-cache: a Nix binary cache\n")++-- ---------------------------------------------------------------------------+-- WAI application+-- ---------------------------------------------------------------------------++-- | WAI application implementing the Nix binary cache HTTP protocol.+cacheApp :: ServerConfig -> Application+cacheApp cfg req respond = case (routeMethod, pathInfo req) of+  -- GET / - the deployment's page (protocol lives at the other routes)+  ("GET", []) ->+    respond =<< scRootResponse cfg+  -- GET /nix-cache-info+  ("GET", ["nix-cache-info"]) ->+    respond (responseLBS HTTP.status200 textHeaders (BL.fromStrict (renderCacheInfo (scStore cfg))))+  -- GET /narinfo-hashes - push-tool plumbing: it enumerates the whole+  -- store (something the public protocol deliberately never offers) and+  -- lists a directory per hit, so it is gated behind the write key and+  -- marked uncacheable.+  ("GET", ["narinfo-hashes"]) ->+    requireAuth cfg req respond $ do+      hashes <- listNarInfoHashes (scStore cfg)+      let body = TE.encodeUtf8 (T.unlines hashes)+      respond (responseLBS HTTP.status200 hashListHeaders (BL.fromStrict body))+  -- GET /<hash>.narinfo+  ("GET", [hashNarinfo])+    | Just hashKey <- T.stripSuffix narInfoSuffix hashNarinfo -> do+        result <- readNarInfo (scStore cfg) hashKey+        case result of+          Just content ->+            respond (responseLBS HTTP.status200 narInfoHeaders (BL.fromStrict content))+          Nothing ->+            respond notFound+  -- GET /nar/<file> - handed to the transport layer as a file so the+  -- OS streams it; a multi-GB NAR never transits the Haskell heap.+  ("GET", ["nar", fileName]) -> do+    found <- narFilePath (scStore cfg) fileName+    case found of+      Just path ->+        respond (responseFile HTTP.status200 octetHeaders path Nothing)+      Nothing ->+        respond notFound+  -- PUT /<hash>.narinfo (auth required, validated)+  ("PUT", [hashNarinfo])+    | Just hashKey <- T.stripSuffix narInfoSuffix hashNarinfo ->+        requireAuth cfg req respond $+          withLimitedBody maxNarInfoBodySize req respond $ \body ->+            case decodeAndValidate body of+              Left err -> do+                logWarn req ("INVALID: " <> T.unpack err)+                respond (badRequest err)+              Right ni+                | not (narInfoHashMatches hashKey ni) -> do+                    logWarn req "HASHMISMATCH"+                    respond (badRequest "narinfo StorePath hash does not match request")+                | otherwise -> do+                    signedResult <- signNarInfo (scSigningKey cfg) ni+                    case signedResult of+                      Left err -> do+                        logWarn req ("SIGNFAIL: " <> err)+                        respond (responseLBS HTTP.status500 textHeaders "signing failed")+                      Right signed -> do+                        ok <- writeNarInfo (scStore cfg) hashKey signed+                        if ok+                          then respond (responseLBS HTTP.status200 textHeaders "ok")+                          else do+                            logWarn req "BADPATH"+                            respond (badRequest "invalid path")+  -- PUT /nar/<file> (auth required, streamed)+  ("PUT", ["nar", fileName]) ->+    requireAuth cfg req respond (putNar cfg req respond fileName)+  -- Fallback+  _ ->+    respond notFound+  where+    -- HEAD is served as GET: the handlers build the same response and+    -- Warp elides the body while keeping status, headers, and the+    -- computed Content-Length.+    routeMethod =+      if requestMethod req == HTTP.methodHead+        then HTTP.methodGet+        else requestMethod req++-- | Stream a NAR upload into the store.  A declared @Content-Length@ over+-- the cap is refused before reading anything; chunked or lying transfers+-- are cut off by the store's running size check, so memory and storage+-- stay bounded either way.+putNar :: ServerConfig -> Request -> (Response -> IO ResponseReceived) -> Text -> IO ResponseReceived+putNar cfg req respond fileName = case requestBodyLength req of+  KnownLength len+    | len > fromIntegral maxNarBodySize -> overLimit+  _ -> do+    result <- writeNarStreaming (scStore cfg) fileName maxNarBodySize (getRequestBodyChunk req)+    case result of+      NarWriteOk -> respond (responseLBS HTTP.status200 textHeaders "ok")+      NarWriteTooLarge -> overLimit+      NarWriteBadPath -> do+        logWarn req "BADPATH"+        respond (badRequest "invalid path")+  where+    overLimit = do+      logWarn req "OVERLIMIT"+      respond (responseLBS HTTP.status413 textHeaders "request body too large")++-- ---------------------------------------------------------------------------+-- Validation pipeline+-- ---------------------------------------------------------------------------++-- | Decode a raw narinfo body and validate it in a single pure pipeline.+--+-- Composes UTF-8 decoding, narinfo parsing, and field validation. Returns+-- the validated 'NarInfo' on success, or a user-facing error message.+decodeAndValidate :: ByteString -> Either Text NarInfo+decodeAndValidate body = do+  decoded <- first (const "request body is not valid UTF-8") (TE.decodeUtf8' body)+  ni <- first T.pack (parseNarInfo decoded)+  first (T.unlines . map (T.pack . show)) (validateNarInfo ni)++-- | Whether the narinfo's declared StorePath actually carries the requested+-- hash - so an authenticated writer cannot store a narinfo describing path X+-- under path Y's key (a cache-poisoning / confused-deputy shape).+narInfoHashMatches :: Text -> NarInfo -> Bool+narInfoHashMatches hashKey ni =+  case parseStorePath defaultStoreDir (niStorePath ni) of+    Right sp -> storePathHashString sp == hashKey+    Left _ -> False++-- ---------------------------------------------------------------------------+-- Request body limiting+-- ---------------------------------------------------------------------------++-- | Read the request body, rejecting payloads over the given limit.+--+-- A declared @Content-Length@ over the limit is rejected up front; otherwise+-- (including unsized/chunked transfers) the body is read in bounded chunks with+-- a running size check that aborts before exceeding the limit, so memory stays+-- bounded regardless of the declared length.+readBodyLimited :: Int -> Request -> IO (Maybe ByteString)+readBodyLimited limit req = case requestBodyLength req of+  KnownLength len+    | len > fromIntegral limit -> pure Nothing+  _ -> readChunks [] 0+  where+    readChunks acc total = do+      chunk <- getRequestBodyChunk req+      if BS.null chunk+        then pure (Just (BS.concat (reverse acc)))+        else+          let newTotal = total + BS.length chunk+           in if newTotal > limit+                then pure Nothing+                else readChunks (chunk : acc) newTotal++-- | Run an action with the limited request body, responding 413 if too large.+withLimitedBody :: Int -> Request -> (Response -> IO ResponseReceived) -> (ByteString -> IO ResponseReceived) -> IO ResponseReceived+withLimitedBody limit req respond action = do+  bodyResult <- readBodyLimited limit req+  case bodyResult of+    Nothing -> do+      logWarn req "OVERLIMIT"+      respond (responseLBS HTTP.status413 textHeaders "request body too large")+    Just body -> action body++-- ---------------------------------------------------------------------------+-- Auth+-- ---------------------------------------------------------------------------++-- | Gate a handler behind API key authentication.+--+-- If no key is configured, the action is permitted (open mode).+-- Otherwise the request must carry @Authorization: Bearer \<key\>@.+-- Uses constant-time comparison to prevent timing attacks.+requireAuth :: ServerConfig -> Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived -> IO ResponseReceived+requireAuth cfg req respond action = case scApiKey cfg of+  Nothing -> action+  Just expected ->+    let provided = lookup HTTP.hAuthorization (requestHeaders req)+        expectedHeader = "Bearer " <> expected+     in if maybe False (constEq expectedHeader) provided+          then action+          else do+            logWarn req "REJECTED"+            respond (responseLBS HTTP.status401 textHeaders "unauthorized")++-- ---------------------------------------------------------------------------+-- Signing+-- ---------------------------------------------------------------------------++-- | Sign a validated 'NarInfo' if a signing key is configured.+--+-- With no key, returns the unsigned rendering (intentional - the operator+-- configured none).  With a key, FAILS CLOSED: a signing error returns 'Left'+-- so the handler refuses the write rather than persisting an unsigned narinfo+-- on a cache that is supposed to sign.+signNarInfo :: Maybe SecretKey -> NarInfo -> IO (Either String ByteString)+signNarInfo Nothing ni = pure (Right (renderNarInfoBytes ni))+signNarInfo (Just sk) ni = case sign sk ni of+  Left err -> do+    hPutStrLn stderr ("ERROR: signNarInfo: sign failed: " ++ err)+    pure (Left err)+  Right sig ->+    let signed = ni {niSigs = niSigs ni ++ [sig]}+     in pure (Right (renderNarInfoBytes signed))++-- | Render a 'NarInfo' to its UTF-8 encoded wire format.+renderNarInfoBytes :: NarInfo -> ByteString+renderNarInfoBytes = TE.encodeUtf8 . renderNarInfo++-- ---------------------------------------------------------------------------+-- Logging+-- ---------------------------------------------------------------------------++-- | Log a server-side warning to stderr with request context.+logWarn :: Request -> String -> IO ()+logWarn req msg =+  hPutStrLn stderr $+    msg+      <> " "+      <> BS8.unpack (requestMethod req)+      <> " /"+      <> T.unpack (T.intercalate "/" (pathInfo req))++-- ---------------------------------------------------------------------------+-- Response helpers+-- ---------------------------------------------------------------------------++-- | Render the nix-cache-info response body.+renderCacheInfo :: FileStore -> ByteString+renderCacheInfo store =+  let info = getCacheInfo store+   in TE.encodeUtf8 $+        T.unlines+          [ "StoreDir: " <> ciStoreDir info,+            "WantMassQuery: " <> boolText (ciWantMassQuery info),+            "Priority: " <> T.pack (show (ciPriority info))+          ]++-- | Render a Bool as @1@ or @0@.+boolText :: Bool -> Text+boolText True = "1"+boolText False = "0"++-- | 404 Not Found response.+notFound :: Response+notFound = responseLBS HTTP.status404 textHeaders "not found"++-- | 400 Bad Request with a text error message.+badRequest :: Text -> Response+badRequest msg = responseLBS HTTP.status400 textHeaders (BL.fromStrict (TE.encodeUtf8 msg))++-- | Map any uncaught handler exception to a generic 500, so internal error+-- detail (filesystem paths, exception text) is never leaked to clients.+onExceptionResponse :: e -> Response+onExceptionResponse _ = responseLBS HTTP.status500 textHeaders "internal server error"++-- | Content-Type: text/plain headers.+textHeaders :: HTTP.ResponseHeaders+textHeaders = [(HTTP.hContentType, "text/plain")]++-- | Headers for the authenticated hash listing: push-tool plumbing that+-- changes with every upload, so intermediaries must never cache it.+hashListHeaders :: HTTP.ResponseHeaders+hashListHeaders =+  [ (HTTP.hContentType, "text/plain"),+    (HTTP.hCacheControl, "no-store")+  ]++-- | Content-Type and caching headers for a narinfo response.+-- A narinfo body is NOT immutable for a fixed key - re-uploading the same store+-- path to add or rotate a signature changes it - so it is cacheable but must+-- stay revalidatable (no @immutable@).+narInfoHeaders :: HTTP.ResponseHeaders+narInfoHeaders =+  [ (HTTP.hContentType, "text/x-nix-narinfo"),+    (HTTP.hCacheControl, "public, max-age=3600, must-revalidate")+  ]++-- | Content-Type: application/octet-stream headers.+-- NAR files are content-addressed (keyed by content hash) and immutable+-- once written, so they are safe to cache indefinitely at the CDN edge.+octetHeaders :: HTTP.ResponseHeaders+octetHeaders =+  [ (HTTP.hContentType, "application/octet-stream"),+    (HTTP.hCacheControl, "public, max-age=31536000, immutable")+  ]

@@ -24,6 +24,7 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Base64 as B64+import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as TE@@ -128,15 +129,22 @@   keyName <> keySeparator <> TE.decodeLatin1 (B64.encode bytes)  -- | Split a @name:base64@ string and decode the base64 payload.+-- An empty name or empty payload is corrupt, as upstream's Key+-- constructor treats it: an empty-named key would sign every narinfo+-- with @:sig@ lines no client's named trust anchor can ever match, so+-- the misconfiguration must fail at key-load time, not as silent+-- signature rejection downstream. splitAndDecode :: Text -> String -> Either String (Text, ByteString) splitAndDecode txt label = case T.breakOn keySeparator txt of-  (_, rest)+  (keyName, rest)     | T.null rest -> Left (label ++ " missing ':' separator")+    | T.null keyName -> Left (label ++ " has an empty name before ':'")+    | T.null encoded -> Left (label ++ " has empty key material after ':'")     | otherwise -> do-        let encoded = T.drop 1 rest-            keyName = fst (T.breakOn keySeparator txt)         decoded <- decodeBase64 encoded         pure (keyName, decoded)+    where+      encoded = T.drop 1 rest  -- | Assert that decoded bytes have the expected size. expectSize :: Int -> String -> ByteString -> Either String ()@@ -167,13 +175,17 @@       niStorePath ni,       niNarHash ni,       T.pack (show (niNarSize ni)),-      T.intercalate referenceSep (map (storeDir <>) (niReferences ni))+      T.intercalate referenceSep (map (storeDir <>) sortedReferences)     ]   where     -- References in a narinfo are basenames, but the fingerprint signs them as     -- full store paths (/nix/store/<hash>-<name>), matching C++ Nix.  The store     -- directory is the leading path of the (already absolute) niStorePath.     storeDir = T.dropWhileEnd (/= '/') (niStorePath ni)+    -- C++ Nix fingerprints a StorePathSet - references sorted by basename,+    -- deduplicated - so the narinfo's file order must not leak into the+    -- signature: real Nix clients always verify against the sorted form.+    sortedReferences = Set.toAscList (Set.fromList (niReferences ni))  -- --------------------------------------------------------------------------- -- Signing and verification

@@ -13,6 +13,9 @@     writeNarInfo,     readNar,     writeNar,+    NarWriteResult (..),+    writeNarStreaming,+    narFilePath,     listNarInfoHashes,     CacheInfo (..),     getCacheInfo,@@ -135,6 +138,56 @@ writeNar fs fileName body = case sanitizePath fileName of   Nothing -> pure False   Just safe -> atomicWriteFile (fsRoot fs </> narSubdir </> safe) body >> pure True++-- | Outcome of a streaming NAR write.+data NarWriteResult+  = -- | Fully written and atomically renamed into place.+    NarWriteOk+  | -- | The chunk stream exceeded the size cap; the partial temp file+    -- was deleted and nothing changed in the store.+    NarWriteTooLarge+  | -- | The filename failed 'sanitizePath'; nothing was written.+    NarWriteBadPath+  deriving (Eq, Show)++-- | Stream a NAR to disk from a chunk source (an empty chunk means end of+-- input), enforcing a total-size cap as bytes arrive so the body is never+-- held in memory.  Same atomic temp-then-rename discipline as 'writeNar':+-- readers see the old file or the complete new one, never a partial write.+writeNarStreaming :: FileStore -> Text -> Int -> IO ByteString -> IO NarWriteResult+writeNarStreaming fs fileName limit nextChunk = case sanitizePath fileName of+  Nothing -> pure NarWriteBadPath+  Just safe -> do+    let target = fsRoot fs </> narSubdir </> safe+    (tmpPath, handle) <- openBinaryTempFile (takeDirectory target) tempFilePrefix+    let cleanup = do+          ignoringExceptions (hClose handle)+          ignoringExceptions (removeFile tmpPath)+        consume !total = do+          chunk <- nextChunk+          if BS.null chunk+            then do+              hClose handle+              renameFile tmpPath target+              pure NarWriteOk+            else+              let grown = total + BS.length chunk+               in if grown > limit+                    then cleanup >> pure NarWriteTooLarge+                    else BS.hPut handle chunk >> consume grown+    consume 0 `onException` cleanup++-- | The on-disk path of a stored NAR, if present.  Lets a server hand the+-- file to its transport layer (e.g. WAI's @responseFile@, which streams+-- from disk) instead of buffering the bytes; the name passes the same+-- 'sanitizePath' contract as 'readNar'.+narFilePath :: FileStore -> Text -> IO (Maybe FilePath)+narFilePath fs fileName = case sanitizePath fileName of+  Nothing -> pure Nothing+  Just safe -> do+    let path = fsRoot fs </> narSubdir </> safe+    exists <- doesFileExist path+    pure (if exists then Just path else Nothing)  -- --------------------------------------------------------------------------- -- Listing

@@ -9,6 +9,8 @@     StorePathHash (..),     StorePathName (..),     parseStorePath,+    parseStorePathBaseName,+    parseAbsoluteStorePath,     renderStorePath,     storePathHashString,     storePathBaseName,@@ -16,7 +18,7 @@   ) where -import Data.Char (isAlphaNum)+import Data.Char (isAlphaNum, isAscii) import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T@@ -69,16 +71,22 @@ hashNameSeparator :: Char hashNameSeparator = '-' +-- | Maximum length of a store path name, as enforced by Nix.+maxNameLen :: Int+maxNameLen = 211+ -- --------------------------------------------------------------------------- -- Validation -- ---------------------------------------------------------------------------  -- | Characters allowed in the name component of a store path. ----- Alphanumeric plus @-._+?=@, matching the Nix specification.+-- ASCII alphanumeric plus @-._+?=@, matching the Nix specification.  The+-- ASCII restriction matters: Nix rejects non-ASCII letters and digits, so+-- accepting them here would sign and store paths no Nix client can parse. validNameChar :: Char -> Bool validNameChar c =-  isAlphaNum c+  (isAscii c && isAlphaNum c)     || c == '-'     || c == '_'     || c == '.'@@ -93,10 +101,31 @@ -- | Parse a store path from a full path or bare basename. -- -- Accepts @\/nix\/store\/\<hash\>-\<name\>@ or just @\<hash\>-\<name\>@.+-- Wire-format fields have a REQUIRED spelling; use 'parseStorePathBaseName'+-- (narinfo References, Deriver) or 'parseAbsoluteStorePath' (narinfo+-- StorePath) to enforce it. parseStorePath :: StoreDir -> Text -> Either String StorePath parseStorePath (StoreDir dir) txt =   parseBaseName (stripDirPrefix dir txt) +-- | Parse a bare @\<hash\>-\<name\>@ basename, rejecting any path separator.+-- Narinfo References and Deriver are basenames on the wire; upstream Nix+-- rejects tokens containing @\/@ outright.+parseStorePathBaseName :: Text -> Either String StorePath+parseStorePathBaseName txt+  | T.any (== '/') txt =+      Left ("expected a store path basename, got a path: " ++ T.unpack txt)+  | otherwise = parseBaseName txt++-- | Parse a full @\<store-dir\>\/\<hash\>-\<name\>@ path, rejecting a bare+-- basename.  The narinfo StorePath field is absolute on the wire.+parseAbsoluteStorePath :: StoreDir -> Text -> Either String StorePath+parseAbsoluteStorePath (StoreDir dir) txt =+  case T.stripPrefix (T.pack dir <> "/") txt of+    Just basename -> parseBaseName basename+    Nothing ->+      Left ("expected an absolute store path under " ++ dir ++ ": " ++ T.unpack txt)+ -- | Strip the store directory prefix if present. stripDirPrefix :: FilePath -> Text -> Text stripDirPrefix dir txt =@@ -115,6 +144,8 @@       Left ("invalid nix-base32 hash in store path: " ++ T.unpack hashPart)   | T.null name =       Left ("empty name in store path: " ++ T.unpack basename)+  | T.length name > maxNameLen =+      Left ("store path name longer than " ++ show maxNameLen ++ " characters: " ++ T.unpack name)   | not (T.all validNameChar name) =       Left ("invalid characters in store path name: " ++ T.unpack name)   | otherwise =

@@ -19,7 +19,7 @@ import NovaCache.Hash (formatNixHash, hashBytes, parseNixHash) import NovaCache.NarInfo (NarInfo (..)) import NovaCache.Signing (PublicKey, verify)-import NovaCache.StorePath (defaultStoreDir, parseStorePath)+import NovaCache.StorePath (defaultStoreDir, parseAbsoluteStorePath, parseStorePathBaseName)  -- --------------------------------------------------------------------------- -- Types@@ -65,19 +65,26 @@     errs -> Left errs   where     sizeErrors =-      [NegativeFileSize (niFileSize ni) | niFileSize ni < 0]+      [NegativeFileSize declared | Just declared <- [niFileSize ni], declared < 0]         ++ [NegativeNarSize (niNarSize ni) | niNarSize ni < 0]      drvErrors =       [DerivationStorePath (niStorePath ni) | ".drv" `T.isSuffixOf` niStorePath ni] -    storePathErrors = case parseStorePath defaultStoreDir (niStorePath ni) of+    -- The wire format fixes each field's spelling: StorePath is absolute,+    -- References and Deriver are basenames.  Accepting the other spelling+    -- would sign narinfos (bare StorePath, absolute references) that every+    -- real Nix client rejects at parse time - and a bare StorePath also+    -- derives an empty store dir in the signed fingerprint.+    storePathErrors = case parseAbsoluteStorePath defaultStoreDir (niStorePath ni) of       Left err -> [InvalidStorePath (niStorePath ni) err]       Right _ -> [] -    fileHashErrors = case parseNixHash (niFileHash ni) of-      Left err -> [InvalidFileHash (niFileHash ni) err]-      Right _ -> []+    fileHashErrors = case niFileHash ni of+      Nothing -> []+      Just declared -> case parseNixHash declared of+        Left err -> [InvalidFileHash declared err]+        Right _ -> []      narHashErrors = case parseNixHash (niNarHash ni) of       Left err -> [InvalidNarHash (niNarHash ni) err]@@ -85,7 +92,7 @@      refErrors = concatMap checkRef (niReferences ni) -    checkRef ref = case parseStorePath defaultStoreDir ref of+    checkRef ref = case parseStorePathBaseName ref of       Left err -> [InvalidReference ref err]       Right _ -> [] @@ -97,8 +104,11 @@ -- the declared 'niNarHash'. validateNarHash :: NarInfo -> ByteString -> Either ValidationError () validateNarHash ni narBytes =-  -- Compare DECODED hash bytes, not re-formatted strings, so any valid encoding-  -- of the declared NarHash (SRI, hex, base32) validates against the same digest.+  -- Compare DECODED hash bytes, not re-formatted strings.  Only the+  -- canonical sha256:<nix-base32> spelling parses - deliberately strict,+  -- since the fingerprint signs the NarHash TEXT verbatim; accepting other+  -- encodings on the read side arrives with the foreign-cache substitution+  -- feature that needs them.   case parseNixHash (niNarHash ni) of     Left err -> Left (InvalidNarHash (niNarHash ni) err)     Right declared@@ -106,14 +116,17 @@       | otherwise -> Left (NarHashMismatch (niNarHash ni) (formatNixHash (hashBytes narBytes)))  -- | Validate that the SHA-256 hash of compressed file bytes matches--- the declared 'niFileHash'.+-- the declared 'niFileHash'.  An absent FileHash declares nothing to+-- check (upstream treats the field as optional); integrity then rests on+-- the always-required NarHash. validateFileHash :: NarInfo -> ByteString -> Either ValidationError ()-validateFileHash ni fileBytes =-  case parseNixHash (niFileHash ni) of-    Left err -> Left (InvalidFileHash (niFileHash ni) err)+validateFileHash ni fileBytes = case niFileHash ni of+  Nothing -> Right ()+  Just declaredText -> case parseNixHash declaredText of+    Left err -> Left (InvalidFileHash declaredText err)     Right declared       | declared == hashBytes fileBytes -> Right ()-      | otherwise -> Left (FileHashMismatch (niFileHash ni) (formatNixHash (hashBytes fileBytes)))+      | otherwise -> Left (FileHashMismatch declaredText (formatNixHash (hashBytes fileBytes)))  -- --------------------------------------------------------------------------- -- Signature validation

@@ -1,88 +0,0 @@-module Main (main) where--import qualified Data.ByteString as BS-import qualified NovaCache.Compression as Compression-import System.Exit (exitFailure, exitSuccess)-import System.IO (hFlush, stdout)---- | Run a named test, short-circuit on first failure.-test :: String -> IO Bool -> IO Bool-test name action = do-  putStr ("  " ++ name ++ "... ")-  hFlush stdout-  result <- action-  if result-    then do-      putStrLn "OK"-      pure True-    else do-      putStrLn "FAILED"-      pure False---- | Assert equality.-assertEqual :: (Eq a, Show a) => String -> a -> a -> IO Bool-assertEqual label expected actual-  | expected == actual = pure True-  | otherwise = do-      putStrLn ""-      putStrLn ("    " ++ label)-      putStrLn ("    expected: " ++ show expected)-      putStrLn ("    actual:   " ++ show actual)-      pure False---- | Assert a Bool is True.-assertTrue :: String -> Bool -> IO Bool-assertTrue _ True = pure True-assertTrue label False = do-  putStrLn ""-  putStrLn ("    " ++ label ++ ": expected True")-  pure False---- | Assert a Right value matches.-assertRight :: (Eq a, Show a) => String -> a -> Either String a -> IO Bool-assertRight label expected (Right actual) = assertEqual label expected actual-assertRight label _ (Left err) = do-  putStrLn ""-  putStrLn ("    " ++ label)-  putStrLn ("    expected Right, got Left: " ++ err)-  pure False---- | Assert a Left (error case).-assertLeft :: (Show a) => String -> Either String a -> IO Bool-assertLeft _ (Left _) = pure True-assertLeft label (Right val) = do-  putStrLn ""-  putStrLn ("    " ++ label)-  putStrLn ("    expected Left, got Right: " ++ show val)-  pure False--main :: IO ()-main = do-  putStrLn "nova-cache compression tests"-  putStrLn "=============================="-  putStrLn ""-  putStrLn "Compression:"-  ok1 <--    test "compress/decompress roundtrip" $ do-      let input = BS.pack [72, 101, 108, 108, 111, 32, 87, 111, 114, 108, 100]-          compressed = Compression.compressXz input-      result <- Compression.decompressXz compressed-      assertRight "roundtrip" input result-  ok2 <--    test "compress/decompress roundtrip (empty)" $ do-      let compressed = Compression.compressXz BS.empty-      result <- Compression.decompressXz compressed-      assertRight "roundtrip empty" BS.empty result-  ok3 <--    test "compressed is smaller for repetitive data" $-      let input = BS.replicate 10000 0x42-          compressed = Compression.compressXz input-       in assertTrue "smaller" (BS.length compressed < BS.length input)-  ok4 <--    test "decompress invalid data returns Left" $ do-      result <- Compression.decompressXz (BS.pack [0, 1, 2, 3])-      assertLeft "invalid xz" result-  putStrLn ""-  if ok1 && ok2 && ok3 && ok4-    then putStrLn "All compression tests passed." >> exitSuccess-    else putStrLn "Some compression tests failed." >> exitFailure

@@ -1,23 +1,35 @@+{-# LANGUAGE LambdaCase #-}+ module Main (main) where +import Control.Exception (SomeException, try) import qualified Crypto.PubKey.Ed25519 as Ed25519+import Data.Bits (shiftR, (.&.)) import Data.ByteArray (convert) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Base64 as B64+import qualified Data.ByteString.Lazy as BL+import Data.IORef (atomicModifyIORef', newIORef) import Data.List (sort)+import Data.Maybe (isJust) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as TE+import Data.Word (Word8)+import qualified Network.HTTP.Types as HTTP+import Network.Wai (RequestBodyLength (..), defaultRequest, pathInfo, requestBodyLength, requestHeaders, requestMethod)+import qualified Network.Wai.Test as WT import qualified NovaCache.Base32 as Base32 import qualified NovaCache.Hash as Hash import qualified NovaCache.NAR as NAR import qualified NovaCache.NarInfo as NarInfo+import qualified NovaCache.Server as Server import qualified NovaCache.Signing as Signing import qualified NovaCache.Store as Store import qualified NovaCache.StorePath as StorePath import qualified NovaCache.Validate as Validate-import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive)+import System.Directory (createDirectory, getTemporaryDirectory, listDirectory, removeDirectoryRecursive) import System.Exit (exitFailure, exitSuccess) import System.IO (hFlush, stdout) @@ -123,7 +135,8 @@       testNarInfo,       testSigning,       testFileStore,-      testValidate+      testValidate,+      testServer     ]  -- ---------------------------------------------------------------------------@@ -162,10 +175,17 @@             encoded = Base32.encode bs          in assertEqual "encoded length" 52 (T.length encoded),       test "nix known vector" $-        -- SHA-256 of empty string in nix-base32 should be 52 chars-        let Hash.NixHash raw = Hash.hashBytes BS.empty-            encoded = Base32.encode raw-         in assertEqual "sha256 of empty in base32 length" 52 (T.length encoded)+        -- SHA-256 of the empty string exactly as real Nix renders it.  A+        -- wrong alphabet or bit order stays self-consistent in roundtrips;+        -- only an external vector catches it.+        assertEqual+          "sha256 of empty in nix-base32"+          "sha256:0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73"+          (Hash.formatNixHash (Hash.hashBytes BS.empty)),+      test "decode rejects nonzero padding bits" $+        -- 52 chars carry 260 bits for a 256-bit value; the 4 spare bits+        -- must be zero in canonical nix-base32.+        assertLeft "nonzero padding" (Base32.decode (T.replicate 52 "z"))     ]  -- ---------------------------------------------------------------------------@@ -311,9 +331,76 @@             h2 = NAR.narHash (NAR.NarRegular False (BS.pack [2]))          in assertTrue "different hashes" (h1 /= h2),       test "deserialise garbage fails" $-        assertLeft "garbage" (NAR.deserialise (BS.pack [0, 0, 0, 0, 0, 0, 0, 0]))+        assertLeft "garbage" (NAR.deserialise (BS.pack [0, 0, 0, 0, 0, 0, 0, 0])),+      test "roundtrip edge: empty directory" $+        let entry = NAR.NarDirectory []+         in assertRight "empty dir" entry (NAR.deserialise (NAR.serialise entry)),+      test "roundtrip edge: contents a multiple of 8 (zero padding)" $+        let entry = NAR.NarRegular False (BS.replicate 8 0x41)+         in assertRight "8-byte contents" entry (NAR.deserialise (NAR.serialise entry)),+      test "roundtrip edge: executable empty file" $+        let entry = NAR.NarRegular True BS.empty+         in assertRight "exec empty" entry (NAR.deserialise (NAR.serialise entry)),+      -- Cache-served archives are untrusted input: every name that could+      -- traverse out of an extraction root must fail the parse.+      test "unsafe directory entry names rejected" $+        let evil name = NAR.serialise (NAR.NarDirectory [(name, NAR.NarRegular False "x")])+            names = ["..", ".", "", "a/b", "a\\b", "a\0b"]+            rejected bytes = either (const True) (const False) (NAR.deserialise bytes)+         in assertTrue "all unsafe names rejected" (all (rejected . evil) names),+      test "duplicate directory entries rejected" $+        let dup =+              NAR.serialise+                ( NAR.NarDirectory+                    [ ("same", NAR.NarRegular False "1"),+                      ("same", NAR.NarRegular False "2")+                    ]+                )+         in assertLeft "duplicate entries" (NAR.deserialise dup),+      test "out-of-order directory entries rejected" $+        assertLeft "unsorted entries" (NAR.deserialise outOfOrderDirNar),+      test "trailing bytes after the root node rejected" $+        let valid = NAR.serialise (NAR.NarRegular False "x")+         in assertLeft "trailing bytes" (NAR.deserialise (valid <> "junk1234")),+      test "nonzero string padding rejected" $+        assertLeft "nonzero padding" (NAR.deserialise badPaddingNar)     ] +-- | Encode one NAR wire string with a chosen padding byte.  The spec+-- demands zero padding, so a nonzero byte builds archives the parser+-- must reject - and 'NAR.serialise' (rightly) cannot produce them.+narWireStr :: Word8 -> ByteString -> ByteString+narWireStr padByte str = lenLE <> str <> BS.replicate padLen padByte+  where+    n = BS.length str+    lenLE = BS.pack [fromIntegral ((n `shiftR` (8 * i)) .&. 0xff) | i <- [0 .. 7]]+    padLen = (8 - n `mod` 8) `mod` 8++-- | A directory NAR whose entries arrive out of sorted order - again not+-- producible via 'NAR.serialise', which sorts on write.+outOfOrderDirNar :: ByteString+outOfOrderDirNar =+  BS.concat+    ( map+        (narWireStr 0)+        ( ["nix-archive-1", "(", "type", "directory"]+            ++ entryFor "b"+            ++ entryFor "a"+            ++ [")"]+        )+    )+  where+    entryFor name = ["entry", "(", "name", name, "node", "(", "type", "regular", "contents", "", ")", ")"]++-- | A regular-file NAR whose contents padding is nonzero.+badPaddingNar :: ByteString+badPaddingNar =+  BS.concat+    [ BS.concat (map (narWireStr 0) ["nix-archive-1", "(", "type", "regular", "contents"]),+      narWireStr 1 "abc",+      narWireStr 0 ")"+    ]+ -- --------------------------------------------------------------------------- -- NarInfo tests -- ---------------------------------------------------------------------------@@ -347,7 +434,7 @@             ok1 <- assertEqual "storePath" "/nix/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-hello-1.0" (NarInfo.niStorePath ni)             ok2 <- assertEqual "url" "nar/1234abcd.nar.xz" (NarInfo.niUrl ni)             ok3 <- assertEqual "compression" "xz" (NarInfo.niCompression ni)-            ok4 <- assertEqual "fileSize" 12345 (NarInfo.niFileSize ni)+            ok4 <- assertEqual "fileSize" (Just 12345) (NarInfo.niFileSize ni)             ok5 <- assertEqual "narSize" 67890 (NarInfo.niNarSize ni)             ok6 <- assertEqual "refs count" 2 (length (NarInfo.niReferences ni))             ok7 <- assertEqual "deriver" (Just "cccccccccccccccccccccccccccccccc-hello-1.0.drv") (NarInfo.niDeriver ni)@@ -388,6 +475,44 @@                 ok3 <- assertEqual "ca" Nothing (NarInfo.niCA ni)                 ok4 <- assertEqual "refs" [] (NarInfo.niReferences ni)                 pure (ok1 && ok2 && ok3 && ok4),+      test "CRLF-terminated narinfo parses identically" $+        assertEqual+          "crlf tolerated"+          (NarInfo.parseNarInfo sampleNarInfoText)+          (NarInfo.parseNarInfo (T.replace "\n" "\r\n" sampleNarInfoText)),+      test "upstream-optional fields default as upstream" $+        -- Only StorePath, URL, NarHash, NarSize are mandatory upstream;+        -- Compression defaults to bzip2 and FileHash/FileSize stay absent.+        let bare =+              T.unlines+                [ "StorePath: /nix/store/aaaa-test",+                  "URL: nar/test.nar.xz",+                  "NarHash: sha256:def",+                  "NarSize: 200"+                ]+         in case NarInfo.parseNarInfo bare of+              Left err -> do+                putStrLn ("  parse failed: " ++ err)+                pure False+              Right ni -> do+                ok1 <- assertEqual "compression default" "bzip2" (NarInfo.niCompression ni)+                ok2 <- assertEqual "fileHash absent" Nothing (NarInfo.niFileHash ni)+                ok3 <- assertEqual "fileSize absent" Nothing (NarInfo.niFileSize ni)+                pure (ok1 && ok2 && ok3),+      test "CA field parse/render roundtrip" $+        let withCA = sampleNarInfoText <> "CA: fixed:r:sha256:0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73\n"+         in case NarInfo.parseNarInfo withCA of+              Left err -> do+                putStrLn ("  parse failed: " ++ err)+                pure False+              Right ni -> do+                ok1 <-+                  assertEqual+                    "ca parsed"+                    (Just "fixed:r:sha256:0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73")+                    (NarInfo.niCA ni)+                ok2 <- assertRight "ca survives render" ni (NarInfo.parseNarInfo (NarInfo.renderNarInfo ni))+                pure (ok1 && ok2),       test "parse missing required key fails" $         let incomplete = T.unlines ["StorePath: /nix/store/aaaa-test", "URL: nar/test.nar.xz"]          in assertLeft "missing key" (NarInfo.parseNarInfo incomplete),@@ -427,6 +552,22 @@          in assertTrue               "reference is a full /nix/store path in the fingerprint"               (T.isInfixOf "/nix/store/00000000000000000000000000000000-glibc-2.40" fp),+      test "fingerprint sorts and dedupes references" $+        let ni =+              mkTestNarInfo+                { NarInfo.niReferences =+                    [ "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb-zlib-1.3",+                      "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-glibc-2.40",+                      "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb-zlib-1.3"+                    ]+                }+            fp = Signing.fingerprint ni+         in assertTrue+              "references sorted by basename and deduplicated (C++ Nix parity)"+              ( T.isSuffixOf+                  "/nix/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-glibc-2.40,/nix/store/bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb-zlib-1.3"+                  fp+              ),       test "parseSecretKey valid" $         let keyBytes = BS.pack ([1 .. 32] ++ [33 .. 64])             keyB64 = TE.decodeUtf8 (B64.encode keyBytes)@@ -449,6 +590,40 @@                 assertEqual "key name" "test-key" (Signing.pkName pk),       test "parseSecretKey no colon fails" $         assertLeft "no colon" (Signing.parseSecretKey "nokeyname"),+      test "empty key name rejected" $+        -- An empty-named key would emit :sig lines no named trust anchor+        -- matches; the misconfiguration must fail at load time.+        let material = TE.decodeUtf8 (B64.encode (BS.pack [1 .. 64]))+         in assertLeft "empty name" (Signing.parseSecretKey (":" <> material)),+      test "empty key material rejected" $+        assertLeft "empty material" (Signing.parsePublicKey "test-key:"),+      test "signature from a different keypair rejected" $ do+        signingKey <- generateTestSecretKey+        otherKey <- generateTestSecretKey+        let verifier = deriveTestPublicKey otherKey+        case Signing.sign signingKey mkTestNarInfo of+          Left err -> do+            putStrLn ("  sign failed: " ++ err)+            pure False+          Right signed ->+            assertTrue "cross-key rejected" (not (Signing.verify verifier mkTestNarInfo signed)),+      test "valid signature under a renamed trust anchor rejected" $ do+        signingKey <- generateTestSecretKey+        let renamed = (deriveTestPublicKey signingKey) {Signing.pkName = "some-other-cache"}+        case Signing.sign signingKey mkTestNarInfo of+          Left err -> do+            putStrLn ("  sign failed: " ++ err)+            pure False+          Right signed ->+            assertTrue "name mismatch rejected" (not (Signing.verify renamed mkTestNarInfo signed)),+      test "malformed signature lines rejected" $ do+        signingKey <- generateTestSecretKey+        let verifier = deriveTestPublicKey signingKey+            wrongSize = "test-key:" <> TE.decodeUtf8 (B64.encode (BS.pack [1 .. 16]))+            badLines = ["test-key:!!!not-base64!!!", wrongSize, "test-key:", "no-colon-at-all"]+        assertTrue+          "all malformed rejected"+          (not (any (Signing.verify verifier mkTestNarInfo) badLines)),       test "parsePublicKey wrong size fails" $         let keyStr = "test-key:" <> TE.decodeUtf8 (B64.encode (BS.pack [1 .. 16]))          in assertLeft "wrong size" (Signing.parsePublicKey keyStr),@@ -515,8 +690,8 @@     { NarInfo.niStorePath = "/nix/store/aaaa-hello-1.0",       NarInfo.niUrl = "nar/test.nar.xz",       NarInfo.niCompression = "xz",-      NarInfo.niFileHash = "sha256:abc",-      NarInfo.niFileSize = 100,+      NarInfo.niFileHash = Just "sha256:abc",+      NarInfo.niFileSize = Just 100,       NarInfo.niNarHash = "sha256:def",       NarInfo.niNarSize = 200,       NarInfo.niReferences = ["aaaa-hello-1.0"],@@ -638,8 +813,8 @@     { NarInfo.niStorePath = "/nix/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-hello-1.0",       NarInfo.niUrl = "nar/test.nar.xz",       NarInfo.niCompression = "xz",-      NarInfo.niFileHash = Hash.formatNixHash (Hash.hashBytes validFileBytes),-      NarInfo.niFileSize = 5,+      NarInfo.niFileHash = Just (Hash.formatNixHash (Hash.hashBytes validFileBytes)),+      NarInfo.niFileSize = Just 5,       NarInfo.niNarHash = Hash.formatNixHash (Hash.hashBytes validNarBytes),       NarInfo.niNarSize = 5,       NarInfo.niReferences = ["aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-hello-1.0"],@@ -658,7 +833,7 @@           (Right mkValidNarInfo)           (Validate.validateNarInfo mkValidNarInfo),       test "validateNarInfo negative FileSize" $-        let ni = mkValidNarInfo {NarInfo.niFileSize = -1}+        let ni = mkValidNarInfo {NarInfo.niFileSize = Just (-1)}          in assertEqual               "negative filesize"               (Left [Validate.NegativeFileSize (-1)])@@ -687,7 +862,7 @@                 putStrLn ("    expected Left [InvalidStorePath ..], got: " ++ show other)                 pure False,       test "validateNarInfo bad FileHash" $-        let ni = mkValidNarInfo {NarInfo.niFileHash = "md5:bogus"}+        let ni = mkValidNarInfo {NarInfo.niFileHash = Just "md5:bogus"}          in case Validate.validateNarInfo ni of               Left [Validate.InvalidFileHash raw _] ->                 assertEqual "raw value" "md5:bogus" raw@@ -713,7 +888,7 @@       test "validateNarInfo multiple errors collected" $         let ni =               mkValidNarInfo-                { NarInfo.niFileSize = -1,+                { NarInfo.niFileSize = Just (-1),                   NarInfo.niNarSize = -1,                   NarInfo.niStorePath = "bad"                 }@@ -788,7 +963,7 @@       test "validateFull multiple failures" $ do         sk <- generateTestSecretKey         let pk = deriveTestPublicKey sk-            ni = mkValidNarInfo {NarInfo.niFileSize = -1, NarInfo.niNarSize = -1}+            ni = mkValidNarInfo {NarInfo.niFileSize = Just (-1), NarInfo.niNarSize = -1}         case Validate.validateFull pk ni (BS.pack [99]) (BS.pack [99]) of           Left errs -> assertTrue "at least 4 errors" (length errs >= 4)           Right _ -> do@@ -797,15 +972,303 @@     ]  -- ---------------------------------------------------------------------------+-- Server (WAI) tests+-- ---------------------------------------------------------------------------++-- | The write key the authenticated-server tests configure.+serverTestApiKey :: ByteString+serverTestApiKey = "test-api-key"++-- | The Authorization header 'serverTestApiKey' expects.+serverAuthHeader :: HTTP.Header+serverAuthHeader = (HTTP.hAuthorization, "Bearer " <> serverTestApiKey)++-- | Store-path hash of 'validServerNarInfo' (32 nix-base32 zeros).+validNarInfoHashKey :: Text+validNarInfoHashKey = T.replicate 32 "0"++-- | A canonical all-zero sha256 in nix-base32: 52 digits, and the 4+-- spare bits of the 260-bit encoding are zero, so it parses.+zeroNarHash :: Text+zeroNarHash = "sha256:" <> T.replicate 52 "0"++-- | A narinfo that passes 'Validate.validateNarInfo' end to end, keyed+-- under 'validNarInfoHashKey'.+validServerNarInfo :: NarInfo.NarInfo+validServerNarInfo =+  NarInfo.NarInfo+    { NarInfo.niStorePath = "/nix/store/" <> validNarInfoHashKey <> "-hello-1.0",+      NarInfo.niUrl = "nar/test.nar",+      NarInfo.niCompression = "none",+      NarInfo.niFileHash = Nothing,+      NarInfo.niFileSize = Nothing,+      NarInfo.niNarHash = zeroNarHash,+      NarInfo.niNarSize = 200,+      NarInfo.niReferences = [validNarInfoHashKey <> "-hello-1.0"],+      NarInfo.niDeriver = Nothing,+      NarInfo.niSigs = [],+      NarInfo.niCA = Nothing+    }++-- | Rendered wire form of 'validServerNarInfo'.+validServerNarInfoBytes :: BL.ByteString+validServerNarInfoBytes =+  BL.fromStrict (TE.encodeUtf8 (NarInfo.renderNarInfo validServerNarInfo))++-- | Run one test against a fresh server (configurable write key and+-- signing key), removing the store directory afterwards.+withServer :: Maybe ByteString -> Maybe Signing.SecretKey -> (Server.ServerConfig -> IO Bool) -> IO Bool+withServer apiKey sigKey body = do+  tmpDir <- createTestDir+  store <- Store.newFileStore tmpDir+  passed <-+    body+      Server.ServerConfig+        { Server.scStore = store,+          Server.scApiKey = apiKey,+          Server.scSigningKey = sigKey,+          Server.scRootResponse = Server.defaultRootResponse+        }+  removeDirectoryRecursive tmpDir+  pure passed++-- | 'withServer' with write auth armed and no signing - the common case.+withAuthedServer :: (Server.ServerConfig -> IO Bool) -> IO Bool+withAuthedServer = withServer (Just serverTestApiKey) Nothing++-- | Execute a single request against the server.+serverRequest :: Server.ServerConfig -> BS.ByteString -> [Text] -> [HTTP.Header] -> BL.ByteString -> IO WT.SResponse+serverRequest cfg method segments headers body =+  WT.runSession (WT.srequest (WT.SRequest req body)) (Server.cacheApp cfg)+  where+    req =+      defaultRequest+        { requestMethod = method,+          pathInfo = segments,+          requestHeaders = headers+        }++-- | Like 'serverRequest', with a declared Content-Length - for the+-- reject-before-reading limit checks.+serverRequestSized :: Server.ServerConfig -> BS.ByteString -> [Text] -> [HTTP.Header] -> Word -> IO WT.SResponse+serverRequestSized cfg method segments headers declared =+  WT.runSession (WT.srequest (WT.SRequest req "")) (Server.cacheApp cfg)+  where+    req =+      defaultRequest+        { requestMethod = method,+          pathInfo = segments,+          requestHeaders = headers,+          requestBodyLength = KnownLength (fromIntegral declared)+        }++-- | A chunk source yielding the given chunks, then empty (end of input).+chunkSource :: [ByteString] -> IO (IO ByteString)+chunkSource chunks = do+  remaining <- newIORef chunks+  pure $+    atomicModifyIORef' remaining $ \case+      [] -> ([], BS.empty)+      (c : cs) -> (cs, c)++-- | Body bytes as strict ByteString, for infix assertions.+strictBody :: WT.SResponse -> ByteString+strictBody = BL.toStrict . WT.simpleBody++testServer :: IO Bool+testServer =+  runGroup+    "Server"+    [ test "GET / serves the default root response" $+        withServer Nothing Nothing $ \cfg -> do+          resp <- serverRequest cfg "GET" [] [] ""+          ok1 <- assertEqual "status" HTTP.status200 (WT.simpleStatus resp)+          ok2 <- assertEqual "body" "nova-cache: a Nix binary cache\n" (WT.simpleBody resp)+          pure (ok1 && ok2),+      test "GET /nix-cache-info renders cache metadata" $+        withServer Nothing Nothing $ \cfg -> do+          resp <- serverRequest cfg "GET" ["nix-cache-info"] [] ""+          ok1 <- assertEqual "status" HTTP.status200 (WT.simpleStatus resp)+          ok2 <- assertTrue "StoreDir line" (BS.isInfixOf "StoreDir: /nix/store" (strictBody resp))+          pure (ok1 && ok2),+      test "unknown route is 404" $+        withServer Nothing Nothing $ \cfg -> do+          resp <- serverRequest cfg "GET" ["no", "such", "route"] [] ""+          assertEqual "status" HTTP.status404 (WT.simpleStatus resp),+      -- HEAD is routed exactly like GET (upstream clients probe narinfo+      -- existence with HEAD; it used to fall through to 404).+      test "HEAD is served wherever GET is" $+        withServer Nothing Nothing $ \cfg -> do+          okResp <- serverRequest cfg "HEAD" ["nix-cache-info"] [] ""+          missingResp <- serverRequest cfg "HEAD" [validNarInfoHashKey <> ".narinfo"] [] ""+          ok1 <- assertEqual "present" HTTP.status200 (WT.simpleStatus okResp)+          ok2 <- assertEqual "absent" HTTP.status404 (WT.simpleStatus missingResp)+          pure (ok1 && ok2),+      -- Write authentication+      test "PUT narinfo without auth is 401" $+        withAuthedServer $ \cfg -> do+          resp <- serverRequest cfg "PUT" [validNarInfoHashKey <> ".narinfo"] [] validServerNarInfoBytes+          assertEqual "status" HTTP.status401 (WT.simpleStatus resp),+      test "PUT narinfo with the wrong key is 401" $+        withAuthedServer $ \cfg -> do+          let wrongAuth = (HTTP.hAuthorization, "Bearer not-the-key")+          resp <- serverRequest cfg "PUT" [validNarInfoHashKey <> ".narinfo"] [wrongAuth] validServerNarInfoBytes+          assertEqual "status" HTTP.status401 (WT.simpleStatus resp),+      test "PUT then GET narinfo roundtrip" $+        withAuthedServer $ \cfg -> do+          putResp <- serverRequest cfg "PUT" [validNarInfoHashKey <> ".narinfo"] [serverAuthHeader] validServerNarInfoBytes+          getResp <- serverRequest cfg "GET" [validNarInfoHashKey <> ".narinfo"] [] ""+          ok1 <- assertEqual "PUT status" HTTP.status200 (WT.simpleStatus putResp)+          ok2 <- assertEqual "GET status" HTTP.status200 (WT.simpleStatus getResp)+          ok3 <- assertTrue "StorePath present" (BS.isInfixOf (TE.encodeUtf8 validNarInfoHashKey) (strictBody getResp))+          ok4 <-+            assertEqual+              "revalidatable, never immutable"+              (Just "public, max-age=3600, must-revalidate")+              (lookup HTTP.hCacheControl (WT.simpleHeaders getResp))+          pure (ok1 && ok2 && ok3 && ok4),+      test "PUT narinfo signs when a key is configured" $ do+        sigKey <- generateTestSecretKey+        withServer (Just serverTestApiKey) (Just sigKey) $ \cfg -> do+          putResp <- serverRequest cfg "PUT" [validNarInfoHashKey <> ".narinfo"] [serverAuthHeader] validServerNarInfoBytes+          getResp <- serverRequest cfg "GET" [validNarInfoHashKey <> ".narinfo"] [] ""+          ok1 <- assertEqual "PUT status" HTTP.status200 (WT.simpleStatus putResp)+          ok2 <- assertTrue "Sig line present" (BS.isInfixOf "Sig: test-key:" (strictBody getResp))+          pure (ok1 && ok2),+      -- The confused-deputy gate: a narinfo describing path X cannot be+      -- stored under path Y's key.+      test "PUT narinfo under a mismatched hash is 400" $+        withAuthedServer $ \cfg -> do+          let otherKey = T.replicate 32 "1" <> ".narinfo"+          resp <- serverRequest cfg "PUT" [otherKey] [serverAuthHeader] validServerNarInfoBytes+          assertEqual "status" HTTP.status400 (WT.simpleStatus resp),+      test "PUT malformed narinfo is 400" $+        withAuthedServer $ \cfg -> do+          resp <- serverRequest cfg "PUT" [validNarInfoHashKey <> ".narinfo"] [serverAuthHeader] "not a narinfo"+          assertEqual "status" HTTP.status400 (WT.simpleStatus resp),+      test "PUT narinfo with an oversized declared length is 413" $+        withAuthedServer $ \cfg -> do+          resp <-+            serverRequestSized+              cfg+              "PUT"+              [validNarInfoHashKey <> ".narinfo"]+              [serverAuthHeader]+              (fromIntegral Server.maxNarInfoBodySize + 1)+          assertEqual "status" HTTP.status413 (WT.simpleStatus resp),+      -- The hash listing is push-tool plumbing: authenticated, uncacheable.+      test "GET /narinfo-hashes without auth is 401" $+        withAuthedServer $ \cfg -> do+          resp <- serverRequest cfg "GET" ["narinfo-hashes"] [] ""+          assertEqual "status" HTTP.status401 (WT.simpleStatus resp),+      test "GET /narinfo-hashes with auth lists hashes, uncacheable" $+        withAuthedServer $ \cfg -> do+          putResp <- serverRequest cfg "PUT" [validNarInfoHashKey <> ".narinfo"] [serverAuthHeader] validServerNarInfoBytes+          resp <- serverRequest cfg "GET" ["narinfo-hashes"] [serverAuthHeader] ""+          ok1 <- assertEqual "PUT status" HTTP.status200 (WT.simpleStatus putResp)+          ok2 <- assertEqual "status" HTTP.status200 (WT.simpleStatus resp)+          ok3 <- assertTrue "uploaded hash listed" (BS.isInfixOf (TE.encodeUtf8 validNarInfoHashKey) (strictBody resp))+          ok4 <- assertEqual "no-store" (Just "no-store") (lookup HTTP.hCacheControl (WT.simpleHeaders resp))+          pure (ok1 && ok2 && ok3 && ok4),+      test "GET /narinfo-hashes in open mode needs no auth" $+        withServer Nothing Nothing $ \cfg -> do+          resp <- serverRequest cfg "GET" ["narinfo-hashes"] [] ""+          assertEqual "status" HTTP.status200 (WT.simpleStatus resp),+      -- NAR transfer+      test "PUT then GET and HEAD a NAR" $+        withAuthedServer $ \cfg -> do+          putResp <- serverRequest cfg "PUT" ["nar", "test.nar"] [serverAuthHeader] "nar-payload-bytes"+          getResp <- serverRequest cfg "GET" ["nar", "test.nar"] [] ""+          headResp <- serverRequest cfg "HEAD" ["nar", "test.nar"] [] ""+          ok1 <- assertEqual "PUT status" HTTP.status200 (WT.simpleStatus putResp)+          ok2 <- assertEqual "GET status" HTTP.status200 (WT.simpleStatus getResp)+          ok3 <- assertEqual "GET body" "nar-payload-bytes" (WT.simpleBody getResp)+          ok4 <-+            assertEqual+              "immutable content address"+              (Just "public, max-age=31536000, immutable")+              (lookup HTTP.hCacheControl (WT.simpleHeaders getResp))+          ok5 <- assertEqual "HEAD status" HTTP.status200 (WT.simpleStatus headResp)+          pure (ok1 && ok2 && ok3 && ok4 && ok5),+      test "PUT NAR without auth is 401" $+        withAuthedServer $ \cfg -> do+          resp <- serverRequest cfg "PUT" ["nar", "test.nar"] [] "nar-payload-bytes"+          assertEqual "status" HTTP.status401 (WT.simpleStatus resp),+      test "PUT NAR with a traversal name is 400" $+        withAuthedServer $ \cfg -> do+          resp <- serverRequest cfg "PUT" ["nar", ".."] [serverAuthHeader] "escape"+          assertEqual "status" HTTP.status400 (WT.simpleStatus resp),+      test "PUT NAR with an oversized declared length is 413" $+        withAuthedServer $ \cfg -> do+          resp <-+            serverRequestSized+              cfg+              "PUT"+              ["nar", "test.nar"]+              [serverAuthHeader]+              (fromIntegral Server.maxNarBodySize + 1)+          assertEqual "status" HTTP.status413 (WT.simpleStatus resp),+      test "GET absent NAR is 404" $+        withServer Nothing Nothing $ \cfg -> do+          resp <- serverRequest cfg "GET" ["nar", "absent.nar"] [] ""+          assertEqual "status" HTTP.status404 (WT.simpleStatus resp),+      -- Streaming write, at the store layer+      test "writeNarStreaming writes chunks and lands atomically" $ do+        tmpDir <- createTestDir+        store <- Store.newFileStore tmpDir+        source <- chunkSource ["ab", "cd", "ef"]+        result <- Store.writeNarStreaming store "streamed.nar" 16 source+        stored <- Store.readNar store "streamed.nar"+        located <- Store.narFilePath store "streamed.nar"+        removeDirectoryRecursive tmpDir+        ok1 <- assertEqual "result" Store.NarWriteOk result+        ok2 <- assertEqual "content" (Just "abcdef") stored+        ok3 <- assertTrue "narFilePath resolves" (isJust located)+        pure (ok1 && ok2 && ok3),+      test "writeNarStreaming over the cap deletes the partial file" $ do+        tmpDir <- createTestDir+        store <- Store.newFileStore tmpDir+        source <- chunkSource ["four", "more", "over"]+        result <- Store.writeNarStreaming store "big.nar" 8 source+        leftovers <- listDirectory (tmpDir ++ "/nar")+        removeDirectoryRecursive tmpDir+        ok1 <- assertEqual "result" Store.NarWriteTooLarge result+        ok2 <- assertEqual "no partial files" [] leftovers+        pure (ok1 && ok2),+      test "writeNarStreaming rejects a traversal name" $ do+        tmpDir <- createTestDir+        store <- Store.newFileStore tmpDir+        source <- chunkSource ["x"]+        result <- Store.writeNarStreaming store "../escape" 8 source+        removeDirectoryRecursive tmpDir+        assertEqual "result" Store.NarWriteBadPath result,+      test "narFilePath rejects a traversal name" $ do+        tmpDir <- createTestDir+        store <- Store.newFileStore tmpDir+        located <- Store.narFilePath store "../escape"+        removeDirectoryRecursive tmpDir+        assertEqual "path" Nothing located+    ]++-- --------------------------------------------------------------------------- -- Helpers -- --------------------------------------------------------------------------- --- | Create a temporary test directory.+-- | A fresh, unique directory under the system temp dir.  A fixed+-- machine-global path poisons later runs whenever cleanup is skipped and+-- races concurrent checkouts; probing numbered names until createDirectory+-- succeeds gives uniqueness against both. createTestDir :: IO FilePath createTestDir = do-  let dir = "/tmp/nova-cache-test"-  createDirectoryIfMissing True dir-  pure dir+  base <- getTemporaryDirectory+  probe base (0 :: Int)+  where+    probe base n = do+      let dir = base ++ "/nova-cache-test-" ++ show n+      made <- try (createDirectory dir) :: IO (Either SomeException ())+      case made of+        Right () -> pure dir+        Left _ -> probe base (n + 1)  -- | Generate a test Ed25519 secret key using crypton. generateTestSecretKey :: IO Signing.SecretKey