packages feed

nova-cache 0.4.0.0 → 0.4.1.0

raw patch · 12 files changed

+303/−103 lines, 12 files

Files

CHANGELOG.md view
@@ -1,5 +1,13 @@ # Changelog +## 0.4.1.0 — 2026-06-10++- **Server: landing page at `GET /`** — a human-facing page with live stats+  (store-path count, signing status, priority), the substituter snippet, and+  protocol endpoint documentation. The cache protocol routes are unchanged;+  the page is briefly cacheable (`max-age=300, must-revalidate`) since its+  stats change as paths are added.+ ## 0.4.0.0 — 2026-06-08  ### Breaking changes
exe/Main.hs view
@@ -6,7 +6,7 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS8 import qualified Data.ByteString.Lazy as BL-import Data.Maybe (fromMaybe)+import Data.Maybe (fromMaybe, isJust) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as TE@@ -28,7 +28,8 @@ import Network.Wai.Middleware.RequestLogger (logStdout) import NovaCache.NarInfo (NarInfo (..), parseNarInfo, renderNarInfo) import NovaCache.Signing (SecretKey, parseSecretKey, sign)-import NovaCache.Store (FileStore, getCacheInfo, listNarInfoHashes, newFileStore, readNar, readNarInfo, writeNar, writeNarInfo)+import NovaCache.Store (CacheInfo (..), FileStore, getCacheInfo, listNarInfoHashes, newFileStore, readNar, readNarInfo, writeNar, writeNarInfo)+import NovaCache.StorePath (defaultStoreDir, parseStorePath, storePathHashString) import NovaCache.Validate (validateNarInfo) import System.Environment (getArgs, lookupEnv) import System.Exit (exitFailure)@@ -59,10 +60,16 @@ requestLogEnvVar :: String requestLogEnvVar = "LOG_REQUESTS" --- | Maximum allowed request body size (100 MB).-maxBodySize :: Int-maxBodySize = 100 * 1024 * 1024+-- | 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 -- ---------------------------------------------------------------------------@@ -87,12 +94,15 @@   sigKeyPath <- lookupEnv signingKeyEnvVar   logRequestsEnv <- lookupEnv requestLogEnvVar -  let port = case args of-        ("--port" : p : _) -> fromMaybe defaultPort (readMaybe p)-        _ -> maybe defaultPort (fromMaybe defaultPort . readMaybe) portEnv-      storeRoot = case args of-        ("--store" : s : _) -> s-        _ -> fromMaybe defaultStoreRoot storeEnv+  -- Order-independent flag parsing: take the value following a flag wherever it+  -- appears, so e.g. `--allow-open-writes --port 8080` still honours --port.+  let argValue flag = case dropWhile (/= flag) args of+        (_ : v : _) -> Just v+        _ -> Nothing+      port = case argValue "--port" >>= readMaybe of+        Just p -> p+        Nothing -> maybe defaultPort (fromMaybe defaultPort . readMaybe) portEnv+      storeRoot = fromMaybe (fromMaybe defaultStoreRoot storeEnv) (argValue "--store")       allowOpenWrites = "--allow-open-writes" `elem` args    store <- newFileStore storeRoot@@ -150,6 +160,13 @@ -- | 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 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))))@@ -179,23 +196,32 @@   ("PUT", [hashNarinfo])     | Just hashKey <- T.stripSuffix ".narinfo" hashNarinfo ->         requireAuth cfg req respond $-          withLimitedBody req respond $ \body ->+          withLimitedBody maxNarInfoBodySize req respond $ \body ->             case decodeAndValidate body of               Left err -> do                 logWarn req ("INVALID: " <> T.unpack err)                 respond (badRequest err)-              Right ni -> do-                signed <- signNarInfo (cfgSigningKey cfg) ni-                ok <- writeNarInfo (cfgStore cfg) hashKey signed-                if ok-                  then respond (responseLBS HTTP.status200 textHeaders "ok")-                  else do-                    logWarn req "BADPATH"-                    respond (badRequest "invalid path")+              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 req respond $ \body -> do+      withLimitedBody maxNarBodySize req respond $ \body -> do         ok <- writeNar (cfgStore cfg) fileName body         if ok           then respond (responseLBS HTTP.status200 textHeaders "ok")@@ -220,37 +246,45 @@   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 'maxBodySize'.+-- | Read the request body, rejecting payloads over the given limit. ----- Returns 'Nothing' if the declared @Content-Length@ exceeds the limit.--- For chunked transfers the body is read and checked after the fact.-readBodyLimited :: Request -> IO (Maybe BS.ByteString)-readBodyLimited req = case requestBodyLength req of+-- 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 maxBodySize -> pure Nothing+    | len > fromIntegral limit -> pure Nothing   _ -> readChunks [] 0   where-    -- Stream the body in chunks, aborting as soon as the running total-    -- exceeds the cap — so an unsized (chunked) upload can never buffer-    -- more than 'maxBodySize' into memory.     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 > maxBodySize+           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 :: Request -> (Response -> IO ResponseReceived) -> (BS.ByteString -> IO ResponseReceived) -> IO ResponseReceived-withLimitedBody req respond action = do-  bodyResult <- readBodyLimited req+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"@@ -284,17 +318,19 @@  -- | Sign a validated 'NarInfo' if a signing key is configured. ----- Logs a warning to stderr if signing fails, then returns the unsigned--- rendering so the upload is not rejected.-signNarInfo :: Maybe SecretKey -> NarInfo -> IO BS.ByteString-signNarInfo Nothing ni = pure (renderNarInfoBytes ni)+-- 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 ("WARNING: signNarInfo: sign failed: " ++ err)-    pure (renderNarInfoBytes ni)+    hPutStrLn stderr ("ERROR: signNarInfo: sign failed: " ++ err)+    pure (Left err)   Right sig ->     let signed = ni {niSigs = niSigs ni ++ [sig]}-     in pure (renderNarInfoBytes signed)+     in pure (Right (renderNarInfoBytes signed))  -- | Render a 'NarInfo' to its UTF-8 encoded wire format. renderNarInfoBytes :: NarInfo -> BS.ByteString@@ -321,12 +357,12 @@ -- | Render the nix-cache-info response body. renderCacheInfo :: FileStore -> BS.ByteString renderCacheInfo store =-  let (storeDir, wantMassQuery, priority) = getCacheInfo store+  let info = getCacheInfo store    in TE.encodeUtf8 $         T.unlines-          [ "StoreDir: " <> storeDir,-            "WantMassQuery: " <> boolText wantMassQuery,-            "Priority: " <> T.pack (show priority)+          [ "StoreDir: " <> ciStoreDir info,+            "WantMassQuery: " <> boolText (ciWantMassQuery info),+            "Priority: " <> T.pack (show (ciPriority info))           ]  -- | Render a Bool as @1@ or @0@.@@ -334,6 +370,91 @@ boolText True = "1" boolText False = "0" +-- | The landing page served at @GET /@.  Static apart from three live+-- values (store-path count, store dir, signing status); styled to match+-- novavero.ai.  No user input is interpolated, so no escaping is needed.+landingHtml :: CacheInfo -> Bool -> Int -> Text+landingHtml info signingEnabled 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(3, 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; overflow-x: auto; 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</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>"+    ]++-- | 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"@@ -351,14 +472,14 @@ textHeaders :: HTTP.ResponseHeaders textHeaders = [(HTTP.hContentType, "text/plain")] --- | Content-Type: application/x-nix-narinfo headers.--- Narinfo files are content-addressed (keyed by store path hash) and--- immutable once written, so they are safe to cache indefinitely at the--- CDN edge.+-- | 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=31536000, immutable")+    (HTTP.hCacheControl, "public, max-age=3600, must-revalidate")   ]  -- | Content-Type: application/octet-stream headers.
nova-cache.cabal view
@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               nova-cache-version:            0.4.0.0+version:            0.4.1.0 synopsis:           Pure-first Nix binary cache protocol library description:   A pure-first library implementing the Nix binary cache protocol —
src/NovaCache/Base32.hs view
@@ -17,6 +17,7 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BSU import Data.Char (ord)+import Data.STRef (newSTRef, readSTRef, writeSTRef) import Data.Text (Text) import qualified Data.Text as T import Data.Vector.Unboxed (Vector)@@ -129,7 +130,7 @@   | T.null txt = Right BS.empty   | otherwise = do       values <- traverse lookupChar (T.unpack txt)-      Right (scatterDecode values inputLen outputLen)+      scatterDecode values inputLen outputLen   where     inputLen = T.length txt     outputLen = (inputLen * bitsPerChar) `div` bitsPerByte@@ -148,30 +149,39 @@ -- -- O(n) in the number of input characters. Each character contributes -- exactly 5 bits, placed at the correct byte and bit offset.-scatterDecode :: [Word8] -> Int -> Int -> ByteString+scatterDecode :: [Word8] -> Int -> Int -> Either String ByteString scatterDecode values inputLen outputLen = runST $ do   arr <- MV.replicate outputLen (0 :: Word8)-  scatterAll arr 0 values-  frozen <- V.unsafeFreeze arr-  pure (BS.pack (V.toList frozen))+  canonical <- newSTRef True+  scatterAll arr canonical 0 values+  ok <- readSTRef canonical+  if ok+    then do+      frozen <- V.unsafeFreeze arr+      pure (Right (BS.pack (V.toList frozen)))+    else pure (Left "non-canonical nix-base32: padding bits must be zero")   where-    scatterAll _ !_ [] = pure ()-    scatterAll arr !n (c5 : rest) = do+    scatterAll _ _ !_ [] = pure ()+    scatterAll arr canonical !n (c5 : rest) = do       let bitsStart = bitsPerChar * (inputLen - 1 - n)-      scatterBits arr c5 bitsStart 0-      scatterAll arr (n + 1) rest+      scatterBits arr canonical c5 bitsStart 0+      scatterAll arr canonical (n + 1) rest -    scatterBits arr c5 bitsStart !bit+    scatterBits arr canonical c5 bitsStart !bit       | bit >= bitsPerChar = pure ()       | otherwise = do           let b = bitsStart + bit               byteIdx = b `shiftR` 3               bitIdx = b .&. byteAlignMask               bitVal = (c5 `shiftR` bit) .&. 1-          when (byteIdx < outputLen) $ do-            old <- MV.unsafeRead arr byteIdx-            MV.unsafeWrite arr byteIdx (old .|. (bitVal `shiftL` bitIdx))-          scatterBits arr c5 bitsStart (bit + 1)+          if byteIdx < outputLen+            then do+              old <- MV.unsafeRead arr byteIdx+              MV.unsafeWrite arr byteIdx (old .|. (bitVal `shiftL` bitIdx))+            -- A set bit landing outside the output is a non-canonical encoding+            -- (Nix requires these padding bits to be zero); reject it.+            else when (bitVal /= 0) (writeSTRef canonical False)+          scatterBits arr canonical c5 bitsStart (bit + 1)  invalidCharMsg :: Char -> String invalidCharMsg c = "invalid nix-base32 character: " ++ [c]
src/NovaCache/Compression.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE ScopedTypeVariables #-}+ -- | xz compression and decompression for NAR files. -- -- Thin wrappers around the @lzma@ package, converting between strict@@ -9,7 +11,7 @@ where  import qualified Codec.Compression.Lzma as Lzma-import Control.Exception (SomeException, evaluate, try)+import Control.Exception (SomeAsyncException, SomeException, evaluate, fromException, throwIO, try) import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as BL @@ -23,6 +25,11 @@ decompressXz :: ByteString -> IO (Either String ByteString) decompressXz bs = do   result <- try (evaluate (BL.toStrict (Lzma.decompress (BL.fromStrict bs))))-  pure $ case result of-    Left err -> Left ("xz decompression failed: " ++ show (err :: SomeException))-    Right decompressed -> Right decompressed+  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)))
src/NovaCache/NAR.hs view
@@ -53,7 +53,9 @@     NarRegular !Bool !ByteString   | -- | Symbolic link: target path.     NarSymlink !Text-  | -- | Directory: sorted list of (name, entry) pairs.+  | -- | Directory: list of (name, entry) pairs.  Names must be unique; the+    -- serializer sorts them and 'deserialise' rejects duplicate or+    -- out-of-order names.     NarDirectory ![(Text, NarEntry)]   deriving (Eq, Show) @@ -166,7 +168,10 @@ deserialise bs = do   (magic, rest) <- readStr bs   expect tokMagic magic-  fst <$> parseNode rest+  (entry, rest2) <- parseNode rest+  if BS.null rest2+    then Right entry+    else Left "trailing bytes after NAR root node"  -- | Parse a single NAR node. parseNode :: NarParser NarEntry@@ -204,10 +209,10 @@           (rp, final) <- readStr afterContents           expect tokRParen rp           pure (NarRegular False contents, final)-      | tok == tokRParen =-          pure (NarRegular False BS.empty, rest)       | otherwise =-          Left ("expected 'executable', 'contents', or ')' in regular, got: " ++ show tok)+          -- 'contents' is mandatory (even an empty file serialises with it), so+          -- a regular node without it is malformed — reject, matching Nix.+          Left ("expected 'executable' or 'contents' in regular, got: " ++ show tok)  -- | Parse a symlink node. parseSymlink :: NarParser NarEntry@@ -222,9 +227,9 @@  -- | Parse a directory node (zero or more child entries). parseDirectory :: NarParser NarEntry-parseDirectory = go []+parseDirectory = go Nothing []   where-    go !acc bs = do+    go !prev !acc bs = do       (tok, afterTok) <- readStr bs       if tok == tokRParen         then pure (NarDirectory (reverse acc), afterTok)@@ -241,7 +246,20 @@           (rp, afterRp) <- readStr afterEntry           expect tokRParen rp           decodedName <- decodeUtf8Safe entryName-          go ((decodedName, entry) : acc) afterRp+          _ <- checkName prev decodedName+          go (Just decodedName) ((decodedName, entry) : acc) afterRp+    -- NAR directory entries must have safe names in strictly increasing+    -- (sorted, unique) order.  Enforcing this rejects malformed or hostile+    -- archives, keeps @serialise . deserialise@ an identity, and forecloses the+    -- 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 =+          Left ("unsafe NAR directory entry name: " ++ T.unpack name)+      | Just p <- prev,+        name <= p =+          Left ("NAR directory entries not strictly increasing: " ++ T.unpack name)+      | otherwise = Right ()  -- --------------------------------------------------------------------------- -- Wire primitives@@ -354,7 +372,12 @@       contents <- BS.readFile path       isExec <- checkExecutable path       pure (NarRegular isExec contents)-    else pure (NarRegular False BS.empty)+    else+      -- Not a symlink, directory, or regular file: a special file (FIFO,+      -- socket, device) or a path that vanished mid-walk.  Fail loudly rather+      -- than fabricating an empty regular (which would silently change the NAR+      -- and its hash) — matching Nix, which aborts on unsupported types.+      fail ("serialiseFromPath: not a regular file (special or vanished): " ++ path)  -- | Check whether a file has the executable permission set. -- Uses 'System.Directory.getPermissions' which is cross-platform:
src/NovaCache/NarInfo.hs view
@@ -14,6 +14,7 @@ import Data.Maybe (fromMaybe, mapMaybe) import Data.Text (Text) import qualified Data.Text as T+import qualified Data.Text.Read as TR  -- --------------------------------------------------------------------------- -- Types@@ -163,10 +164,13 @@   Nothing -> Left ("missing required key: " ++ T.unpack key)   Just val -> Right val --- | Parse an integer value from text.+-- | Parse a non-negative base-10 integer, matching C++ Nix's narinfo parser.+-- Uses 'TR.decimal' (not 'reads', which also accepts hex/octal/leading space)+-- and requires the whole field to be consumed, so a non-canonical value cannot+-- slip through and then be re-signed under the cache's key. parseInteger :: Text -> Text -> Either String Integer-parseInteger key txt = case reads (T.unpack txt) of-  [(n, "")] -> Right n+parseInteger key txt = case TR.decimal txt of+  Right (n, rest) | T.null rest -> Right n   _ -> Left ("invalid integer for " ++ T.unpack key ++ ": " ++ T.unpack txt)  -- | Show a value as 'Text'.
src/NovaCache/Signing.hs view
@@ -158,12 +158,17 @@  -- | Verify a @keyname:base64sig@ signature against a narinfo and public key. ----- Returns 'False' for any malformed input rather than failing.+-- The signature's key name must match this key's name (Nix looks the public key+-- up BY name) before the Ed25519 check runs.  Returns 'False' for any malformed+-- or non-matching input rather than failing. verify :: PublicKey -> NarInfo -> Text -> Bool-verify (PublicKey _ pubBytes) ni sigLine =-  case extractSignaturePayload sigLine of-    Nothing -> False-    Just sigRaw -> verifyRaw pubBytes (TE.encodeUtf8 (fingerprint ni)) sigRaw+verify (PublicKey trustedName pubBytes) ni sigLine =+  case T.breakOn keySeparator sigLine of+    (sigName, sigRest)+      | T.null sigRest || sigName /= trustedName -> False+      | otherwise -> case extractSignaturePayload sigLine of+          Nothing -> False+          Just sigRaw -> verifyRaw pubBytes (TE.encodeUtf8 (fingerprint ni)) sigRaw  -- | Extract the raw signature bytes from a @keyname:base64sig@ line. extractSignaturePayload :: Text -> Maybe ByteString
src/NovaCache/Store.hs view
@@ -14,6 +14,7 @@     readNar,     writeNar,     listNarInfoHashes,+    CacheInfo (..),     getCacheInfo,     sanitizePath,   )@@ -152,9 +153,26 @@ -- Cache metadata -- --------------------------------------------------------------------------- --- | Cache metadata: (storeDir, wantMassQuery, priority).-getCacheInfo :: FileStore -> (Text, Bool, Int)-getCacheInfo fs = (fsStoreDir fs, True, fsPriority fs)+-- | Cache metadata for the @nix-cache-info@ response.+data CacheInfo = CacheInfo+  { ciStoreDir :: !Text,+    ciWantMassQuery :: !Bool,+    ciPriority :: !Int+  }+  deriving (Eq, Show)++-- | This file-backed cache answers mass-query (path-existence) requests.+defaultWantMassQuery :: Bool+defaultWantMassQuery = True++-- | Read the cache's metadata.+getCacheInfo :: FileStore -> CacheInfo+getCacheInfo fs =+  CacheInfo+    { ciStoreDir = fsStoreDir fs,+      ciWantMassQuery = defaultWantMassQuery,+      ciPriority = fsPriority fs+    }  -- --------------------------------------------------------------------------- -- Path sanitization
src/NovaCache/StorePath.hs view
@@ -107,6 +107,8 @@ parseBaseName basename   | T.length basename < minBaseNameLen =       Left ("store path too short: " ++ T.unpack basename)+  -- Safe: minBaseNameLen = storePathHashLen + 1, so the length guard above+  -- guarantees index storePathHashLen is in bounds.   | T.index basename storePathHashLen /= hashNameSeparator =       Left ("expected '-' after hash in store path: " ++ T.unpack basename)   | not (T.all isBase32Char hashPart) =
src/NovaCache/Validate.hs view
@@ -97,21 +97,23 @@ -- the declared 'niNarHash'. validateNarHash :: NarInfo -> ByteString -> Either ValidationError () validateNarHash ni narBytes =-  let actual = formatNixHash (hashBytes narBytes)-      expected = niNarHash ni-   in if expected == actual-        then Right ()-        else Left (NarHashMismatch expected actual)+  -- Compare DECODED hash bytes, not re-formatted strings, so any valid encoding+  -- of the declared NarHash (SRI, hex, base32) validates against the same digest.+  case parseNixHash (niNarHash ni) of+    Left err -> Left (InvalidNarHash (niNarHash ni) err)+    Right declared+      | declared == hashBytes narBytes -> Right ()+      | otherwise -> Left (NarHashMismatch (niNarHash ni) (formatNixHash (hashBytes narBytes)))  -- | Validate that the SHA-256 hash of compressed file bytes matches -- the declared 'niFileHash'. validateFileHash :: NarInfo -> ByteString -> Either ValidationError () validateFileHash ni fileBytes =-  let actual = formatNixHash (hashBytes fileBytes)-      expected = niFileHash ni-   in if expected == actual-        then Right ()-        else Left (FileHashMismatch expected actual)+  case parseNixHash (niFileHash ni) of+    Left err -> Left (InvalidFileHash (niFileHash ni) err)+    Right declared+      | declared == hashBytes fileBytes -> Right ()+      | otherwise -> Left (FileHashMismatch (niFileHash ni) (formatNixHash (hashBytes fileBytes)))  -- --------------------------------------------------------------------------- -- Signature validation
test/Main.hs view
@@ -531,11 +531,11 @@       test "cacheInfo defaults" $ do         tmpDir <- createTestDir         store <- Store.newFileStore tmpDir-        let (storeDir, wantMass, priority) = Store.getCacheInfo store+        let info = Store.getCacheInfo store         removeDirectoryRecursive tmpDir-        ok1 <- assertEqual "storeDir" "/nix/store" storeDir-        ok2 <- assertTrue "wantMassQuery" wantMass-        ok3 <- assertEqual "priority" 50 priority+        ok1 <- assertEqual "storeDir" "/nix/store" (Store.ciStoreDir info)+        ok2 <- assertTrue "wantMassQuery" (Store.ciWantMassQuery info)+        ok3 <- assertEqual "priority" 50 (Store.ciPriority info)         pure (ok1 && ok2 && ok3),       test "sanitizePath rejects traversal" $         assertEqual "dotdot" Nothing (Store.sanitizePath ".."),