Nix Binary Cache Protocol for Haskell
-Pure-first implementation of the complete Nix binary cache protocol — base32, NAR, narinfo, Ed25519 signing, store paths — with an optional WAI server.
-Quick Start · Modules · Server · API Reference
-+
The Nix binary cache protocol, in Haskell.
+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.
[](https://github.com/Novavero-AI/nova-cache/actions/workflows/ci.yml) [](https://hackage.haskell.org/package/nova-cache) - +  -- BSD-3-Clause · Novavero AI -
+BSD-3-Clause · Novavero AI
diff --git a/exe/Main.hs b/exe/Main.hs --- a/exe/Main.hs +++ b/exe/Main.hs @@ -1,5 +1,6 @@ module Main (main) where +import Control.Exception (SomeException) import Data.Bifunctor (first) import Data.ByteArray (constEq) import qualified Data.ByteString as BS @@ -16,12 +17,12 @@ RequestBodyLength (..), Response, ResponseReceived, + getRequestBodyChunk, pathInfo, requestBodyLength, requestHeaders, requestMethod, responseLBS, - strictRequestBody, ) import qualified Network.Wai.Handler.Warp as Warp import Network.Wai.Middleware.RequestLogger (logStdout) @@ -30,6 +31,7 @@ import NovaCache.Store (FileStore, getCacheInfo, listNarInfoHashes, newFileStore, readNar, readNarInfo, writeNar, writeNarInfo) import NovaCache.Validate (validateNarInfo) import System.Environment (getArgs, lookupEnv) +import System.Exit (exitFailure) import System.IO (hPutStrLn, stderr) import Text.Read (readMaybe) @@ -91,6 +93,7 @@ storeRoot = case args of ("--store" : s : _) -> s _ -> fromMaybe defaultStoreRoot storeEnv + allowOpenWrites = "--allow-open-writes" `elem` args store <- newFileStore storeRoot sigKey <- loadSigningKey sigKeyPath @@ -110,8 +113,25 @@ putStrLn ("signing: " ++ maybe "disabled" (const "enabled") sigKey) putStrLn ("write auth: " ++ maybe "disabled (open writes!)" (const "enabled") (cfgApiKey cfg)) putStrLn ("request logging: " ++ if logRequests then "enabled" else "disabled (LOG_REQUESTS=0)") - Warp.run port (requestLogger (app cfg)) + case cfgApiKey cfg of + Nothing + | not allowOpenWrites -> do + hPutStrLn stderr $ + "FATAL: " + ++ apiKeyEnvVar + ++ " is not set — refusing to start with unauthenticated writes. " + ++ "Set " + ++ apiKeyEnvVar + ++ ", or pass --allow-open-writes to override (not recommended on a public host)." + exitFailure + _ -> pure () + + let settings = + Warp.setPort port $ + Warp.setOnExceptionResponse onExceptionResponse Warp.defaultSettings + Warp.runSettings settings (requestLogger (app cfg)) + -- | Load a signing key from a file, if configured. loadSigningKey :: Maybe FilePath -> IO (Maybe SecretKey) loadSigningKey Nothing = pure Nothing @@ -212,11 +232,20 @@ readBodyLimited req = case requestBodyLength req of KnownLength len | len > fromIntegral maxBodySize -> pure Nothing - _ -> do - body <- BL.toStrict <$> strictRequestBody req - if BS.length body > maxBodySize - then pure Nothing - else pure (Just body) + _ -> 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 + 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 @@ -312,6 +341,11 @@ -- | 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 diff --git a/nova-cache.cabal b/nova-cache.cabal --- a/nova-cache.cabal +++ b/nova-cache.cabal @@ -1,12 +1,11 @@ cabal-version: 3.0 name: nova-cache -version: 0.3.2.1 -synopsis: Pure Nix binary cache protocol library +version: 0.4.0.0 +synopsis: Pure-first Nix binary cache protocol library description: - A focused, minimal, pure-first library implementing the full Nix binary - cache protocol — nix-base32, NAR serialization, narinfo parsing, Ed25519 - signing, store path handling, content validation — with an optional WAI - server. + A pure-first library implementing the Nix binary cache protocol — + nix-base32, NAR serialization, narinfo parsing, Ed25519 signing, store + path handling, and content validation — with an optional WAI server. license: BSD-3-Clause license-file: LICENSE diff --git a/src/NovaCache/Base32.hs b/src/NovaCache/Base32.hs --- a/src/NovaCache/Base32.hs +++ b/src/NovaCache/Base32.hs @@ -6,6 +6,7 @@ module NovaCache.Base32 ( encode, decode, + isBase32Char, ) where @@ -48,6 +49,13 @@ -- | Sentinel value for characters outside the alphabet. invalidMarker :: Word8 invalidMarker = 0xFF + +-- | Is a character part of the Nix base32 alphabet +-- (@0123456789abcdfghijklmnpqrsvwxyz@)? Used to validate store-path hashes. +isBase32Char :: Char -> Bool +isBase32Char c = case nixDecodeLut V.!? ord c of + Just v -> v /= invalidMarker + Nothing -> False -- | Bits per base32 character. bitsPerChar :: Int diff --git a/src/NovaCache/NAR.hs b/src/NovaCache/NAR.hs --- a/src/NovaCache/NAR.hs +++ b/src/NovaCache/NAR.hs @@ -252,10 +252,20 @@ readStr bs | BS.length bs < wordSize = Left "unexpected end of NAR: need 8 bytes for string length" - | totalLen > BS.length payload = + -- Compare the Word64 length to the remaining bytes BEFORE narrowing it to + -- Int: a hostile length above maxBound::Int would otherwise wrap negative + -- and slip past the totalLen check below. + | len > fromIntegral (BS.length payload) = Left ( "unexpected end of NAR: string length " ++ show len + ++ " exceeds remaining " + ++ show (BS.length payload) + ) + | totalLen > BS.length payload = + Left + ( "unexpected end of NAR: padded string length " + ++ show totalLen ++ " exceeds remaining " ++ show (BS.length payload) ) diff --git a/src/NovaCache/NarInfo.hs b/src/NovaCache/NarInfo.hs --- a/src/NovaCache/NarInfo.hs +++ b/src/NovaCache/NarInfo.hs @@ -2,7 +2,7 @@ -- -- A @.narinfo@ file is a simple @Key: Value@ text format describing a -- store path in a binary cache. The format supports multiple @Sig@ lines --- and optional fields for @Deriver@, @System@, and @CA@. +-- and optional fields for @Deriver@ and @CA@. module NovaCache.NarInfo ( NarInfo (..), parseNarInfo, @@ -11,7 +11,7 @@ where import Data.List (find) -import Data.Maybe (mapMaybe) +import Data.Maybe (fromMaybe, mapMaybe) import Data.Text (Text) import qualified Data.Text as T @@ -30,7 +30,6 @@ niNarSize :: !Integer, niReferences :: ![Text], niDeriver :: !(Maybe Text), - niSystem :: !(Maybe Text), niSigs :: ![Text], niCA :: !(Maybe Text) } @@ -52,19 +51,18 @@ keyNarSize = "NarSize" keyReferences = "References" -keyDeriver, keySystem, keySig, keyCA :: Text +keyDeriver, keySig, keyCA :: Text keyDeriver = "Deriver" -keySystem = "System" keySig = "Sig" keyCA = "CA" --- | Key-value separator in narinfo format. +-- | Key-value separator used when rendering narinfo lines. kvSeparator :: Text kvSeparator = ": " --- | Length of the key-value separator. -kvSeparatorLen :: Int -kvSeparatorLen = 2 +-- | Field delimiter used when parsing (Nix splits on the first colon). +fieldColon :: Text +fieldColon = ":" -- --------------------------------------------------------------------------- -- Parsing @@ -92,7 +90,6 @@ niNarSize = narSize, niReferences = parseRefs (lookupFirst keyReferences kvs), niDeriver = lookupFirst keyDeriver kvs, - niSystem = lookupFirst keySystem kvs, niSigs = lookupAll keySig kvs, niCA = lookupFirst keyCA kvs } @@ -122,7 +119,6 @@ kv keyReferences (T.unwords (niReferences ni)) ] ++ optionalKV keyDeriver (niDeriver ni) - ++ optionalKV keySystem (niSystem ni) ++ map (kv keySig) (niSigs ni) ++ optionalKV keyCA (niCA ni) @@ -131,11 +127,18 @@ -- --------------------------------------------------------------------------- -- | Parse a single @Key: Value@ line. +-- +-- Splits on the first colon (matching Nix), strips a single leading space +-- from the value, and tolerates a trailing carriage return so CRLF-terminated +-- narinfo from other tools parses correctly. parseLine :: Text -> Maybe (Text, Text) -parseLine line = case T.breakOn kvSeparator line of +parseLine rawLine = case T.breakOn fieldColon line of (_, rest) | T.null rest -> Nothing - (key, rest) -> Just (key, T.drop kvSeparatorLen rest) + (key, rest) -> Just (key, dropLeadingSpace (T.drop 1 rest)) + where + line = T.dropWhileEnd (== '\r') rawLine + dropLeadingSpace value = fromMaybe value (T.stripPrefix " " value) -- | Render a key-value pair. kv :: Text -> Text -> Text diff --git a/src/NovaCache/Signing.hs b/src/NovaCache/Signing.hs --- a/src/NovaCache/Signing.hs +++ b/src/NovaCache/Signing.hs @@ -134,8 +134,13 @@ niStorePath ni, niNarHash ni, T.pack (show (niNarSize ni)), - T.intercalate referenceSep (niReferences ni) + T.intercalate referenceSep (map (storeDir <>) (niReferences ni)) ] + where + -- References in a narinfo are basenames, but the fingerprint signs them as + -- full store paths (/nix/store/