diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,14 @@ +# Changelog + +## 0.1.0.0 — 2026-02-21 + +- Initial release (renamed from gb-nix-cache) +- Nix-base32 encoding/decoding +- SHA-256 hashing with Nix hash formatting +- Store path parsing and rendering +- NAR binary format serialization/deserialization +- NarInfo text format parsing/rendering +- Ed25519 signing and verification +- xz compression/decompression +- Filesystem storage backend +- Optional WAI cache server (behind `server` flag) diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2026 Novavero AI + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,321 @@ +
+

nova-cache

+

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

+

+ +[![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) +![Haskell](https://img.shields.io/badge/haskell-GHC%209.6-purple) +![License](https://img.shields.io/badge/license-MIT-blue) + +

+
+ +--- + +## What is nova-cache? + +A focused, minimal library implementing the full Nix binary cache protocol: + +- **Base32** — Nix-specific encoding with the custom `0123456789abcdfghijklmnpqrsvwxyz` alphabet, O(n) ST-based decode +- **Hash** — SHA-256 hashing with `sha256:` formatting, composition pipeline over crypton +- **StorePath** — Store path parsing, validation, and hash extraction with enforced invariants via newtypes +- **NAR** — Binary serialization and deserialization of the Nix ARchive format using `Builder` monoid composition +- **NarInfo** — Parse and render the key-value narinfo text format +- **Signing** — Ed25519 fingerprint signing and verification for binary cache trust +- **Compression** — xz compress/decompress for NAR transport +- **Store** — Filesystem storage backend for narinfo and NAR files +- **Server** — Optional WAI/Warp HTTP server implementing the cache protocol (behind `server` cabal flag) + +Every module is pure by default. IO lives at the boundaries only. + +--- + +## Quick Start + +Add to your `.cabal` file: + +```cabal +build-depends: nova-cache +``` + +### Hash a Store Path + +```haskell +import NovaCache.Hash (hashBytes, formatNixHash) +import qualified Data.ByteString as BS + +main :: IO () +main = do + contents <- BS.readFile "/nix/store/abc123-hello/bin/hello" + let nixHash = hashBytes contents + putStrLn (show (formatNixHash nixHash)) + -- "sha256:0m6g5r7c..." +``` + +### Parse a NarInfo + +```haskell +import NovaCache.NarInfo (parseNarInfo, niStorePath, niNarHash) + +main :: IO () +main = do + let raw = "StorePath: /nix/store/abc...-hello\n\ + \URL: nar/abc....nar.xz\n\ + \Compression: xz\n\ + \FileHash: sha256:...\n\ + \FileSize: 1234\n\ + \NarHash: sha256:...\n\ + \NarSize: 5678\n\ + \References: \n" + case parseNarInfo raw of + Left err -> putStrLn ("Parse error: " ++ err) + Right ni -> do + putStrLn ("Store path: " <> show (niStorePath ni)) + putStrLn ("NAR hash: " <> show (niNarHash ni)) +``` + +### Sign and Verify + +```haskell +import NovaCache.Signing (parseSecretKey, parsePublicKey, sign, verify) + +main :: IO () +main = do + let Right sk = parseSecretKey "mykey:base64secretkey..." + Right pk = parsePublicKey "mykey:base64pubkey..." + case sign sk narinfo of + Left err -> putStrLn ("Sign error: " ++ err) + Right sig -> putStrLn ("Verified: " <> show (verify pk narinfo sig)) +``` + +--- + +## Modules + +### NovaCache.Base32 + +Nix uses a non-standard base32 alphabet that omits `e`, `o`, `u`, `t` and encodes in reverse byte order. The encoder extracts 5-bit groups from descending positions; the decoder uses an O(n) ST-based bit scatter with mutable vectors. + +```haskell +import NovaCache.Base32 (encode, decode) + +encode "\xff" -- "8z" +decode "0z" -- Right "\x1e" +decode (encode bs) -- Right bs (roundtrip) +``` + +### NovaCache.Hash + +SHA-256 via crypton, formatted as `sha256:`: + +```haskell +import NovaCache.Hash (hashBytes, hashFile, formatNixHash, parseNixHash) + +formatNixHash (hashBytes "hello") +-- "sha256:0m6g5r7c..." + +nixHash <- hashFile "/nix/store/abc123-hello" +``` + +### NovaCache.StorePath + +Newtypes enforce invariants — store path hashes are always 32 characters, names are validated against the Nix character set: + +```haskell +import NovaCache.StorePath + +let Right sp = parseStorePath defaultStoreDir "/nix/store/abc123...-hello-1.0" +storePathHashString sp -- "abc123..." +storePathBaseName sp -- "abc123...-hello-1.0" +renderStorePath defaultStoreDir sp -- "/nix/store/abc123...-hello-1.0" +``` + +### NovaCache.NAR + +The NAR tree ADT with `Builder`-based serialization: + +```haskell +import NovaCache.NAR + +let entry = NarRegular False "file contents" +let bytes = serialise entry +deserialise bytes -- Right entry (roundtrip) + +-- Hash a NAR directly (serialise + SHA-256) +narHash entry -- NixHash + +-- Build from filesystem +tree <- serialiseFromPath "/nix/store/abc123-hello" +``` + +### NovaCache.Signing + +Ed25519 signing and verification of narinfo fingerprints. Keys are `name:base64` pairs: + +```haskell +import NovaCache.Signing + +-- Fingerprint format: 1;;;; +fingerprint narinfo +-- "1;/nix/store/abc...;sha256:...;5678;" +``` + +--- + +## Server + +Enable the WAI server with the `server` cabal flag: + +```bash +cabal build --flag server +cabal run nova-cache-server -- --port 5000 --store ./nix-cache +``` + +Or via environment variables: + +```bash +PORT=5000 NIX_CACHE_DIR=./nix-cache nova-cache-server +``` + +### Endpoints + +| Method | Path | Description | +|--------|------|-------------| +| `GET` | `/nix-cache-info` | Cache metadata (StoreDir, WantMassQuery, Priority) | +| `GET` | `/.narinfo` | Fetch narinfo by store path hash | +| `GET` | `/nar/` | Fetch compressed NAR file | +| `PUT` | `/.narinfo` | Upload narinfo | +| `PUT` | `/nar/` | Upload NAR file | + +### Use as a Nix Substituter + +```bash +# Push to your cache +nix copy --to http://cache.example.com /nix/store/abc123-hello + +# Pull from your cache +nix build --substituters http://cache.example.com --trusted-public-keys "mykey:base64..." +``` + +--- + +## Architecture + +``` + Pure Core (no IO) + ┌──────────────────────────────────────────┐ + │ │ + │ Base32 ──→ Hash ──→ StorePath │ + │ │ │ + │ NarInfo ──→ Signing │ + │ │ │ + │ NAR │ + │ │ + └──────────────────────────────────────────┘ + │ + IO Boundary (thin) + ┌──────────────────────────────────────────┐ + │ Compression Store Server (flag) │ + └──────────────────────────────────────────┘ +``` + +- **8 modules**, 6 pure + 2 at the IO boundary +- **48 tests**, hand-rolled harness, no framework dependencies +- **Zero partial functions** — total by construction +- **Strict by default** — bang patterns on all data fields + +--- + +## API Reference + +### Base32 + +```haskell +encode :: ByteString -> Text +decode :: Text -> Either String ByteString +``` + +### Hash + +```haskell +hashBytes :: ByteString -> NixHash +hashFile :: FilePath -> IO NixHash +formatNixHash :: NixHash -> Text +parseNixHash :: Text -> Either String NixHash +``` + +### StorePath + +```haskell +parseStorePath :: StoreDir -> Text -> Either String StorePath +renderStorePath :: StoreDir -> StorePath -> Text +storePathHashString :: StorePath -> Text +storePathBaseName :: StorePath -> Text +``` + +### NAR + +```haskell +serialise :: NarEntry -> ByteString +deserialise :: ByteString -> Either String NarEntry +narHash :: NarEntry -> NixHash +serialiseFromPath :: FilePath -> IO NarEntry +``` + +### NarInfo + +```haskell +parseNarInfo :: Text -> Either String NarInfo +renderNarInfo :: NarInfo -> Text +``` + +### Signing + +```haskell +parseSecretKey :: Text -> Either String SecretKey +parsePublicKey :: Text -> Either String PublicKey +fingerprint :: NarInfo -> Text +sign :: SecretKey -> NarInfo -> Either String Text +verify :: PublicKey -> NarInfo -> Text -> Bool +``` + +### Compression + +```haskell +compressXz :: ByteString -> ByteString +decompressXz :: ByteString -> ByteString +``` + +### Store + +```haskell +newFileStore :: FilePath -> IO FileStore +readNarInfo :: FileStore -> Text -> IO (Maybe ByteString) +writeNarInfo :: FileStore -> Text -> ByteString -> IO () +readNar :: FileStore -> Text -> IO (Maybe ByteString) +writeNar :: FileStore -> Text -> ByteString -> IO () +getCacheInfo :: FileStore -> (Text, Bool, Int) +``` + +Full Haddock documentation is available on [Hackage](https://hackage.haskell.org/package/nova-cache). + +--- + +## Build & Test + +```bash +cabal build # Build library +cabal test # Run all tests (48 tests, 8 groups) +cabal build --ghc-options="-Werror" # Warnings as errors +cabal build --flag server # Build with WAI server +cabal haddock # Generate docs +``` + +--- + +

+ MIT License · Novavero AI +

diff --git a/exe/Main.hs b/exe/Main.hs new file mode 100644 --- /dev/null +++ b/exe/Main.hs @@ -0,0 +1,202 @@ +module Main (main) where + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import Data.Maybe (fromMaybe) +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, Response, ResponseReceived, pathInfo, requestHeaders, requestMethod, responseLBS, strictRequestBody) +import qualified Network.Wai.Handler.Warp as Warp +import NovaCache.NarInfo (NarInfo (..), parseNarInfo, renderNarInfo) +import NovaCache.Signing (SecretKey, parseSecretKey, sign) +import NovaCache.Store (FileStore, getCacheInfo, newFileStore, readNar, readNarInfo, writeNar, writeNarInfo) +import System.Environment (getArgs, lookupEnv) +import Text.Read (readMaybe) + +-- --------------------------------------------------------------------------- +-- Constants +-- --------------------------------------------------------------------------- + +-- | Default server port. +defaultPort :: Int +defaultPort = 5000 + +-- | Default store directory. +defaultStoreRoot :: FilePath +defaultStoreRoot = "./nix-cache" + +-- | Environment variable for the write API key. +apiKeyEnvVar :: String +apiKeyEnvVar = "CACHE_API_KEY" + +-- | Environment variable for the signing key file path. +signingKeyEnvVar :: String +signingKeyEnvVar = "SIGNING_KEY_FILE" + +-- --------------------------------------------------------------------------- +-- Server configuration +-- --------------------------------------------------------------------------- + +-- | Runtime server configuration. +data Config = Config + { cfgStore :: !FileStore, + cfgApiKey :: !(Maybe BS.ByteString), + cfgSigningKey :: !(Maybe SecretKey) + } + +-- --------------------------------------------------------------------------- +-- Main +-- --------------------------------------------------------------------------- + +main :: IO () +main = do + args <- getArgs + portEnv <- lookupEnv "PORT" + storeEnv <- lookupEnv "NIX_CACHE_DIR" + apiKeyEnv <- lookupEnv apiKeyEnvVar + sigKeyPath <- lookupEnv signingKeyEnvVar + + 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 + + store <- newFileStore storeRoot + sigKey <- loadSigningKey sigKeyPath + + let cfg = + Config + { cfgStore = store, + cfgApiKey = TE.encodeUtf8 . T.pack <$> apiKeyEnv, + cfgSigningKey = sigKey + } + + putStrLn ("nova-cache-server listening on port " ++ show port) + putStrLn ("store root: " ++ storeRoot) + putStrLn ("signing: " ++ maybe "disabled" (const "enabled") sigKey) + putStrLn ("write auth: " ++ maybe "disabled (open writes!)" (const "enabled") (cfgApiKey cfg)) + Warp.run port (app cfg) + +-- | Load a signing key from a file, if configured. +loadSigningKey :: Maybe FilePath -> IO (Maybe SecretKey) +loadSigningKey Nothing = pure Nothing +loadSigningKey (Just path) = do + contents <- T.strip . TE.decodeUtf8 <$> BS.readFile path + case parseSecretKey contents of + Left err -> do + putStrLn ("WARNING: failed to load signing key: " ++ err) + pure Nothing + Right sk -> pure (Just sk) + +-- --------------------------------------------------------------------------- +-- 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 /nix-cache-info + ("GET", ["nix-cache-info"]) -> + respond (responseLBS HTTP.status200 textHeaders (BL.fromStrict (renderCacheInfo (cfgStore cfg)))) + -- GET /.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 (responseLBS HTTP.status404 textHeaders "not found") + -- GET /nar/ + ("GET", ["nar", fileName]) -> do + result <- readNar (cfgStore cfg) fileName + case result of + Just content -> + respond (responseLBS HTTP.status200 octetHeaders (BL.fromStrict content)) + Nothing -> + respond (responseLBS HTTP.status404 textHeaders "not found") + -- PUT /.narinfo (auth required) + ("PUT", [hashNarinfo]) + | Just hashKey <- T.stripSuffix ".narinfo" hashNarinfo -> + requireAuth cfg req respond $ do + body <- BL.toStrict <$> strictRequestBody req + let signed = signNarInfo (cfgSigningKey cfg) body + writeNarInfo (cfgStore cfg) hashKey signed + respond (responseLBS HTTP.status200 textHeaders "ok") + -- PUT /nar/ (auth required) + ("PUT", ["nar", fileName]) -> + requireAuth cfg req respond $ do + body <- BL.toStrict <$> strictRequestBody req + writeNar (cfgStore cfg) fileName body + respond (responseLBS HTTP.status200 textHeaders "ok") + -- Fallback + _ -> + respond (responseLBS HTTP.status404 textHeaders "not found") + +-- --------------------------------------------------------------------------- +-- 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 \@. +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) + in if provided == Just ("Bearer " <> expected) + then action + else respond (responseLBS HTTP.status401 textHeaders "unauthorized") + +-- --------------------------------------------------------------------------- +-- Signing +-- --------------------------------------------------------------------------- + +-- | Sign a narinfo body if a signing key is configured. +signNarInfo :: Maybe SecretKey -> BS.ByteString -> BS.ByteString +signNarInfo Nothing body = body +signNarInfo (Just sk) body = case parseNarInfo (TE.decodeUtf8 body) of + Left _ -> body + Right ni -> case sign sk ni of + Left _ -> body + Right sig -> + let signed = ni {niSigs = niSigs ni ++ [sig]} + in TE.encodeUtf8 (renderNarInfo signed) + +-- --------------------------------------------------------------------------- +-- Response helpers +-- --------------------------------------------------------------------------- + +-- | Render the nix-cache-info response body. +renderCacheInfo :: FileStore -> BS.ByteString +renderCacheInfo store = + let (storeDir, wantMassQuery, priority) = getCacheInfo store + in TE.encodeUtf8 $ + T.unlines + [ "StoreDir: " <> storeDir, + "WantMassQuery: " <> boolText wantMassQuery, + "Priority: " <> T.pack (show priority) + ] + +-- | Render a Bool as @1@ or @0@. +boolText :: Bool -> Text +boolText True = "1" +boolText False = "0" + +-- | Content-Type: text/plain headers. +textHeaders :: HTTP.ResponseHeaders +textHeaders = [(HTTP.hContentType, "text/plain")] + +-- | Content-Type: application/x-nix-narinfo headers. +narInfoHeaders :: HTTP.ResponseHeaders +narInfoHeaders = [(HTTP.hContentType, "text/x-nix-narinfo")] + +-- | Content-Type: application/octet-stream headers. +octetHeaders :: HTTP.ResponseHeaders +octetHeaders = [(HTTP.hContentType, "application/octet-stream")] diff --git a/nova-cache.cabal b/nova-cache.cabal new file mode 100644 --- /dev/null +++ b/nova-cache.cabal @@ -0,0 +1,107 @@ +cabal-version: 3.0 +name: nova-cache +version: 0.1.0.0 +synopsis: Pure 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 — with an optional WAI server. + +license: MIT +license-file: LICENSE +author: Devon Tomlin +maintainer: devon.tomlin@novavero.ai +homepage: https://github.com/Novavero-AI/nova-cache +bug-reports: https://github.com/Novavero-AI/nova-cache/issues +category: Nix, Distribution +stability: experimental +build-type: Simple +tested-with: GHC == 9.6.7 +extra-doc-files: + CHANGELOG.md + README.md + +flag server + description: Build the cache server executable (pulls in warp/wai) + default: False + manual: True + +library + exposed-modules: + NovaCache.Base32 + NovaCache.Compression + NovaCache.Hash + NovaCache.NAR + NovaCache.NarInfo + NovaCache.Signing + NovaCache.Store + NovaCache.StorePath + + build-depends: + base >= 4.16 && < 5 + , base64-bytestring >= 1.2 && < 1.3 + , bytestring >= 0.11 && < 0.13 + , containers >= 0.6 && < 0.8 + , crypton >= 1.0 && < 2 + , directory >= 1.3 && < 1.4 + , filepath >= 1.4 && < 1.6 + , lzma >= 0.0.1 && < 0.1 + , memory >= 0.18 && < 1 + , text >= 2.0 && < 2.2 + , unix >= 2.7 && < 2.9 + , vector >= 0.12 && < 0.14 + + hs-source-dirs: src + default-language: Haskell2010 + default-extensions: + BangPatterns + OverloadedStrings + ghc-options: + -Wall + -Wcompat + -Wincomplete-record-updates + -Wincomplete-uni-patterns + +executable nova-cache-server + if !flag(server) + buildable: False + + main-is: Main.hs + hs-source-dirs: exe + default-language: Haskell2010 + default-extensions: + OverloadedStrings + ghc-options: -Wall -Wcompat -threaded -rtsopts + + build-depends: + base >= 4.16 && < 5 + , bytestring >= 0.11 && < 0.13 + , nova-cache + , http-types >= 0.12 && < 0.13 + , text >= 2.0 && < 2.2 + , wai >= 3.2 && < 3.3 + , warp >= 3.3 && < 3.5 + +test-suite nova-cache-test + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: test + default-language: Haskell2010 + default-extensions: + OverloadedStrings + ghc-options: -Wall -Wcompat + + build-depends: + base >= 4.16 && < 5 + , base64-bytestring >= 1.2 && < 1.3 + , bytestring >= 0.11 && < 0.13 + , crypton >= 1.0 && < 2 + , directory >= 1.3 && < 1.4 + , nova-cache + , memory >= 0.18 && < 1 + , text >= 2.0 && < 2.2 + +source-repository head + type: git + location: https://github.com/Novavero-AI/nova-cache + branch: main diff --git a/src/NovaCache/Base32.hs b/src/NovaCache/Base32.hs new file mode 100644 --- /dev/null +++ b/src/NovaCache/Base32.hs @@ -0,0 +1,169 @@ +-- | Nix-specific base32 encoding and decoding. +-- +-- Nix uses a non-standard base32 alphabet that omits @e@, @o@, @u@, @t@, +-- and encodes bytes in reverse order compared to RFC 4648. The encoding +-- extracts 5-bit groups from the raw bytes in descending position order. +module NovaCache.Base32 + ( encode, + decode, + ) +where + +import Control.Monad (when) +import Control.Monad.ST (runST) +import Data.Bits (shiftL, shiftR, (.&.), (.|.)) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Unsafe as BSU +import Data.Char (ord) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Vector.Unboxed (Vector) +import qualified Data.Vector.Unboxed as V +import qualified Data.Vector.Unboxed.Mutable as MV +import Data.Word (Word8) + +-- --------------------------------------------------------------------------- +-- Alphabet +-- --------------------------------------------------------------------------- + +-- | Nix base32 alphabet: @0123456789abcdfghijklmnpqrsvwxyz@ +-- +-- 32 characters, deliberately omitting @e@, @o@, @u@, @t@ to avoid +-- visually ambiguous characters and accidental English words. +nixAlphabet :: Vector Char +nixAlphabet = V.fromList "0123456789abcdfghijklmnpqrsvwxyz" + +-- | Reverse lookup table: ASCII ordinal to 5-bit value. +-- Invalid characters map to 'invalidMarker'. +nixDecodeLut :: Vector Word8 +nixDecodeLut = + V.generate asciiTableSize $ \c -> + maybe invalidMarker fromIntegral (V.findIndex (== toEnum c) nixAlphabet) + +-- | Size of the ASCII lookup table. +asciiTableSize :: Int +asciiTableSize = 256 + +-- | Sentinel value for characters outside the alphabet. +invalidMarker :: Word8 +invalidMarker = 0xFF + +-- | Bits per base32 character. +bitsPerChar :: Int +bitsPerChar = 5 + +-- | Bits per byte. +bitsPerByte :: Int +bitsPerByte = 8 + +-- | Bit mask for extracting 5 bits. +fiveBitMask :: Int +fiveBitMask = 0x1F + +-- | Bit mask for byte-within-8 alignment. +byteAlignMask :: Int +byteAlignMask = 7 + +-- --------------------------------------------------------------------------- +-- Encode +-- --------------------------------------------------------------------------- + +-- | Number of base32 characters for a given input byte length. +-- +-- @\lceil len \times 8 / 5 \rceil@ +encodedLength :: Int -> Int +encodedLength n = + let totalBits = n * bitsPerByte + in totalBits `div` bitsPerChar + + (if totalBits `mod` bitsPerChar > 0 then 1 else 0) + +-- | Encode a 'ByteString' to Nix-base32 'Text'. +-- +-- Each output character position @n@ maps to a 5-bit group extracted from +-- the input at bit offset @n * 5@. Characters are emitted from the highest +-- position down, matching the Nix reference implementation. +encode :: ByteString -> Text +encode bs = T.pack [charAtPosition n | n <- [encLen - 1, encLen - 2 .. 0]] + where + len = BS.length bs + encLen = encodedLength len + + charAtPosition :: Int -> Char + charAtPosition n = V.unsafeIndex nixAlphabet (extract5Bits n) + + extract5Bits :: Int -> Int + extract5Bits n = + let bitOff = n * bitsPerChar + byteIdx = bitOff `shiftR` 3 + bitIdx = bitOff .&. byteAlignMask + lo = safeByte byteIdx + hi = safeByte (byteIdx + 1) + combined = fromIntegral lo .|. (fromIntegral hi `shiftL` bitsPerByte :: Int) + in (combined `shiftR` bitIdx) .&. fiveBitMask + + safeByte :: Int -> Word8 + safeByte i + | i < len = BSU.unsafeIndex bs i + | otherwise = 0 + +-- --------------------------------------------------------------------------- +-- Decode +-- --------------------------------------------------------------------------- + +-- | Decode Nix-base32 'Text' to a 'ByteString'. +-- +-- For each character at string position @n@, the corresponding bit offset +-- in the output is @5 * (inputLen - 1 - n)@. Each 5-bit value's bits are +-- scattered into the output byte array via an O(n) mutable vector pass. +decode :: Text -> Either String ByteString +decode txt + | T.null txt = Right BS.empty + | otherwise = do + values <- traverse lookupChar (T.unpack txt) + Right (scatterDecode values inputLen outputLen) + where + inputLen = T.length txt + outputLen = (inputLen * bitsPerChar) `div` bitsPerByte + +-- | Resolve a character to its 5-bit value, failing on invalid input. +lookupChar :: Char -> Either String Word8 +lookupChar c + | ci >= asciiTableSize = Left (invalidCharMsg c) + | val == invalidMarker = Left (invalidCharMsg c) + | otherwise = Right val + where + ci = ord c + val = V.unsafeIndex nixDecodeLut ci + +-- | Scatter 5-bit values into an output byte array using a mutable vector. +-- +-- 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 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)) + where + scatterAll _ !_ [] = pure () + scatterAll arr !n (c5 : rest) = do + let bitsStart = bitsPerChar * (inputLen - 1 - n) + scatterBits arr c5 bitsStart 0 + scatterAll arr (n + 1) rest + + scatterBits arr 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) + +invalidCharMsg :: Char -> String +invalidCharMsg c = "invalid nix-base32 character: " ++ [c] diff --git a/src/NovaCache/Compression.hs b/src/NovaCache/Compression.hs new file mode 100644 --- /dev/null +++ b/src/NovaCache/Compression.hs @@ -0,0 +1,21 @@ +-- | 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 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'. +decompressXz :: ByteString -> ByteString +decompressXz = BL.toStrict . Lzma.decompress . BL.fromStrict diff --git a/src/NovaCache/Hash.hs b/src/NovaCache/Hash.hs new file mode 100644 --- /dev/null +++ b/src/NovaCache/Hash.hs @@ -0,0 +1,66 @@ +-- | SHA-256 hashing with Nix-specific formatting. +-- +-- Nix represents content hashes as @sha256:\@. This module +-- provides the bridge between raw cryptographic hashing and the Nix +-- string representation, composing 'Crypto.Hash' with 'NovaCache.Base32'. +module NovaCache.Hash + ( NixHash (..), + hashBytes, + hashFile, + formatNixHash, + parseNixHash, + ) +where + +import Crypto.Hash (Digest, SHA256, hash) +import Data.ByteArray (convert) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.Text (Text) +import qualified Data.Text as T +import qualified NovaCache.Base32 as Base32 + +-- | A SHA-256 hash as raw bytes (always exactly 32 bytes). +newtype NixHash = NixHash ByteString + deriving (Eq, Ord, Show) + +-- | Size of a SHA-256 digest in bytes. +sha256DigestSize :: Int +sha256DigestSize = 32 + +-- | Hash algorithm prefix used in Nix hash strings. +sha256Prefix :: Text +sha256Prefix = "sha256:" + +-- | Compute the SHA-256 hash of a strict 'ByteString'. +hashBytes :: ByteString -> NixHash +hashBytes = NixHash . convert . sha256 + +-- | Compute the SHA-256 hash of a file's contents. +hashFile :: FilePath -> IO NixHash +hashFile path = hashBytes <$> BS.readFile path + +-- | Format a 'NixHash' as @sha256:\@. +formatNixHash :: NixHash -> Text +formatNixHash (NixHash raw) = sha256Prefix <> Base32.encode raw + +-- | Parse a @sha256:\@ string back to a 'NixHash'. +-- +-- Validates both the prefix and the decoded length. +parseNixHash :: Text -> Either String NixHash +parseNixHash txt = case T.stripPrefix sha256Prefix txt of + Nothing -> Left ("expected " ++ T.unpack sha256Prefix ++ " prefix, got: " ++ T.unpack txt) + Just encoded -> do + decoded <- Base32.decode encoded + if BS.length decoded == sha256DigestSize + then Right (NixHash decoded) + else Left (digestSizeError (BS.length decoded)) + +-- | Internal: compute SHA-256 digest. +sha256 :: ByteString -> Digest SHA256 +sha256 = hash + +-- | Error message for wrong digest size. +digestSizeError :: Int -> String +digestSizeError actual = + "expected " ++ show sha256DigestSize ++ "-byte SHA-256 digest, got " ++ show actual ++ " bytes" diff --git a/src/NovaCache/NAR.hs b/src/NovaCache/NAR.hs new file mode 100644 --- /dev/null +++ b/src/NovaCache/NAR.hs @@ -0,0 +1,344 @@ +-- | NAR (Nix ARchive) binary format serialization and deserialization. +-- +-- NAR is a deterministic archive format used by Nix. All strings are +-- length-prefixed and padded to 8-byte alignment. The grammar is: +-- +-- @ +-- archive ::= "nix-archive-1" node +-- node ::= "(" "type" ("regular" regular | "symlink" symlink | "directory" directory) ")" +-- regular ::= ["executable" ""] "contents" STRING +-- symlink ::= "target" STRING +-- directory ::= (entry)* +-- entry ::= "entry" "(" "name" STRING "node" node ")" +-- @ +module NovaCache.NAR + ( NarEntry (..), + serialise, + deserialise, + narHash, + serialiseFromPath, + ) +where + +import Data.Bits (shiftL, (.&.), (.|.)) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Builder as B +import qualified Data.ByteString.Lazy as BL +import Data.List (sort, sortBy) +import Data.Ord (comparing) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import Data.Word (Word64) +import qualified NovaCache.Hash as Hash +import System.Directory + ( doesDirectoryExist, + doesFileExist, + getSymbolicLinkTarget, + listDirectory, + pathIsSymbolicLink, + ) +import System.FilePath (()) +import qualified System.Posix.Files as Posix + +-- --------------------------------------------------------------------------- +-- Types +-- --------------------------------------------------------------------------- + +-- | A node in the NAR tree. +data NarEntry + = -- | Regular file: executable flag and contents. + NarRegular !Bool !ByteString + | -- | Symbolic link: target path. + NarSymlink !Text + | -- | Directory: sorted list of (name, entry) pairs. + NarDirectory ![(Text, NarEntry)] + deriving (Eq, Show) + +-- --------------------------------------------------------------------------- +-- Wire tokens (named constants, no magic strings) +-- --------------------------------------------------------------------------- + +tokMagic, tokLParen, tokRParen, tokType :: ByteString +tokMagic = "nix-archive-1" +tokLParen = "(" +tokRParen = ")" +tokType = "type" + +tokRegular, tokDirectory, tokSymlink :: ByteString +tokRegular = "regular" +tokDirectory = "directory" +tokSymlink = "symlink" + +tokContents, tokTarget, tokExecutable :: ByteString +tokContents = "contents" +tokTarget = "target" +tokExecutable = "executable" + +tokEntry, tokName, tokNode :: ByteString +tokEntry = "entry" +tokName = "name" +tokNode = "node" + +-- | Alignment boundary for NAR wire strings. +narAlignment :: Int +narAlignment = 8 + +-- --------------------------------------------------------------------------- +-- Serialization (pure Builder pipeline) +-- --------------------------------------------------------------------------- + +-- | Serialise a 'NarEntry' to NAR binary format. +serialise :: NarEntry -> ByteString +serialise = BL.toStrict . B.toLazyByteString . buildArchive + +-- | Build the full NAR archive: magic header followed by the root node. +buildArchive :: NarEntry -> B.Builder +buildArchive entry = narStr tokMagic <> buildNode entry + +-- | Build a NAR node. +buildNode :: NarEntry -> B.Builder +buildNode (NarRegular isExec contents) = + narStr tokLParen + <> narStr tokType + <> narStr tokRegular + <> execFlag isExec + <> narStr tokContents + <> narStr contents + <> narStr tokRParen +buildNode (NarSymlink target) = + narStr tokLParen + <> narStr tokType + <> narStr tokSymlink + <> narStr tokTarget + <> narStr (TE.encodeUtf8 target) + <> narStr tokRParen +buildNode (NarDirectory entries) = + narStr tokLParen + <> narStr tokType + <> narStr tokDirectory + <> foldMap buildDirEntry (sortBy (comparing fst) entries) + <> narStr tokRParen + +-- | Emit the executable flag tokens if the file is executable. +execFlag :: Bool -> B.Builder +execFlag True = narStr tokExecutable <> narStr BS.empty +execFlag False = mempty + +-- | Build a single directory entry: @"entry" "(" "name" \ "node" \ ")"@. +buildDirEntry :: (Text, NarEntry) -> B.Builder +buildDirEntry (entryName, entry) = + narStr tokEntry + <> narStr tokLParen + <> narStr tokName + <> narStr (TE.encodeUtf8 entryName) + <> narStr tokNode + <> buildNode entry + <> narStr tokRParen + +-- | Write a length-prefixed, 8-byte-padded bytestring to the Builder. +narStr :: ByteString -> B.Builder +narStr bs = + B.word64LE (fromIntegral len) + <> B.byteString bs + <> B.byteString (BS.replicate padLen 0) + where + len = BS.length bs + padLen = narPad len + +-- | Compute padding to reach the next 8-byte boundary. +narPad :: Int -> Int +narPad len = + let remainder = len .&. (narAlignment - 1) + in if remainder == 0 then 0 else narAlignment - remainder + +-- --------------------------------------------------------------------------- +-- Deserialization (pure, cursor-passing parser) +-- --------------------------------------------------------------------------- + +-- | Parser state: remaining bytes after consuming a token. +type NarParser a = ByteString -> Either String (a, ByteString) + +-- | Deserialise NAR binary format to a 'NarEntry'. +deserialise :: ByteString -> Either String NarEntry +deserialise bs = do + (magic, rest) <- readStr bs + expect tokMagic magic + fst <$> parseNode rest + +-- | Parse a single NAR node. +parseNode :: NarParser NarEntry +parseNode bs = do + (lp, rest) <- readStr bs + expect tokLParen lp + (ty, afterTy) <- readStr rest + expect tokType ty + (kind, afterKind) <- readStr afterTy + dispatch kind afterKind + where + dispatch kind rest + | kind == tokRegular = parseRegular rest + | kind == tokSymlink = parseSymlink rest + | kind == tokDirectory = parseDirectory rest + | otherwise = Left ("unknown NAR entry type: " ++ show kind) + +-- | Parse a regular file node (optional executable flag + contents). +parseRegular :: NarParser NarEntry +parseRegular bs = do + (tok, afterTok) <- readStr bs + regular tok afterTok + where + regular tok rest + | tok == tokExecutable = do + (_, afterEmpty) <- readStr rest + (cTok, afterCTok) <- readStr afterEmpty + expect tokContents cTok + (contents, afterContents) <- readStr afterCTok + (rp, final) <- readStr afterContents + expect tokRParen rp + pure (NarRegular True contents, final) + | tok == tokContents = do + (contents, afterContents) <- readStr rest + (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) + +-- | Parse a symlink node. +parseSymlink :: NarParser NarEntry +parseSymlink bs = do + (tgt, afterTgt) <- readStr bs + expect tokTarget tgt + (targetPath, afterPath) <- readStr afterTgt + (rp, final) <- readStr afterPath + expect tokRParen rp + pure (NarSymlink (TE.decodeUtf8 targetPath), final) + +-- | Parse a directory node (zero or more child entries). +parseDirectory :: NarParser NarEntry +parseDirectory = go [] + where + go !acc bs = do + (tok, afterTok) <- readStr bs + if tok == tokRParen + then pure (NarDirectory (reverse acc), afterTok) + else do + expect tokEntry tok + (lp, afterLp) <- readStr afterTok + expect tokLParen lp + (nTok, afterNTok) <- readStr afterLp + expect tokName nTok + (entryName, afterName) <- readStr afterNTok + (nodeTok, afterNodeTok) <- readStr afterName + expect tokNode nodeTok + (entry, afterEntry) <- parseNode afterNodeTok + (rp, afterRp) <- readStr afterEntry + expect tokRParen rp + go ((TE.decodeUtf8 entryName, entry) : acc) afterRp + +-- --------------------------------------------------------------------------- +-- Wire primitives +-- --------------------------------------------------------------------------- + +-- | Read a length-prefixed, 8-byte-padded string from the buffer. +readStr :: NarParser ByteString +readStr bs + | BS.length bs < wordSize = + Left "unexpected end of NAR: need 8 bytes for string length" + | totalLen > BS.length payload = + Left + ( "unexpected end of NAR: string length " + ++ show len + ++ " exceeds remaining " + ++ show (BS.length payload) + ) + | 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) + +-- | Read a little-endian 'Word64' from the first 8 bytes. +readWord64LE :: ByteString -> Word64 +readWord64LE bs = + byte 0 + .|. (byte 1 `shiftL` 8) + .|. (byte 2 `shiftL` 16) + .|. (byte 3 `shiftL` 24) + .|. (byte 4 `shiftL` 32) + .|. (byte 5 `shiftL` 40) + .|. (byte 6 `shiftL` 48) + .|. (byte 7 `shiftL` 56) + where + byte i = fromIntegral (BS.index bs i) + +-- | Size of a Word64 in bytes. +wordSize :: Int +wordSize = 8 + +-- | Assert that a token matches the expected value. +expect :: ByteString -> ByteString -> Either String () +expect expected got + | got == expected = Right () + | otherwise = Left ("expected " ++ show expected ++ ", got " ++ show got) + +-- --------------------------------------------------------------------------- +-- Hashing +-- --------------------------------------------------------------------------- + +-- | SHA-256 hash of the NAR serialization. Pure composition. +narHash :: NarEntry -> Hash.NixHash +narHash = Hash.hashBytes . serialise + +-- --------------------------------------------------------------------------- +-- Filesystem to NarEntry (IO boundary) +-- --------------------------------------------------------------------------- + +-- | Walk a filesystem path and build a 'NarEntry'. +-- +-- This is the sole IO function in the module. It classifies each path +-- as symlink, directory, or regular file, then delegates to pure +-- constructors. +serialiseFromPath :: FilePath -> IO NarEntry +serialiseFromPath path = do + isSym <- pathIsSymbolicLink path + if isSym + then NarSymlink . T.pack <$> getSymbolicLinkTarget path + else do + isDir <- doesDirectoryExist path + if isDir + then buildDirectory path + else buildRegularFile path + +-- | Build a directory entry by recursively walking children. +buildDirectory :: FilePath -> IO NarEntry +buildDirectory path = do + names <- sort <$> listDirectory path + entries <- traverse walkChild names + pure (NarDirectory entries) + where + walkChild name = do + entry <- serialiseFromPath (path name) + pure (T.pack name, entry) + +-- | Build a regular file entry, checking the executable bit. +buildRegularFile :: FilePath -> IO NarEntry +buildRegularFile path = do + isFile <- doesFileExist path + if isFile + then do + contents <- BS.readFile path + isExec <- checkExecutable path + pure (NarRegular isExec contents) + else pure (NarRegular False BS.empty) + +-- | Check whether a file has the owner-execute permission set. +checkExecutable :: FilePath -> IO Bool +checkExecutable path = do + status <- Posix.getFileStatus path + pure (Posix.fileMode status .&. Posix.ownerExecuteMode /= 0) diff --git a/src/NovaCache/NarInfo.hs b/src/NovaCache/NarInfo.hs new file mode 100644 --- /dev/null +++ b/src/NovaCache/NarInfo.hs @@ -0,0 +1,173 @@ +-- | NarInfo text format parsing and rendering. +-- +-- 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@. +module NovaCache.NarInfo + ( NarInfo (..), + parseNarInfo, + renderNarInfo, + ) +where + +import Data.List (find) +import Data.Maybe (mapMaybe) +import Data.Text (Text) +import qualified Data.Text as T + +-- --------------------------------------------------------------------------- +-- Types +-- --------------------------------------------------------------------------- + +-- | A parsed @.narinfo@ record. All fields are strict. +data NarInfo = NarInfo + { niStorePath :: !Text, + niUrl :: !Text, + niCompression :: !Text, + niFileHash :: !Text, + niFileSize :: !Integer, + niNarHash :: !Text, + niNarSize :: !Integer, + niReferences :: ![Text], + niDeriver :: !(Maybe Text), + niSystem :: !(Maybe Text), + niSigs :: ![Text], + niCA :: !(Maybe Text) + } + deriving (Eq, Show) + +-- --------------------------------------------------------------------------- +-- Key constants (no magic strings in logic) +-- --------------------------------------------------------------------------- + +keyStorePath, keyUrl, keyCompression, keyFileHash :: Text +keyStorePath = "StorePath" +keyUrl = "URL" +keyCompression = "Compression" +keyFileHash = "FileHash" + +keyFileSize, keyNarHash, keyNarSize, keyReferences :: Text +keyFileSize = "FileSize" +keyNarHash = "NarHash" +keyNarSize = "NarSize" +keyReferences = "References" + +keyDeriver, keySystem, keySig, keyCA :: Text +keyDeriver = "Deriver" +keySystem = "System" +keySig = "Sig" +keyCA = "CA" + +-- | Key-value separator in narinfo format. +kvSeparator :: Text +kvSeparator = ": " + +-- | Length of the key-value separator. +kvSeparatorLen :: Int +kvSeparatorLen = 2 + +-- --------------------------------------------------------------------------- +-- Parsing +-- --------------------------------------------------------------------------- + +-- | Parse a narinfo text body into a 'NarInfo'. +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 + narHashVal <- require keyNarHash kvs + narSize <- require keyNarSize kvs >>= parseInteger keyNarSize + pure + NarInfo + { niStorePath = storePath, + niUrl = url, + niCompression = compression, + niFileHash = fileHash, + niFileSize = fileSize, + niNarHash = narHashVal, + niNarSize = narSize, + niReferences = parseRefs (lookupFirst keyReferences kvs), + niDeriver = lookupFirst keyDeriver kvs, + niSystem = lookupFirst keySystem kvs, + niSigs = lookupAll keySig kvs, + niCA = lookupFirst keyCA kvs + } + +-- | Parse a space-separated references field. +parseRefs :: Maybe Text -> [Text] +parseRefs Nothing = [] +parseRefs (Just r) + | T.null (T.strip r) = [] + | otherwise = T.words r + +-- --------------------------------------------------------------------------- +-- Rendering +-- --------------------------------------------------------------------------- + +-- | Render a 'NarInfo' to its text representation. +renderNarInfo :: NarInfo -> Text +renderNarInfo ni = + 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)) + ] + ++ optionalKV keyDeriver (niDeriver ni) + ++ optionalKV keySystem (niSystem ni) + ++ map (kv keySig) (niSigs ni) + ++ optionalKV keyCA (niCA ni) + +-- --------------------------------------------------------------------------- +-- Key-value primitives +-- --------------------------------------------------------------------------- + +-- | Parse a single @Key: Value@ line. +parseLine :: Text -> Maybe (Text, Text) +parseLine line = case T.breakOn kvSeparator line of + (_, rest) + | T.null rest -> Nothing + | otherwise -> Just (key, T.drop kvSeparatorLen rest) + where + key = fst (T.breakOn kvSeparator line) + +-- | Render a key-value pair. +kv :: Text -> Text -> Text +kv key val = key <> kvSeparator <> val + +-- | Render an optional key-value pair. +optionalKV :: Text -> Maybe Text -> [Text] +optionalKV _ Nothing = [] +optionalKV key (Just val) = [kv key val] + +-- | Look up the first occurrence of a key. +lookupFirst :: Text -> [(Text, Text)] -> Maybe Text +lookupFirst key kvs = snd <$> find ((== key) . fst) kvs + +-- | Look up all occurrences of a key. +lookupAll :: Text -> [(Text, Text)] -> [Text] +lookupAll key = map snd . filter ((== key) . fst) + +-- | Require a key to be present. +require :: Text -> [(Text, Text)] -> Either String Text +require key kvs = case lookupFirst key kvs of + Nothing -> Left ("missing required key: " ++ T.unpack key) + Just val -> Right val + +-- | Parse an integer value from text. +parseInteger :: Text -> Text -> Either String Integer +parseInteger key txt = case reads (T.unpack txt) of + [(n, "")] -> Right n + _ -> Left ("invalid integer for " ++ T.unpack key ++ ": " ++ T.unpack txt) + +-- | Show a value as 'Text'. +showT :: (Show a) => a -> Text +showT = T.pack . show diff --git a/src/NovaCache/Signing.hs b/src/NovaCache/Signing.hs new file mode 100644 --- /dev/null +++ b/src/NovaCache/Signing.hs @@ -0,0 +1,200 @@ +-- | Ed25519 signing and verification for Nix binary cache. +-- +-- Nix signs narinfo fingerprints with Ed25519. Keys are stored as +-- @name:base64@ pairs. The fingerprint is a semicolon-delimited string: +-- +-- @1;\;\;\;\@ +module NovaCache.Signing + ( SecretKey (..), + PublicKey (..), + parseSecretKey, + parsePublicKey, + fingerprint, + sign, + verify, + ) +where + +import Crypto.Error (CryptoFailable (..)) +import qualified Crypto.PubKey.Ed25519 as Ed25519 +import Data.ByteArray (convert) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base64 as B64 +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import NovaCache.NarInfo (NarInfo (..)) + +-- --------------------------------------------------------------------------- +-- Types +-- --------------------------------------------------------------------------- + +-- | An Ed25519 secret key with its key name. +data SecretKey = SecretKey + { skName :: !Text, + skBytes :: !ByteString + } + deriving (Eq, Show) + +-- | An Ed25519 public key with its key name. +data PublicKey = PublicKey + { pkName :: !Text, + pkBytes :: !ByteString + } + deriving (Eq, Show) + +-- --------------------------------------------------------------------------- +-- Constants +-- --------------------------------------------------------------------------- + +-- | Size of an Ed25519 secret key: 32-byte seed + 32-byte public half. +ed25519SecretKeySize :: Int +ed25519SecretKeySize = 64 + +-- | Size of an Ed25519 public key. +ed25519PublicKeySize :: Int +ed25519PublicKeySize = 32 + +-- | Size of the Ed25519 seed (first half of the secret key). +ed25519SeedSize :: Int +ed25519SeedSize = 32 + +-- | Key separator in @name:base64@ format. +keySeparator :: Text +keySeparator = ":" + +-- | Fingerprint version tag. +fingerprintVersion :: Text +fingerprintVersion = "1" + +-- | Fingerprint field separator. +fingerprintSep :: Text +fingerprintSep = ";" + +-- | Reference separator within a fingerprint. +referenceSep :: Text +referenceSep = "," + +-- --------------------------------------------------------------------------- +-- Key parsing +-- --------------------------------------------------------------------------- + +-- | Parse a @name:base64@ secret key string. +parseSecretKey :: Text -> Either String SecretKey +parseSecretKey txt = do + (keyName, decoded) <- splitAndDecode txt "secret key" + expectSize ed25519SecretKeySize "secret key" decoded + pure SecretKey {skName = keyName, skBytes = decoded} + +-- | Parse a @name:base64@ public key string. +parsePublicKey :: Text -> Either String PublicKey +parsePublicKey txt = do + (keyName, decoded) <- splitAndDecode txt "public key" + expectSize ed25519PublicKeySize "public key" decoded + pure PublicKey {pkName = keyName, pkBytes = decoded} + +-- | Split a @name:base64@ string and decode the base64 payload. +splitAndDecode :: Text -> String -> Either String (Text, ByteString) +splitAndDecode txt label = case T.breakOn keySeparator txt of + (_, rest) + | T.null rest -> Left (label ++ " missing ':' separator") + | otherwise -> do + let encoded = T.drop 1 rest + keyName = fst (T.breakOn keySeparator txt) + decoded <- decodeBase64 encoded + pure (keyName, decoded) + +-- | Assert that decoded bytes have the expected size. +expectSize :: Int -> String -> ByteString -> Either String () +expectSize expected label bs + | BS.length bs == expected = Right () + | otherwise = + Left + ( "expected " + ++ show expected + ++ "-byte " + ++ label + ++ ", got " + ++ show (BS.length bs) + ) + +-- --------------------------------------------------------------------------- +-- Fingerprint +-- --------------------------------------------------------------------------- + +-- | Construct the fingerprint string for a narinfo. +-- +-- Format: @1;\;\;\;\@ +fingerprint :: NarInfo -> Text +fingerprint ni = + T.intercalate + fingerprintSep + [ fingerprintVersion, + niStorePath ni, + niNarHash ni, + T.pack (show (niNarSize ni)), + T.intercalate referenceSep (niReferences ni) + ] + +-- --------------------------------------------------------------------------- +-- Signing and verification +-- --------------------------------------------------------------------------- + +-- | Sign a narinfo, producing a @keyname:base64sig@ string. +sign :: SecretKey -> NarInfo -> Either String Text +sign (SecretKey keyName secretBytes) ni = do + sk <- cryptoSecretKey (BS.take ed25519SeedSize secretBytes) + let pk = Ed25519.toPublic sk + msg = TE.encodeUtf8 (fingerprint ni) + sig = Ed25519.sign sk pk msg + sigB64 = TE.decodeUtf8 (B64.encode (convert sig)) + pure (keyName <> keySeparator <> sigB64) + +-- | Verify a @keyname:base64sig@ signature against a narinfo and public key. +-- +-- Returns 'False' for any malformed 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 + +-- | Extract the raw signature bytes from a @keyname:base64sig@ line. +extractSignaturePayload :: Text -> Maybe ByteString +extractSignaturePayload sigLine = case T.breakOn keySeparator sigLine of + (_, rest) + | T.null rest -> Nothing + | otherwise -> either (const Nothing) Just (decodeBase64 (T.drop 1 rest)) + +-- | Low-level Ed25519 verification of raw bytes. +verifyRaw :: ByteString -> ByteString -> ByteString -> Bool +verifyRaw pubBytes msg sigBytes = + case (cryptoPublicKey pubBytes, cryptoSignature sigBytes) of + (Right pk, Right sig) -> Ed25519.verify pk msg sig + _ -> False + +-- --------------------------------------------------------------------------- +-- Cryptographic primitives (thin wrappers over crypton) +-- --------------------------------------------------------------------------- + +-- | Decode base64 text to bytes. +decodeBase64 :: Text -> Either String ByteString +decodeBase64 = B64.decode . TE.encodeUtf8 + +-- | Lift a 'CryptoFailable' to 'Either' with a descriptive label. +liftCrypto :: String -> CryptoFailable a -> Either String a +liftCrypto _ (CryptoPassed x) = Right x +liftCrypto label (CryptoFailed err) = Left ("invalid " ++ label ++ ": " ++ show err) + +-- | Parse raw bytes as an Ed25519 secret key. +cryptoSecretKey :: ByteString -> Either String Ed25519.SecretKey +cryptoSecretKey = liftCrypto "Ed25519 secret key" . Ed25519.secretKey + +-- | Parse raw bytes as an Ed25519 public key. +cryptoPublicKey :: ByteString -> Either String Ed25519.PublicKey +cryptoPublicKey = liftCrypto "Ed25519 public key" . Ed25519.publicKey + +-- | Parse raw bytes as an Ed25519 signature. +cryptoSignature :: ByteString -> Either String Ed25519.Signature +cryptoSignature = liftCrypto "Ed25519 signature" . Ed25519.signature diff --git a/src/NovaCache/Store.hs b/src/NovaCache/Store.hs new file mode 100644 --- /dev/null +++ b/src/NovaCache/Store.hs @@ -0,0 +1,157 @@ +-- | Filesystem storage backend for a Nix binary cache. +-- +-- Stores narinfo and NAR files in a directory tree: +-- +-- @ +-- \\/narinfo\/\ -- narinfo files by store path hash +-- \\/nar\/\ -- compressed NAR files +-- @ +module NovaCache.Store + ( FileStore (..), + newFileStore, + readNarInfo, + writeNarInfo, + readNar, + writeNar, + getCacheInfo, + sanitizePath, + ) +where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.Text (Text) +import qualified Data.Text as T +import System.Directory + ( createDirectoryIfMissing, + doesFileExist, + ) +import System.FilePath (()) + +-- --------------------------------------------------------------------------- +-- Types +-- --------------------------------------------------------------------------- + +-- | Filesystem-backed cache store configuration. +data FileStore = FileStore + { fsRoot :: !FilePath, + fsStoreDir :: !Text, + fsPriority :: !Int + } + deriving (Show) + +-- --------------------------------------------------------------------------- +-- Constants +-- --------------------------------------------------------------------------- + +-- | Subdirectory for narinfo files. +narinfoSubdir :: String +narinfoSubdir = "narinfo" + +-- | Subdirectory for NAR files. +narSubdir :: String +narSubdir = "nar" + +-- | Default cache priority (lower = preferred by Nix). +defaultPriority :: Int +defaultPriority = 30 + +-- | Default Nix store directory. +defaultStoreDir :: Text +defaultStoreDir = "/nix/store" + +-- --------------------------------------------------------------------------- +-- Initialization +-- --------------------------------------------------------------------------- + +-- | Create a 'FileStore' rooted at the given directory. +-- +-- Ensures the @narinfo@ and @nar@ subdirectories exist. +newFileStore :: FilePath -> IO FileStore +newFileStore root = do + createDirectoryIfMissing True (root narinfoSubdir) + createDirectoryIfMissing True (root narSubdir) + pure + FileStore + { fsRoot = root, + fsStoreDir = defaultStoreDir, + fsPriority = defaultPriority + } + +-- --------------------------------------------------------------------------- +-- NarInfo operations +-- --------------------------------------------------------------------------- + +-- | Read a narinfo by its store path hash. Returns 'Nothing' if absent. +-- +-- Returns 'Nothing' for path components containing traversal sequences. +readNarInfo :: FileStore -> Text -> IO (Maybe ByteString) +readNarInfo fs hashKey = case sanitizePath hashKey of + Nothing -> pure Nothing + Just safe -> readIfExists (fsRoot fs narinfoSubdir safe) + +-- | Write a narinfo by its store path hash. +-- +-- Silently rejects path components containing traversal sequences. +writeNarInfo :: FileStore -> Text -> ByteString -> IO () +writeNarInfo fs hashKey body = case sanitizePath hashKey of + Nothing -> pure () + Just safe -> BS.writeFile (fsRoot fs narinfoSubdir safe) body + +-- --------------------------------------------------------------------------- +-- NAR operations +-- --------------------------------------------------------------------------- + +-- | Read a NAR file by its filename. Returns 'Nothing' if absent. +-- +-- Returns 'Nothing' for path components containing traversal sequences. +readNar :: FileStore -> Text -> IO (Maybe ByteString) +readNar fs fileName = case sanitizePath fileName of + Nothing -> pure Nothing + Just safe -> readIfExists (fsRoot fs narSubdir safe) + +-- | Write a NAR file by its filename. +-- +-- Silently rejects path components containing traversal sequences. +writeNar :: FileStore -> Text -> ByteString -> IO () +writeNar fs fileName body = case sanitizePath fileName of + Nothing -> pure () + Just safe -> BS.writeFile (fsRoot fs narSubdir safe) body + +-- --------------------------------------------------------------------------- +-- Cache metadata +-- --------------------------------------------------------------------------- + +-- | Cache metadata: (storeDir, wantMassQuery, priority). +getCacheInfo :: FileStore -> (Text, Bool, Int) +getCacheInfo fs = (fsStoreDir fs, True, fsPriority fs) + +-- --------------------------------------------------------------------------- +-- Path sanitization +-- --------------------------------------------------------------------------- + +-- | Validate a path component for safe filesystem use. +-- +-- Rejects components containing directory separators (@\/@, @\\@), +-- traversal sequences (@..@), or empty strings. Returns 'Just' the +-- sanitized 'FilePath' on success, 'Nothing' on rejection. +sanitizePath :: Text -> Maybe FilePath +sanitizePath txt + | T.null txt = Nothing + | T.any isPathSeparator txt = Nothing + | txt == ".." = Nothing + | otherwise = Just (T.unpack txt) + where + isPathSeparator c = c == '/' || c == '\\' + +-- --------------------------------------------------------------------------- +-- Internal +-- --------------------------------------------------------------------------- + +-- | Read a file if it exists, returning 'Nothing' otherwise. +readIfExists :: FilePath -> IO (Maybe ByteString) +readIfExists path = do + exists <- doesFileExist path + if exists + then Just <$> BS.readFile path + else pure Nothing diff --git a/src/NovaCache/StorePath.hs b/src/NovaCache/StorePath.hs new file mode 100644 --- /dev/null +++ b/src/NovaCache/StorePath.hs @@ -0,0 +1,137 @@ +-- | Nix store path parsing, rendering, and validation. +-- +-- A store path has the form @\/nix\/store\/\-\@ where the hash +-- is a 32-character nix-base32 string and the name contains only characters +-- from a restricted set: alphanumeric plus @-._+?=@. +module NovaCache.StorePath + ( StoreDir (..), + StorePath (..), + StorePathHash (..), + StorePathName (..), + parseStorePath, + renderStorePath, + storePathHashString, + storePathBaseName, + defaultStoreDir, + ) +where + +import Data.Char (isAlphaNum) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import qualified Data.Text as T + +-- --------------------------------------------------------------------------- +-- Types +-- --------------------------------------------------------------------------- + +-- | Root directory of the Nix store. +newtype StoreDir = StoreDir FilePath + deriving (Eq, Ord, Show) + +-- | A parsed store path: hash prefix and validated name. +data StorePath = StorePath + { spHash :: !StorePathHash, + spName :: !StorePathName + } + deriving (Eq, Ord, Show) + +-- | The 32-character nix-base32 hash prefix of a store path. +newtype StorePathHash = StorePathHash Text + deriving (Eq, Ord, Show) + +-- | The validated name component of a store path. +newtype StorePathName = StorePathName Text + deriving (Eq, Ord, Show) + +-- --------------------------------------------------------------------------- +-- Constants +-- --------------------------------------------------------------------------- + +-- | The standard Nix store directory. +defaultStoreDir :: StoreDir +defaultStoreDir = StoreDir defaultStoreDirPath + +-- | Default store directory path. +defaultStoreDirPath :: FilePath +defaultStoreDirPath = "/nix/store" + +-- | Length of the nix-base32 hash in a store path. +storePathHashLen :: Int +storePathHashLen = 32 + +-- | Minimum basename length: hash + separator. +minBaseNameLen :: Int +minBaseNameLen = storePathHashLen + 1 + +-- | The separator between hash and name in a store path. +hashNameSeparator :: Char +hashNameSeparator = '-' + +-- --------------------------------------------------------------------------- +-- Validation +-- --------------------------------------------------------------------------- + +-- | Characters allowed in the name component of a store path. +-- +-- Alphanumeric plus @-._+?=@, matching the Nix specification. +validNameChar :: Char -> Bool +validNameChar c = + isAlphaNum c + || c == '-' + || c == '_' + || c == '.' + || c == '+' + || c == '?' + || c == '=' + +-- --------------------------------------------------------------------------- +-- Parsing +-- --------------------------------------------------------------------------- + +-- | Parse a store path from a full path or bare basename. +-- +-- Accepts @\/nix\/store\/\-\@ or just @\-\@. +parseStorePath :: StoreDir -> Text -> Either String StorePath +parseStorePath (StoreDir dir) txt = + parseBaseName (stripDirPrefix dir txt) + +-- | Strip the store directory prefix if present. +stripDirPrefix :: FilePath -> Text -> Text +stripDirPrefix dir txt = + fromMaybe txt (T.stripPrefix (T.pack dir <> "/") txt) + +-- | Parse a @\-\@ basename into a 'StorePath'. +parseBaseName :: Text -> Either String StorePath +parseBaseName basename + | T.length basename < minBaseNameLen = + Left ("store path too short: " ++ T.unpack basename) + | T.index basename storePathHashLen /= hashNameSeparator = + Left ("expected '-' after hash in store path: " ++ T.unpack basename) + | T.null name = + Left ("empty name in store path: " ++ T.unpack basename) + | not (T.all validNameChar name) = + Left ("invalid characters in store path name: " ++ T.unpack name) + | otherwise = + Right StorePath {spHash = StorePathHash hashPart, spName = StorePathName name} + where + hashPart = T.take storePathHashLen basename + name = T.drop minBaseNameLen basename + +-- --------------------------------------------------------------------------- +-- Rendering +-- --------------------------------------------------------------------------- + +-- | Render a store path as a full path under the given store directory. +renderStorePath :: StoreDir -> StorePath -> Text +renderStorePath (StoreDir dir) sp = + T.pack dir <> "/" <> storePathBaseName sp + +-- | Extract the 32-character nix-base32 hash string. +storePathHashString :: StorePath -> Text +storePathHashString (StorePath (StorePathHash h) _) = h + +-- | Render the @\-\@ basename. +storePathBaseName :: StorePath -> Text +storePathBaseName (StorePath (StorePathHash h) (StorePathName n)) = + h <> T.singleton hashNameSeparator <> n diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,603 @@ +module Main (main) where + +import qualified Crypto.PubKey.Ed25519 as Ed25519 +import Data.ByteArray (convert) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base64 as B64 +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified NovaCache.Base32 as Base32 +import qualified NovaCache.Compression as Compression +import qualified NovaCache.Hash as Hash +import qualified NovaCache.NAR as NAR +import qualified NovaCache.NarInfo as NarInfo +import qualified NovaCache.Signing as Signing +import qualified NovaCache.Store as Store +import qualified NovaCache.StorePath as StorePath +import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive) +import System.Exit (exitFailure, exitSuccess) +import System.IO (hFlush, stdout) + +-- --------------------------------------------------------------------------- +-- Test harness (hand-rolled, no framework) +-- --------------------------------------------------------------------------- + +-- | 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 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 + +-- | 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 Bool is False. +assertFalse :: String -> Bool -> IO Bool +assertFalse _ False = pure True +assertFalse label True = do + putStrLn "" + putStrLn (" " ++ label ++ ": expected False") + pure False + +-- | Run a group of tests, stopping at first failure. +runGroup :: String -> [IO Bool] -> IO Bool +runGroup name tests = do + putStrLn (name ++ ":") + go tests + where + go [] = pure True + go (t : ts) = do + ok <- t + if ok then go ts else pure False + +-- | Run all test groups. +runAll :: [IO Bool] -> IO () +runAll groups = do + results <- sequence groups + let passed = length (filter id results) + total = length results + putStrLn "" + if and results + then do + putStrLn ("All " ++ show total ++ " groups passed.") + exitSuccess + else do + putStrLn (show passed ++ "/" ++ show total ++ " groups passed.") + exitFailure + +main :: IO () +main = do + putStrLn "nova-cache test suite" + putStrLn "======================" + putStrLn "" + runAll + [ testBase32, + testHash, + testStorePath, + testNAR, + testNarInfo, + testSigning, + testCompression, + testFileStore + ] + +-- --------------------------------------------------------------------------- +-- Base32 tests +-- --------------------------------------------------------------------------- + +testBase32 :: IO Bool +testBase32 = + runGroup + "Base32" + [ test "encode empty" $ + assertEqual "encode empty" "" (Base32.encode BS.empty), + test "decode empty" $ + assertRight "decode empty" BS.empty (Base32.decode ""), + test "encode/decode roundtrip (single byte)" $ + let bs = BS.singleton 0xFF + encoded = Base32.encode bs + in assertRight "roundtrip 0xFF" bs (Base32.decode encoded), + test "encode/decode roundtrip (known SHA-256)" $ + let bs = BS.pack [0 .. 31] + encoded = Base32.encode bs + in assertRight "roundtrip 32 bytes" bs (Base32.decode encoded), + test "encode/decode roundtrip (all zeros)" $ + let bs = BS.replicate 32 0 + encoded = Base32.encode bs + in assertRight "roundtrip zeros" bs (Base32.decode encoded), + test "encode/decode roundtrip (all 0xFF)" $ + let bs = BS.replicate 32 0xFF + encoded = Base32.encode bs + in assertRight "roundtrip 0xFF*32" bs (Base32.decode encoded), + test "decode invalid character" $ + assertLeft "invalid char" (Base32.decode "hello!"), + test "encode length for 32 bytes" $ + -- 32 bytes -> ceil(32*8/5) = ceil(51.2) = 52 chars + let bs = BS.replicate 32 0x42 + 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) + ] + +-- --------------------------------------------------------------------------- +-- Hash tests +-- --------------------------------------------------------------------------- + +testHash :: IO Bool +testHash = + runGroup + "Hash" + [ test "hashBytes deterministic" $ + let h1 = Hash.hashBytes (BS.pack [1, 2, 3]) + h2 = Hash.hashBytes (BS.pack [1, 2, 3]) + in assertEqual "deterministic" h1 h2, + test "hashBytes different inputs differ" $ + let h1 = Hash.hashBytes (BS.pack [1, 2, 3]) + h2 = Hash.hashBytes (BS.pack [4, 5, 6]) + in assertTrue "different" (h1 /= h2), + test "hashBytes is 32 bytes" $ + let Hash.NixHash raw = Hash.hashBytes BS.empty + in assertEqual "32 bytes" 32 (BS.length raw), + test "formatNixHash prefix" $ + let formatted = Hash.formatNixHash (Hash.hashBytes BS.empty) + in assertTrue "sha256: prefix" (T.isPrefixOf "sha256:" formatted), + test "formatNixHash/parseNixHash roundtrip" $ + let h = Hash.hashBytes (BS.pack [42]) + formatted = Hash.formatNixHash h + in assertRight "roundtrip" h (Hash.parseNixHash formatted), + test "parseNixHash bad prefix" $ + assertLeft "bad prefix" (Hash.parseNixHash "md5:abc"), + test "parseNixHash bad base32" $ + assertLeft "bad base32" (Hash.parseNixHash "sha256:!!invalid!!") + ] + +-- --------------------------------------------------------------------------- +-- StorePath tests +-- --------------------------------------------------------------------------- + +testStorePath :: IO Bool +testStorePath = + runGroup + "StorePath" + [ test "parse/render roundtrip" $ + let storeDir = StorePath.defaultStoreDir + input = "/nix/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-hello-1.0" + in case StorePath.parseStorePath storeDir input of + Left err -> do + putStrLn (" parse failed: " ++ err) + pure False + Right sp -> + assertEqual "roundtrip" input (StorePath.renderStorePath storeDir sp), + test "parse basename only" $ + let storeDir = StorePath.defaultStoreDir + basename = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-hello-1.0" + in case StorePath.parseStorePath storeDir basename of + Left err -> do + putStrLn (" parse failed: " ++ err) + pure False + Right sp -> + assertEqual "basename" basename (StorePath.storePathBaseName sp), + test "parse extracts hash" $ + let storeDir = StorePath.defaultStoreDir + input = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-test" + in case StorePath.parseStorePath storeDir input of + Left _ -> pure False + Right sp -> + assertEqual "hash" "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" (StorePath.storePathHashString sp), + test "reject too short" $ + let storeDir = StorePath.defaultStoreDir + in assertLeft "too short" (StorePath.parseStorePath storeDir "abc-def"), + test "reject empty name" $ + let storeDir = StorePath.defaultStoreDir + in assertLeft "empty name" (StorePath.parseStorePath storeDir "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-"), + test "reject invalid name chars" $ + let storeDir = StorePath.defaultStoreDir + input = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-hello world" + in assertLeft "invalid chars" (StorePath.parseStorePath storeDir input) + ] + +-- --------------------------------------------------------------------------- +-- NAR tests +-- --------------------------------------------------------------------------- + +testNAR :: IO Bool +testNAR = + runGroup + "NAR" + [ test "serialise/deserialise roundtrip (regular file)" $ + let entry = NAR.NarRegular False (BS.pack [72, 101, 108, 108, 111]) + serialised = NAR.serialise entry + in assertRight "roundtrip regular" entry (NAR.deserialise serialised), + test "serialise/deserialise roundtrip (empty file)" $ + let entry = NAR.NarRegular False BS.empty + serialised = NAR.serialise entry + in assertRight "roundtrip empty" entry (NAR.deserialise serialised), + test "serialise/deserialise roundtrip (executable)" $ + let entry = NAR.NarRegular True (BS.pack [0x7F, 0x45, 0x4C, 0x46]) + serialised = NAR.serialise entry + in assertRight "roundtrip exec" entry (NAR.deserialise serialised), + test "serialise/deserialise roundtrip (symlink)" $ + let entry = NAR.NarSymlink "/usr/bin/hello" + serialised = NAR.serialise entry + in assertRight "roundtrip symlink" entry (NAR.deserialise serialised), + test "serialise/deserialise roundtrip (directory)" $ + let entry = + NAR.NarDirectory + [ ("bar", NAR.NarRegular False (BS.pack [2])), + ("foo", NAR.NarRegular False (BS.pack [1])) + ] + serialised = NAR.serialise entry + in assertRight "roundtrip dir" entry (NAR.deserialise serialised), + test "serialise/deserialise roundtrip (nested directory)" $ + let entry = + NAR.NarDirectory + [ ("bin", NAR.NarDirectory [("hello", NAR.NarRegular True (BS.pack [42]))]), + ("lib", NAR.NarSymlink "../lib64") + ] + serialised = NAR.serialise entry + in assertRight "roundtrip nested" entry (NAR.deserialise serialised), + test "directory entries sorted" $ + let entry = + NAR.NarDirectory + [ ("zebra", NAR.NarRegular False BS.empty), + ("alpha", NAR.NarRegular False BS.empty) + ] + serialised = NAR.serialise entry + in case NAR.deserialise serialised of + Left err -> do + putStrLn (" deserialise failed: " ++ err) + pure False + Right (NAR.NarDirectory entries) -> + assertEqual "sorted" ["alpha", "zebra"] (map fst entries) + Right other -> do + putStrLn (" expected directory, got: " ++ show other) + pure False, + test "narHash deterministic" $ + let entry = NAR.NarRegular False (BS.pack [1, 2, 3]) + h1 = NAR.narHash entry + h2 = NAR.narHash entry + in assertEqual "deterministic hash" h1 h2, + test "narHash differs for different content" $ + let h1 = NAR.narHash (NAR.NarRegular False (BS.pack [1])) + 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])) + ] + +-- --------------------------------------------------------------------------- +-- NarInfo tests +-- --------------------------------------------------------------------------- + +sampleNarInfoText :: Text +sampleNarInfoText = + T.unlines + [ "StorePath: /nix/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-hello-1.0", + "URL: nar/1234abcd.nar.xz", + "Compression: xz", + "FileHash: sha256:abcdef1234567890", + "FileSize: 12345", + "NarHash: sha256:fedcba0987654321", + "NarSize: 67890", + "References: aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-hello-1.0 bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb-glibc-2.38", + "Deriver: cccccccccccccccccccccccccccccccc-hello-1.0.drv", + "System: x86_64-linux", + "Sig: cache.example.com:c2lnbmF0dXJl", + "Sig: backup.example.com:YW5vdGhlcnNpZw==" + ] + +testNarInfo :: IO Bool +testNarInfo = + runGroup + "NarInfo" + [ test "parse sample narinfo" $ + case NarInfo.parseNarInfo sampleNarInfoText of + Left err -> do + putStrLn (" parse failed: " ++ err) + pure False + Right ni -> do + 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) + 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) + ok8 <- assertEqual "system" (Just "x86_64-linux") (NarInfo.niSystem ni) + ok9 <- assertEqual "sigs count" 2 (length (NarInfo.niSigs ni)) + pure (ok1 && ok2 && ok3 && ok4 && ok5 && ok6 && ok7 && ok8 && ok9), + test "parse/render roundtrip" $ + case NarInfo.parseNarInfo sampleNarInfoText of + Left err -> do + putStrLn (" parse failed: " ++ err) + pure False + Right ni -> + let rendered = NarInfo.renderNarInfo ni + in case NarInfo.parseNarInfo rendered of + Left err -> do + putStrLn (" re-parse failed: " ++ err) + pure False + Right reparsed -> + assertEqual "roundtrip" ni reparsed, + test "parse minimal narinfo (no optional fields)" $ + let minimal = + T.unlines + [ "StorePath: /nix/store/aaaa-test", + "URL: nar/test.nar.xz", + "Compression: xz", + "FileHash: sha256:abc", + "FileSize: 100", + "NarHash: sha256:def", + "NarSize: 200", + "References: " + ] + in case NarInfo.parseNarInfo minimal of + Left err -> do + putStrLn (" parse failed: " ++ err) + pure False + Right ni -> do + ok1 <- assertEqual "deriver" Nothing (NarInfo.niDeriver ni) + ok2 <- assertEqual "system" Nothing (NarInfo.niSystem ni) + ok3 <- assertEqual "sigs" [] (NarInfo.niSigs ni) + ok4 <- assertEqual "ca" Nothing (NarInfo.niCA ni) + ok5 <- assertEqual "refs" [] (NarInfo.niReferences ni) + pure (ok1 && ok2 && ok3 && ok4 && ok5), + 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), + test "parse bad integer fails" $ + let bad = + T.unlines + [ "StorePath: /nix/store/aaaa-test", + "URL: nar/test.nar.xz", + "Compression: xz", + "FileHash: sha256:abc", + "FileSize: not-a-number", + "NarHash: sha256:def", + "NarSize: 200", + "References: " + ] + in assertLeft "bad integer" (NarInfo.parseNarInfo bad) + ] + +-- --------------------------------------------------------------------------- +-- Signing tests +-- --------------------------------------------------------------------------- + +testSigning :: IO Bool +testSigning = + runGroup + "Signing" + [ test "fingerprint format" $ + let ni = mkTestNarInfo + fp = Signing.fingerprint ni + in do + ok1 <- assertTrue "starts with 1;" (T.isPrefixOf "1;" fp) + ok2 <- assertTrue "contains storePath" (T.isInfixOf "/nix/store/" fp) + pure (ok1 && ok2), + test "parseSecretKey valid" $ + let keyBytes = BS.pack ([1 .. 32] ++ [33 .. 64]) + keyB64 = TE.decodeUtf8 (B64.encode keyBytes) + keyStr = "test-key:" <> keyB64 + in case Signing.parseSecretKey keyStr of + Left err -> do + putStrLn (" parse failed: " ++ err) + pure False + Right sk -> + assertEqual "key name" "test-key" (Signing.skName sk), + test "parsePublicKey valid" $ + let keyBytes = BS.pack [1 .. 32] + keyB64 = TE.decodeUtf8 (B64.encode keyBytes) + keyStr = "test-key:" <> keyB64 + in case Signing.parsePublicKey keyStr of + Left err -> do + putStrLn (" parse failed: " ++ err) + pure False + Right pk -> + assertEqual "key name" "test-key" (Signing.pkName pk), + test "parseSecretKey no colon fails" $ + assertLeft "no colon" (Signing.parseSecretKey "nokeyname"), + test "parsePublicKey wrong size fails" $ + let keyStr = "test-key:" <> TE.decodeUtf8 (B64.encode (BS.pack [1 .. 16])) + in assertLeft "wrong size" (Signing.parsePublicKey keyStr), + test "sign/verify roundtrip" $ do + sk <- generateTestSecretKey + let pk = deriveTestPublicKey sk + ni = mkTestNarInfo + case Signing.sign sk ni of + Left err -> do + putStrLn (" sign failed: " ++ err) + pure False + Right sig -> + assertTrue "verify passes" (Signing.verify pk ni sig), + test "verify rejects tampered narinfo" $ do + sk <- generateTestSecretKey + let pk = deriveTestPublicKey sk + ni = mkTestNarInfo + case Signing.sign sk ni of + Left err -> do + putStrLn (" sign failed: " ++ err) + pure False + Right sig -> + let tampered = ni {NarInfo.niNarSize = 999999} + in assertFalse "verify rejects tampered" (Signing.verify pk tampered sig) + ] + +-- | Create a test NarInfo for signing tests. +mkTestNarInfo :: NarInfo.NarInfo +mkTestNarInfo = + NarInfo.NarInfo + { 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.niNarHash = "sha256:def", + NarInfo.niNarSize = 200, + NarInfo.niReferences = ["aaaa-hello-1.0"], + NarInfo.niDeriver = Nothing, + NarInfo.niSystem = Nothing, + NarInfo.niSigs = [], + NarInfo.niCA = Nothing + } + +-- --------------------------------------------------------------------------- +-- Compression tests +-- --------------------------------------------------------------------------- + +testCompression :: IO Bool +testCompression = + runGroup + "Compression" + [ test "compress/decompress roundtrip" $ + let input = BS.pack [72, 101, 108, 108, 111, 32, 87, 111, 114, 108, 100] + compressed = Compression.compressXz input + decompressed = Compression.decompressXz compressed + in assertEqual "roundtrip" input decompressed, + test "compress/decompress roundtrip (empty)" $ + let compressed = Compression.compressXz BS.empty + decompressed = Compression.decompressXz compressed + in assertEqual "roundtrip empty" BS.empty decompressed, + 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) + ] + +-- --------------------------------------------------------------------------- +-- FileStore tests +-- --------------------------------------------------------------------------- + +testFileStore :: IO Bool +testFileStore = + runGroup + "FileStore" + [ test "narinfo write/read roundtrip" $ do + tmpDir <- createTestDir + store <- Store.newFileStore tmpDir + let hashKey = "testhash123" + content = TE.encodeUtf8 ("StorePath: /nix/store/test\n" :: Text) + Store.writeNarInfo store hashKey content + result <- Store.readNarInfo store hashKey + removeDirectoryRecursive tmpDir + assertEqual "narinfo roundtrip" (Just content) result, + test "nar write/read roundtrip" $ do + tmpDir <- createTestDir + store <- Store.newFileStore tmpDir + let fileName = "test.nar.xz" + content = BS.pack [1, 2, 3, 4, 5] + Store.writeNar store fileName content + result <- Store.readNar store fileName + removeDirectoryRecursive tmpDir + assertEqual "nar roundtrip" (Just content) result, + test "read nonexistent returns Nothing" $ do + tmpDir <- createTestDir + store <- Store.newFileStore tmpDir + result <- Store.readNarInfo store "nonexistent" + removeDirectoryRecursive tmpDir + assertEqual "not found" Nothing result, + test "cacheInfo defaults" $ do + tmpDir <- createTestDir + store <- Store.newFileStore tmpDir + let (storeDir, wantMass, priority) = Store.getCacheInfo store + removeDirectoryRecursive tmpDir + ok1 <- assertEqual "storeDir" "/nix/store" storeDir + ok2 <- assertTrue "wantMassQuery" wantMass + ok3 <- assertEqual "priority" 30 priority + pure (ok1 && ok2 && ok3), + test "sanitizePath rejects traversal" $ + assertEqual "dotdot" Nothing (Store.sanitizePath ".."), + test "sanitizePath rejects slash" $ + assertEqual "slash" Nothing (Store.sanitizePath "../../etc/passwd"), + test "sanitizePath rejects backslash" $ + assertEqual "backslash" Nothing (Store.sanitizePath "..\\..\\etc\\passwd"), + test "sanitizePath rejects empty" $ + assertEqual "empty" Nothing (Store.sanitizePath ""), + test "sanitizePath accepts valid hash" $ + assertEqual "valid" (Just "abc123def456") (Store.sanitizePath "abc123def456"), + test "read rejects traversal" $ do + tmpDir <- createTestDir + store <- Store.newFileStore tmpDir + result <- Store.readNarInfo store "../../etc/passwd" + removeDirectoryRecursive tmpDir + assertEqual "blocked" Nothing result + ] + +-- --------------------------------------------------------------------------- +-- Helpers +-- --------------------------------------------------------------------------- + +-- | Create a temporary test directory. +createTestDir :: IO FilePath +createTestDir = do + let dir = "/tmp/nova-cache-test" + createDirectoryIfMissing True dir + pure dir + +-- | Generate a test Ed25519 secret key using crypton. +generateTestSecretKey :: IO Signing.SecretKey +generateTestSecretKey = do + sk <- Ed25519.generateSecretKey + let pk = Ed25519.toPublic sk + skBytes = convert sk <> (convert pk :: ByteString) + pure + Signing.SecretKey + { Signing.skName = "test-key", + Signing.skBytes = skBytes + } + +-- | Derive the public key from a test secret key. +deriveTestPublicKey :: Signing.SecretKey -> Signing.PublicKey +deriveTestPublicKey sk = + Signing.PublicKey + { Signing.pkName = Signing.skName sk, + Signing.pkBytes = BS.drop 32 (Signing.skBytes sk) + }