nova-cache 0.10.0.0 → 0.11.0.0
raw patch · 15 files changed
+1637/−230 lines, 15 filesdep +bzip2-clibPVP ok
version bump matches the API change (PVP)
Dependencies added: bzip2-clib
API changes (from Hackage documentation)
+ NovaCache.NAR: isWindowsHazardName :: ByteString -> Bool
+ NovaCache.NAR.Stream: isWindowsHazardName :: ByteString -> Bool
Files
- CHANGELOG.md +12/−0
- README.md +6/−4
- cbits/nova_bzip2.c +63/−0
- cbits/nova_bzip2.h +19/−0
- nova-cache.cabal +48/−4
- src/NovaCache/Bzip2.hs +399/−0
- src/NovaCache/NAR.hs +18/−11
- src/NovaCache/NAR/Stream.hs +52/−28
- src/NovaCache/SafeName.hs +8/−7
- src/NovaCache/Xz.hs +115/−30
- src/NovaCache/Zstd.hs +327/−98
- test/Bzip2Test.hs +243/−0
- test/Main.hs +52/−22
- test/XzTest.hs +68/−9
- test/ZstdTest.hs +207/−17
CHANGELOG.md view
@@ -1,5 +1,17 @@ # Changelog +## 0.11.0.0 - 2026-08-21++- **A failed `withXzSource` or `withZstdSource` pull latches any exception, matching `NovaCache.Bzip2`.** Both sources held only their own decoder errors (`XzError`, `ZstdError`) for replay on later pulls; an exception thrown by the compressed source itself - an HTTP failure, a capped body source refusing to read on - left the state untouched, so a consumer that caught the failure and pulled again at exactly a stream or frame boundary of a concatenated payload could read the empty chunk, the clean-end signal, and take a prefix for complete output. Any exception escaping a pull now marks the transfer unfinishable and is rethrown on every later pull, the breadth `NovaCache.Bzip2` shipped with.+- **Bounded bzip2: the new `NovaCache.Bzip2`, a public `nova-cache:bzip2` sublibrary.** Historical cache.nixos.org narinfos declare `Compression: bzip2`, and upstream C++ Nix reads an absent `Compression` field as bzip2, so substituting those paths needs the codec. `decompress` takes the narinfo's declared NarSize as its inclusive output bound and fails past it, and `withBzip2Source` decompresses a chunk source into a chunk source under the same limits - the xz discipline, ported. There is no decoder-memory knob because bzip2 carries no attacker-chosen dictionary size: decoding allocates a fixed small amount (about 4 MiB at the format's largest block size), a constant of the format rather than a parameter. Concatenated streams decode as one output, matching upstream's bzip2 decompression sink, which re-initializes the decoder at stream end while input remains; trailing bytes that do not start a valid stream are refused, and truncated input is refused. A failed pull from the streaming source stays failed: later pulls rethrow the failure instead of reading as a clean end, so a consumer that catches and retries cannot mistake a failed transfer for complete output. No existing binding bundles libbz2's C sources on every platform (`bzlib` links the system library outside Windows), so the module drives libbz2 directly over `bzip2-clib`, which is nothing but the bundled sources - no system library anywhere.+- **The publish workflow gates on a dated changelog and survives its own docs half failing.** v0.9.0.0 reached Hackage with its changelog section still headed "## Unreleased" (the dating commit landed after the tag), and the docs build then failed after the sdist was live, so the re-run died on Hackage's duplicate-version 400 and the release stayed docless; a Hackage tarball is immutable, so both scars are permanent. The workflow now refuses to upload anything until the changelog's top section is exactly the tagged version with its date, and an already-published sdist is skipped instead of fatal, so a failed docs upload can be re-run to completion.+- **The docs re-upload workflow handles every shipped release, not only 0.10-and-later trees.** Its purpose is re-uploading documentation for versions that predate it, yet it hardcoded the current tree's shape: on v0.8.0.0 the haddock run missed the then-flag-gated xz module, the sublibrary graft loop died on an unmatched glob, and the fixed verification greps failed, while on v0.9.0.0 the zstandard grep failed. The graft now skips when the tag built no sublibraries, verification checks module HTML for exactly the sublibraries actually grafted, and the xz flag is enabled only where the tag's cabal declares it.+- **The NAR parser accepts upstream's grammar; Windows-hazard names move to the new `isWindowsHazardName`.** The streaming parser rejected, on every platform, Windows reserved device stems (`aux.c`, `con.h`), names ending in a dot or space, and names containing a colon or backslash. Upstream's C++ restore accepts all of these on Unix, and real cache.nixos.org archives carry them (perl man pages named `ExtUtils::MakeMaker.3`, kernel trees carrying `aux.c`), so substitution failed where upstream succeeds - and `serialise` emitted hazard names that `deserialise` (the same machine, whole-input) refused, so a tree readable from disk did not round-trip through its own NAR. `checkEntryName` now enforces exactly upstream's grammar (no empty name, `.`, `..`, `/`, or NUL, and strict entry order), and the Windows categories live in `isWindowsHazardName` (exported from `NovaCache.NAR.Stream` and re-exported from `NovaCache.NAR`) for store writers to apply at materialization when the target filesystem needs it.+- **`narStreamBounded` clamps its bound with alignment headroom.** The bound was clamped to `maxBound :: Int`, but the parser demands a declared length plus its padding in `Int`, so a declared length near the ceiling wrapped that demand negative and a huge structural string "parsed" instantly as empty at an unmoved position. The clamp now sits `narAlignment - 1` below `Int`'s ceiling, so such an archive fails the parse as upstream would at end of input.+- **`withNarSource` no longer leaks a handle when sizing a planned file fails.** If `hFileSize` threw after a successful open (the path swapped for a FIFO between plan and pull), the handle was not yet recorded in the source state and nothing ever closed it. The open and the state hand-off now transfer ownership atomically under `bracketOnError`.+- **`NovaCache.Zstd` owns its decoder lifecycle: the codec now drives `ZSTD_decompressStream` through the binding's FFI module instead of its high-level streaming driver.** The driver freed decompression contexts only at GC finalization and hid the stream's end state, and four defects traced back to that one root. The context's window buffer (sized by the incoming frame header, i.e. by the peer, up to libzstd's 128 MiB default ceiling) is now created and freed in a bracket, released deterministically on every exit: success, bound violation, corrupt frame, or an exception in the consumer. End of input is now judged by the library's own frame-boundary signal, so a frame cut off mid-way and trailing bytes after the last frame (one to four of which the old path silently accepted) both refuse with `ZstdStreamError`, restoring the complete-stream contract `NovaCache.Xz` already had; the truncation-tolerance divergence documented in 0.10.0.0 is gone. A pull after a failure now rethrows the error instead of reporting a phantom clean end of stream. Concatenated frames still decode as one output, and the inclusive NarSize bound is unchanged. Breaking: `compress` now takes a `ZstdCompressionLevel` (smart constructor `zstdCompressionLevel`, validated against the re-exported `maxCompressionLevel`) instead of a raw `Int`, because the binding's compressor calls `error` on an out-of-range level under `unsafePerformIO`; `defaultCompressionLevel` is a value of the new type, so callers passing it (nova-nix's push) only re-typecheck.+- **A failed `withXzSource` pull stays failed, and terminal decoder statuses read as diagnoses.** Every failure path in the streaming pull used to mark the source drained before throwing, and a drained source returns the empty chunk - the clean end-of-output signal - so a consumer that caught the error and pulled again saw truncated output presented as complete; the source now holds the `XzError` and every later pull re-throws it. Separately, unmapped liblzma statuses were shown raw, so a zero-byte input failed with the message `LzmaRetOK` (which reads as success) and a truncated one with `LzmaRetBufError`; the terminal statuses now map to real diagnoses, and the truncated-or-empty-input message is exported as `truncatedInputMessage` so consumers can match the condition. The inclusive output-bound decision is now one shared function under both the pure and streaming paths, with the streaming path tested at exactly the bound, since a narinfo's NarSize is exact. Teardown of a live decoder remains GC-dependent - the `lzma-static` binding exposes no live-stream teardown - and is documented in place with its undo condition.+ ## 0.10.0.0 - 2026-08-20 - **Bounded zstd: the new `NovaCache.Zstd`, a public `nova-cache:zstandard` sublibrary.** The modern caches (Cachix, attic, FlakeHub) serve NARs zstd-compressed, and a cache of our own wants the same: near-xz ratio on binaries with decompression an order of magnitude faster, cheap enough to compress at push time (`compress`, frame content size recorded; `defaultCompressionLevel` is libzstd's own 3). `decompress` takes the narinfo's declared NarSize as its output bound and fails past it, and `withZstdSource` decompresses a chunk source into a chunk source under the same limits, pairing with streaming NAR consumption - the xz discipline, ported. Two deliberate divergences from `NovaCache.Xz`, documented in place: decoder-state memory is capped by libzstd's default window limit (128 MiB; the binding exposes no tunable), and a truncated input yields truncated output at this layer - the signed NarSize and NarHash checks above are the arbiter of completeness. Concatenated frames decode as one output, as upstream's sink accepts. The `zstd` dependency bundles libzstd's C sources; no system library on any platform. (`zstandard`, not `zstd`: an in-package component name shadows the like-named dependency, so a sublibrary called `zstd` could never depend on the `zstd` binding.)
README.md view
@@ -1,7 +1,7 @@ <div align="center"> <h1>nova-cache</h1> <p><strong>The Nix binary cache protocol, in Haskell.</strong></p>-<p>nix-base32, NAR archives (strict and streaming), narinfo, store paths, Ed25519 signing, and bounded xz decompression - with an optional WAI cache server. A pure core; IO is confined to the storage and server boundaries.</p>+<p>nix-base32, NAR archives (strict and streaming), narinfo, store paths, Ed25519 signing, and bounded xz, zstd, and bzip2 codecs as the public nova-cache:xz, nova-cache:zstandard, and nova-cache:bzip2 sublibraries (decompression bounded, zstd compression for the push direction) - with an optional WAI cache server. A pure core; IO is confined to the storage and server boundaries.</p> [](https://github.com/Novavero-AI/nova-cache/actions/workflows/ci.yml) [](https://hackage.haskell.org/package/nova-cache)@@ -54,8 +54,10 @@ -- Stream a tree's NAR and hash it in one pass; the archive never -- exists in memory. The parsing side is NovaCache.NAR.Stream, a--- chunk-fed event machine, and the nova-cache:xz sublibrary adds--- decompression bounded by a narinfo's declared NarSize.+-- chunk-fed event machine; the nova-cache:xz, nova-cache:zstandard,+-- and nova-cache:bzip2 sublibraries add decompression bounded by a+-- narinfo's declared NarSize, and the zstd side also compresses for+-- the push direction. narHash <- withNarSource defaultCaseHack path $ \pull -> let go ctx = do chunk <- pull@@ -116,7 +118,7 @@ cabal test ``` -Optional extras: `--flag server` builds the cache server, and the public `nova-cache:xz` and `nova-cache:zstandard` sublibraries carry the bounded codecs (liblzma and libzstd are bundled - no system libraries needed) - consumers depend on them with `build-depends: nova-cache:xz` and the like. Requires GHC 9.14+ and cabal-install 3.10+.+Optional extras: `--flag server` builds the cache server, and the public `nova-cache:xz`, `nova-cache:bzip2`, and `nova-cache:zstandard` sublibraries carry the bounded codecs (liblzma, libbz2, and libzstd are bundled - no system libraries needed) - consumers depend on them with `build-depends: nova-cache:xz` and the like. Requires GHC 9.14+ and cabal-install 3.10+. ---
+ cbits/nova_bzip2.c view
@@ -0,0 +1,63 @@+#include "nova_bzip2.h"++#include <stdlib.h>++/* calloc so every field starts zeroed: libbz2 reads NULL allocator+ hooks as "use malloc/free", and a NULL state field makes the+ destroy below safe on a stream that was never initialized. */+bz_stream *nova_bzip2_stream_new(void)+{+ return (bz_stream *) calloc(1, sizeof(bz_stream));+}++/* ForeignPtr finalizer. BZ2_bzDecompressEnd on an uninitialized or+ already-ended stream is a harmless BZ_PARAM_ERROR, so this is safe+ in every decoder state; a NULL strm (failed calloc) is a no-op. */+void nova_bzip2_stream_destroy(bz_stream *strm)+{+ if (strm != NULL) {+ (void) BZ2_bzDecompressEnd(strm);+ free(strm);+ }+}++/* verbosity 0 and small 0 (the fast algorithm), the arguments+ upstream Nix's decompression sink passes. BZ2_bzDecompressInit+ itself rejects a NULL strm with BZ_PARAM_ERROR, so a failed calloc+ surfaces as a status, not a crash. */+int nova_bzip2_decompress_init(bz_stream *strm)+{+ return BZ2_bzDecompressInit(strm, 0, 0);+}++/* Between concatenated streams: tear down and start fresh on the+ same struct, as upstream's decompression sink does at stream end+ while input remains. */+int nova_bzip2_decompress_reinit(bz_stream *strm)+{+ int ret = BZ2_bzDecompressEnd(strm);+ if (ret != BZ_OK) {+ return ret;+ }+ return BZ2_bzDecompressInit(strm, 0, 0);+}++/* One BZ2_bzDecompress call: feed input, fill output, report both+ counts. libbz2 only reads through next_in, but the field is not+ const-qualified, so the parameter is plain char *. */+int nova_bzip2_decompress_step(bz_stream *strm,+ char *input, unsigned int input_len,+ char *output, unsigned int output_len,+ unsigned int *consumed,+ unsigned int *produced)+{+ int ret;+ strm->next_in = input;+ strm->avail_in = input_len;+ strm->next_out = output;+ strm->avail_out = output_len;+ ret = BZ2_bzDecompress(strm);+ *consumed = input_len - strm->avail_in;+ *produced = output_len - strm->avail_out;+ return ret;+}
+ cbits/nova_bzip2.h view
@@ -0,0 +1,19 @@+/* Shim over libbz2 for NovaCache.Bzip2. The bz_stream struct stays+ on the C side, where the compiler knows its layout, so the Haskell+ binding carries no struct offsets to drift across platforms. */+#ifndef NOVA_BZIP2_H+#define NOVA_BZIP2_H++#include <bzlib.h>++bz_stream *nova_bzip2_stream_new(void);+void nova_bzip2_stream_destroy(bz_stream *strm);+int nova_bzip2_decompress_init(bz_stream *strm);+int nova_bzip2_decompress_reinit(bz_stream *strm);+int nova_bzip2_decompress_step(bz_stream *strm,+ char *input, unsigned int input_len,+ char *output, unsigned int output_len,+ unsigned int *consumed,+ unsigned int *produced);++#endif
nova-cache.cabal view
@@ -1,14 +1,14 @@ cabal-version: 3.0 name: nova-cache-version: 0.10.0.0+version: 0.11.0.0 synopsis: Pure-first Nix binary cache protocol library description: A pure-first library implementing the Nix binary cache protocol - nix-base32, NAR serialization (whole-tree and streaming), narinfo parsing, Ed25519 signing, store path handling, and content- validation - with an optional WAI server, and bounded xz and zstd- codecs as the public @nova-cache:xz@ and @nova-cache:zstandard@- sublibraries.+ validation - with an optional WAI server, and bounded xz, bzip2,+ and zstd codecs as the public @nova-cache:xz@, @nova-cache:bzip2@,+ and @nova-cache:zstandard@ sublibraries. license: Apache-2.0 license-file: LICENSE@@ -25,6 +25,8 @@ CHANGELOG.md NOTICE README.md+extra-source-files:+ cbits/nova_bzip2.h flag server description: Build the cache server executable (pulls in warp and wai-extra)@@ -97,6 +99,34 @@ , bytestring >= 0.11 && < 0.13 , lzma-static >= 5.2.5 && < 5.3 +-- The bounded bzip2 decoder, the same solver-visible opt-in as xz.+-- Historical cache.nixos.org narinfos declare Compression: bzip2, and+-- upstream reads an absent Compression field as bzip2, so substituting+-- old paths needs the codec. No existing binding bundles libbz2's C+-- sources on every platform (bzlib links the system library outside+-- Windows), so the module drives libbz2 directly over bzip2-clib -+-- nothing but the bundled sources - through the cbits shim.+library bzip2+ visibility: public+ exposed-modules: NovaCache.Bzip2+ hs-source-dirs: src+ c-sources: cbits/nova_bzip2.c+ include-dirs: cbits+ default-language: Haskell2010+ default-extensions:+ BangPatterns+ OverloadedStrings+ ghc-options:+ -Wall+ -Wcompat+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns++ build-depends:+ base >= 4.22 && < 5+ , bytestring >= 0.11 && < 0.13+ , bzip2-clib >= 1.0.8 && < 1.1+ -- The bounded zstd codec, the same solver-visible opt-in as xz. -- Named zstandard, not zstd: an in-package component name shadows the -- like-named external package in every build-depends of this package,@@ -180,6 +210,20 @@ base >= 4.22 && < 5 , bytestring >= 0.11 && < 0.13 , nova-cache:xz++test-suite nova-cache-bzip2-test+ type: exitcode-stdio-1.0+ main-is: Bzip2Test.hs+ hs-source-dirs: test+ default-language: Haskell2010+ default-extensions:+ OverloadedStrings+ ghc-options: -Wall -Wcompat++ build-depends:+ base >= 4.22 && < 5+ , bytestring >= 0.11 && < 0.13+ , nova-cache:bzip2 test-suite nova-cache-zstd-test type: exitcode-stdio-1.0
+ src/NovaCache/Bzip2.hs view
@@ -0,0 +1,399 @@+-- EmptyDataDecls for the opaque 'BzStream' tag alone: the C struct+-- has no Haskell values, and a placeholder constructor would be+-- unused by construction (which -Werror rightly refuses).+{-# LANGUAGE EmptyDataDecls #-}++-- | Bounded bzip2 decompression for untrusted cache data.+--+-- Historical cache.nixos.org narinfos declare @Compression: bzip2@,+-- and upstream C++ Nix reads an absent @Compression@ field as bzip2+-- (nova-cache's narinfo parser defaults the same way), so+-- substituting those paths needs this decoder. Substitution+-- decompresses bytes that arrive from the network BEFORE any hash+-- can vouch for them, so the decoder must not be steerable into+-- unbounded allocation. The consumer knows the narinfo's declared+-- NarSize before decompressing: decompression takes that bound and+-- fails past it ('bzip2MaxOutputBytes').+--+-- There is no decoder-memory knob like the xz codec's+-- @xzMaxDecoderMemoryBytes@: bzip2 carries no attacker-chosen+-- dictionary size, and decoding allocates a fixed small amount -+-- about 4 MiB at the format's largest block size (900k) - so decoder+-- memory is a constant of the format, not a parameter.+--+-- Concatenated streams decode as one output: upstream's bzip2+-- decompression sink re-initializes the decoder at stream end while+-- input remains, and this module does the same. Trailing bytes that+-- do not start a valid stream are refused, as is truncated input.+--+-- Everything here is IO: the decoder is libbz2, driven over the FFI.+-- The binding goes directly over @bzip2-clib@ (nothing but the+-- bundled C sources) because no existing binding bundles them on+-- every platform - @bzlib@ links the system library outside Windows+-- - and the codec sublibraries promise no system library anywhere.+--+-- This module lives in the public @nova-cache:bzip2@ sublibrary, the+-- same solver-visible opt-in as @nova-cache:xz@: consumers that+-- substitute bzip2 paths depend on it; everyone else never builds+-- the bundled libbz2.+module NovaCache.Bzip2+ ( Bzip2Limits (..),+ Bzip2Error (..),+ decompress,+ withBzip2Source,+ )+where++import Control.Exception (Exception, SomeException, throwIO, toException, try)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Data.Maybe (fromMaybe)+import Data.Word (Word64)+import Foreign.C.Types (CChar, CInt (..), CUInt (..))+import Foreign.ForeignPtr (FinalizerPtr, ForeignPtr, newForeignPtr, withForeignPtr)+import Foreign.Marshal.Alloc (alloca, allocaBytes)+import Foreign.Ptr (Ptr)+import Foreign.Storable (peek)++-- ---------------------------------------------------------------------------+-- Limits+-- ---------------------------------------------------------------------------++-- | What a decode run may cost. The bound is inclusive: output of+-- exactly 'bzip2MaxOutputBytes' passes, one byte more fails - a+-- narinfo's NarSize is exact, so the declared size itself must be+-- reachable. Decoder-state memory is a small format constant (see+-- the module header), not a field here.+newtype Bzip2Limits = Bzip2Limits+ { -- | Maximum decompressed output, in bytes: the narinfo's declared+ -- NarSize.+ bzip2MaxOutputBytes :: Word64+ }+ deriving (Eq, Show)++-- ---------------------------------------------------------------------------+-- Errors+-- ---------------------------------------------------------------------------++-- | Everything a bounded decode can refuse. 'decompress' returns+-- these in 'Left'; the pull source behind 'withBzip2Source' throws+-- them (see the 'Exception' instance).+data Bzip2Error+ = -- | The compressed stream is malformed, truncated, or carries+ -- trailing bytes that do not start a valid stream (libbz2's+ -- status, rendered).+ Bzip2StreamError !String+ | -- | Decompressed output would exceed the bound (carried here).+ Bzip2OutputOverBound !Word64+ deriving (Eq, Show)++-- | Thrown by the pull source 'withBzip2Source' hands its+-- continuation; a chunk convention has no error channel, and a+-- throwing pull composes with consumers built around one.+instance Exception Bzip2Error++-- ---------------------------------------------------------------------------+-- Bounded decode+-- ---------------------------------------------------------------------------++-- | Decompress one bzip2 payload under the given limits. Output+-- stops accumulating the moment it would pass the bound, so a+-- high-expansion input costs at most the bound plus one decoder+-- buffer, never what it claims to hold.+decompress :: Bzip2Limits -> ByteString -> IO (Either Bzip2Error ByteString)+decompress limits input = do+ opened <- newDecoder+ case opened of+ Left err -> pure (Left err)+ Right decoder -> do+ -- The IORef makes the whole input a one-shot chunk source+ -- (input, then the empty end marker), so the strict path+ -- drives the same engine as the streaming one.+ remainingRef <- newIORef input+ let source = do+ held <- readIORef remainingRef+ writeIORef remainingRef BS.empty+ pure held+ collect source decoder []+ where+ collect source decoder acc = do+ outcome <- nextDecodedChunk limits source decoder+ case outcome of+ Left err -> pure (Left err)+ Right Nothing -> pure (Right (BS.concat (reverse acc)))+ Right (Just (chunk, next)) -> collect source next (chunk : acc)++-- ---------------------------------------------------------------------------+-- Streaming bounded decode+-- ---------------------------------------------------------------------------++-- | What the pull source is doing between calls. The 'IORef'+-- holding this is a deliberate, documented mutable boundary, the+-- same as the xz and zstd sources. A failure is a state of its own:+-- once a pull has thrown, every later pull rethrows - never the+-- empty chunk, which would let a consumer that catches and retries+-- mistake a failed transfer for complete output.+data Bzip2SourceState+ = Bzip2Streaming !Decoder+ | Bzip2Drained+ | Bzip2Failed !SomeException++-- | Decompress a chunk source into a chunk source, under the+-- limits. The continuation's pull yields decompressed chunks; the+-- empty chunk means end of output and repeats on further pulls.+-- The compressed source follows the same convention on its side.+-- Pairs with the incremental NAR parser and hashing, so a+-- substituter can fetch, decompress, hash, and unpack in one+-- bounded pass.+--+-- Limit violations and malformed input are thrown as 'Bzip2Error'+-- from the pull. A pull that fails latches: every later pull+-- rethrows the same exception, so a catch-and-retry consumer can+-- never mistake an aborted transfer for a clean end of output.+withBzip2Source :: Bzip2Limits -> IO ByteString -> (IO ByteString -> IO a) -> IO a+withBzip2Source limits compressedSource consume = do+ opened <- newDecoder+ stateRef <- newIORef (either (Bzip2Failed . toException) Bzip2Streaming opened)+ consume (pullDecompressed limits compressedSource stateRef)++-- | Produce the next decompressed chunk.+pullDecompressed :: Bzip2Limits -> IO ByteString -> IORef Bzip2SourceState -> IO ByteString+pullDecompressed limits compressedSource stateRef = advance =<< readIORef stateRef+ where+ advance state = case state of+ Bzip2Drained -> pure BS.empty+ Bzip2Failed failure -> throwIO failure+ Bzip2Streaming decoder -> do+ outcome <- tryPull (nextDecodedChunk limits compressedSource decoder)+ case outcome of+ Left failure -> do+ writeIORef stateRef (Bzip2Failed failure)+ throwIO failure+ Right (Left err) -> do+ writeIORef stateRef (Bzip2Failed (toException err))+ throwIO err+ Right (Right Nothing) -> do+ writeIORef stateRef Bzip2Drained+ pure BS.empty+ Right (Right (Just (chunk, next))) -> do+ writeIORef stateRef (Bzip2Streaming next)+ pure chunk++-- | 'try' at 'SomeException', monomorphic so the catch-all needs no+-- annotation at the call site. Any exception escaping a pull - the+-- compressed source failing included - leaves the transfer+-- unfinishable, and the only sound later answer is the same failure+-- again, so the caller latches whatever this catches.+tryPull ::+ IO (Either Bzip2Error (Maybe (ByteString, Decoder))) ->+ IO (Either SomeException (Either Bzip2Error (Maybe (ByteString, Decoder))))+tryPull = try++-- ---------------------------------------------------------------------------+-- Shared decoder engine+-- ---------------------------------------------------------------------------++-- | Decoder identity threaded between engine steps: the C stream,+-- input handed over but not yet consumed, output produced so far+-- (the bound's basis), and whether the decoder sits at a stream+-- boundary.+data Decoder = Decoder+ { decoderStream :: !(ForeignPtr BzStream),+ decoderLeftover :: !ByteString,+ decoderProduced :: !Word64,+ decoderPhase :: !DecoderPhase+ }++-- | 'AtStreamBoundary' means a stream just ended cleanly: end of+-- input here is a clean end of output, while more input means a+-- concatenated stream follows. Anywhere else, end of input is+-- truncation.+data DecoderPhase = MidStream | AtStreamBoundary++-- | A freshly initialized decoder. Failure here is libbz2 refusing+-- to initialize (or the allocation failing, which the shim folds+-- into the same status), rendered as a stream error.+newDecoder :: IO (Either Bzip2Error Decoder)+newDecoder = do+ rawStream <- cStreamNew+ stream <- newForeignPtr cStreamDestroy rawStream+ status <- withForeignPtr stream cDecompressInit+ pure $+ if status == statusOk+ then+ Right+ Decoder+ { decoderStream = stream,+ decoderLeftover = BS.empty,+ decoderProduced = 0,+ decoderPhase = MidStream+ }+ else Left (Bzip2StreamError (renderStatus status))++-- | Advance the decoder to its next decompressed chunk: 'Nothing'+-- is the clean end of output, 'Just' carries a nonempty chunk and+-- the decoder to continue from. Both 'decompress' and+-- 'withBzip2Source' drive this engine, so the bound arithmetic and+-- the stream-boundary rules exist once.+nextDecodedChunk ::+ Bzip2Limits ->+ IO ByteString ->+ Decoder ->+ IO (Either Bzip2Error (Maybe (ByteString, Decoder)))+nextDecodedChunk limits compressedSource = advance+ where+ advance decoder = case decoderPhase decoder of+ AtStreamBoundary+ | BS.null (decoderLeftover decoder) -> do+ chunk <- compressedSource+ if BS.null chunk+ then pure (Right Nothing)+ else reopen decoder {decoderLeftover = chunk}+ | otherwise -> reopen decoder+ MidStream+ | BS.null (decoderLeftover decoder) -> do+ chunk <- compressedSource+ if BS.null chunk+ then pure (Left (Bzip2StreamError truncatedInputMessage))+ else advance decoder {decoderLeftover = chunk}+ | otherwise -> decodeStep decoder++ -- Input after a clean stream end: re-initialize and decode it as+ -- the next concatenated stream. Garbage fails the re-initialized+ -- decoder's magic check, which is the trailing-garbage refusal.+ reopen decoder = do+ status <- withForeignPtr (decoderStream decoder) cDecompressReinit+ if status == statusOk+ then advance decoder {decoderPhase = MidStream}+ else pure (Left (Bzip2StreamError (renderStatus status)))++ decodeStep decoder = do+ (status, consumedCount, outChunk) <-+ runDecompressStep (decoderStream decoder) (decoderLeftover decoder)+ let remaining = BS.drop consumedCount (decoderLeftover decoder)+ finished = status == statusStreamEnd+ if status /= statusOk && not finished+ then pure (Left (Bzip2StreamError (renderStatus status)))+ else case growWithinBound limits (decoderProduced decoder) (BS.length outChunk) of+ Left err -> pure (Left err)+ Right grown ->+ let continued =+ decoder+ { decoderLeftover = remaining,+ decoderProduced = grown,+ decoderPhase = if finished then AtStreamBoundary else MidStream+ }+ in -- An empty step (input absorbed, nothing produced+ -- yet) must not surface as the end-of-output chunk.+ if BS.null outChunk+ then advance continued+ else pure (Right (Just (outChunk, continued)))++-- | The one place the output bound is enforced: the produced count+-- grown by a chunk, refused past the bound. Inclusive - reaching+-- the bound exactly passes, because a narinfo's NarSize is exact.+growWithinBound :: Bzip2Limits -> Word64 -> Int -> Either Bzip2Error Word64+growWithinBound limits produced chunkLength+ | grown > bound = Left (Bzip2OutputOverBound bound)+ | otherwise = Right grown+ where+ bound = bzip2MaxOutputBytes limits+ grown = produced + fromIntegral chunkLength++-- | One BZ2_bzDecompress call through the shim: feed at most+-- 'stepBufferBytes' of the input against a fresh output buffer, and+-- yield the status, the count of input bytes consumed, and the+-- bytes produced.+runDecompressStep :: ForeignPtr BzStream -> ByteString -> IO (CInt, Int, ByteString)+runDecompressStep stream input =+ withForeignPtr stream $ \streamPtr ->+ unsafeUseAsCStringLen (BS.take stepBufferBytes input) $ \(inputPtr, inputLength) ->+ allocaBytes stepBufferBytes $ \outputPtr ->+ alloca $ \consumedPtr ->+ alloca $ \producedPtr -> do+ status <-+ cDecompressStep+ streamPtr+ inputPtr+ (fromIntegral inputLength)+ outputPtr+ (fromIntegral stepBufferBytes)+ consumedPtr+ producedPtr+ consumedCount <- peek consumedPtr+ producedCount <- peek producedPtr+ outChunk <- BS.packCStringLen (outputPtr, fromIntegral producedCount)+ pure (status, fromIntegral consumedCount, outChunk)++-- | Per-step transfer size, for both the input fed across the FFI+-- and the output buffer: bounds one unsafe C call's work, and keeps+-- the lengths within CUInt on every platform however large a chunk+-- the source hands over.+stepBufferBytes :: Int+stepBufferBytes = 64 * 1024++truncatedInputMessage :: String+truncatedInputMessage = "input ends inside a bzip2 stream"++-- ---------------------------------------------------------------------------+-- FFI boundary+-- ---------------------------------------------------------------------------++-- | Opaque tag for libbz2's @bz_stream@; the struct lives behind+-- the shim and is never inspected from Haskell.+data BzStream++-- | libbz2's status names by return code, as bzlib.h declares them.+statusNames :: [(CInt, String)]+statusNames =+ [ (0, "BZ_OK"),+ (1, "BZ_RUN_OK"),+ (2, "BZ_FLUSH_OK"),+ (3, "BZ_FINISH_OK"),+ (4, "BZ_STREAM_END"),+ (-1, "BZ_SEQUENCE_ERROR"),+ (-2, "BZ_PARAM_ERROR"),+ (-3, "BZ_MEM_ERROR"),+ (-4, "BZ_DATA_ERROR"),+ (-5, "BZ_DATA_ERROR_MAGIC"),+ (-6, "BZ_IO_ERROR"),+ (-7, "BZ_UNEXPECTED_EOF"),+ (-8, "BZ_OUTBUFF_FULL"),+ (-9, "BZ_CONFIG_ERROR")+ ]++statusOk :: CInt+statusOk = 0++statusStreamEnd :: CInt+statusStreamEnd = 4++-- | Render a libbz2 status by its bzlib.h name.+renderStatus :: CInt -> String+renderStatus status =+ fromMaybe ("bzip2 status " <> show status) (lookup status statusNames)++foreign import ccall unsafe "nova_bzip2_stream_new"+ cStreamNew :: IO (Ptr BzStream)++foreign import ccall unsafe "&nova_bzip2_stream_destroy"+ cStreamDestroy :: FinalizerPtr BzStream++foreign import ccall unsafe "nova_bzip2_decompress_init"+ cDecompressInit :: Ptr BzStream -> IO CInt++foreign import ccall unsafe "nova_bzip2_decompress_reinit"+ cDecompressReinit :: Ptr BzStream -> IO CInt++foreign import ccall unsafe "nova_bzip2_decompress_step"+ cDecompressStep ::+ Ptr BzStream ->+ Ptr CChar ->+ CUInt ->+ Ptr CChar ->+ CUInt ->+ Ptr CUInt ->+ Ptr CUInt ->+ IO CInt
src/NovaCache/NAR.hs view
@@ -25,6 +25,7 @@ ( NarEntry (..), serialise, deserialise,+ isWindowsHazardName, narHash, serialiseFromPath, serialiseFromPathWith,@@ -35,7 +36,7 @@ ) where -import Control.Exception (finally)+import Control.Exception (bracketOnError, finally) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Builder as B@@ -48,6 +49,7 @@ import NovaCache.NAR.Stream ( NarEvent (..), NarStep (..),+ isWindowsHazardName, narPad, narPadOf, narStreamBounded,@@ -181,7 +183,7 @@ deserialise :: ByteString -> Either String NarEntry deserialise input = drive True (narStreamBounded (fromIntegral (BS.length input))) [] Nothing where- drive !firstFeed step stack root = case step of+ drive !firstFeed step !stack !root = case step of NarFail err -> Left err NarDone -> case (stack, root) of ([], Just entry) -> Right entry@@ -497,11 +499,16 @@ pure bytes advance (SourceSegments (SegmentFile path : rest)) = do shownPath <- decodeFS path- handle <- openBinaryFile shownPath ReadMode- size <- hFileSize handle- let owed = fromIntegral size :: Word64- writeIORef stateRef (SourceFile handle shownPath owed (narPadOf owed) rest)- pure (BL.toStrict (B.toLazyByteString (B.word64LE owed)))+ -- hFileSize can throw after a successful open (the path swapped+ -- for a FIFO between plan and pull); until the state ref records+ -- the handle, closeCurrent cannot see it, so ownership transfers+ -- under bracketOnError - the same discipline as the shrink path+ -- below.+ bracketOnError (openBinaryFile shownPath ReadMode) hClose $ \handle -> do+ size <- hFileSize handle+ let owed = fromIntegral size :: Word64+ writeIORef stateRef (SourceFile handle shownPath owed (narPadOf owed) rest)+ pure (BL.toStrict (B.toLazyByteString (B.word64LE owed))) advance (SourceFile handle _ 0 padLen rest) = do hClose handle writeIORef stateRef (SourceSegments rest)@@ -533,7 +540,7 @@ -- | Plan pieces before coalescing: structural builders, or a deferred -- regular file. data PlanPiece- = PieceBytes B.Builder+ = PieceBytes !B.Builder | PieceFile !OsPath -- | Merge adjacent structural runs and render each strict, so a pull@@ -542,9 +549,9 @@ coalesce :: [PlanPiece] -> [NarSegment] coalesce = go mempty where- go pending [] = flushOnto pending []- go pending (PieceBytes builder : rest) = go (pending <> builder) rest- go pending (PieceFile path : rest) =+ go !pending [] = flushOnto pending []+ go !pending (PieceBytes builder : rest) = go (pending <> builder) rest+ go !pending (PieceFile path : rest) = flushOnto pending (SegmentFile path : go mempty rest) flushOnto pending segments = let bytes = BL.toStrict (B.toLazyByteString pending)
src/NovaCache/NAR/Stream.hs view
@@ -25,6 +25,7 @@ -- * Entry-name safety checkEntryName,+ isWindowsHazardName, -- * Wire vocabulary (shared with the serialiser in "NovaCache.NAR") tokMagic,@@ -144,7 +145,12 @@ -- can go wrong is a 'NarFail'. data NarStep = NarAwait !(ByteString -> NarStep)- | NarYield !NarEvent NarStep+ | -- | The continuation is deliberately lazy: yielding is what hands+ -- control back to the consumer, and a strict field would force+ -- each step's successor at construction, materializing the whole+ -- fed chunk's event chain before the consumer acts on the first+ -- event. Do not add a bang.+ NarYield !NarEvent NarStep | NarDone | NarFail !String @@ -162,6 +168,13 @@ narStream :: NarStep narStream = narStreamBounded maxWireStringBytes +-- | The largest structural-string bound 'narStreamBounded' honors:+-- 'Int''s ceiling less alignment headroom, so a payload at the bound+-- still fits 'Int' together with its padding.+structuralBoundCeiling :: Word64+structuralBoundCeiling =+ fromIntegral (maxBound :: Int) - fromIntegral (narAlignment - 1)+ -- --------------------------------------------------------------------------- -- Parser -- ---------------------------------------------------------------------------@@ -180,9 +193,10 @@ expectWire limited "archive magic" tokMagic (parseNode limited archiveEnd) BS.empty where -- Declared lengths are compared in Word64 and narrowed only below- -- the bound, so the bound itself must fit Int for the narrowing to- -- be exact.- limited = min bound (fromIntegral (maxBound :: Int))+ -- the bound; 'wireString' then demands the narrowed length plus+ -- its padding in Int, so the bound must sit far enough below Int's+ -- ceiling that the padded sum cannot wrap.+ limited = min bound structuralBoundCeiling archiveEnd leftover | BS.null leftover = NarAwait confirm | otherwise = NarFail trailingBytes@@ -286,37 +300,46 @@ -- Entry-name safety -- --------------------------------------------------------------------------- --- | Reject a NAR directory entry name that is unsafe or out of order--- against its predecessor. Entries must have safe names in strictly--- increasing (sorted, unique) byte order: enforcing this rejects--- malformed or hostile archives, keeps @serialise . deserialise@ an--- identity, and forecloses the path-traversal surface for any--- NAR-extraction consumer. Names are arbitrary bytes; every check--- here is ASCII-structural, so it stays exact whether or not the name--- decodes as text (see "NovaCache.SafeName").+-- | Reject a NAR directory entry name the grammar itself refuses, or+-- one out of order against its predecessor. The rejections are+-- exactly upstream's: no empty name, no @.@ or @..@, no @/@ or NUL,+-- and strictly increasing (sorted, unique) byte order - which rejects+-- malformed archives, keeps @serialise . deserialise@ an identity,+-- and forecloses the POSIX path-traversal surface. Names hazardous+-- only on Windows (device stems like @aux.c@, colons, backslashes,+-- trailing dots or spaces) are accepted here, as upstream's restore+-- accepts them on Unix and real caches serve them; rejecting them is+-- a materialization-boundary decision a store writer takes with+-- 'isWindowsHazardName' when the target filesystem needs it. checkEntryName :: Maybe ByteString -> ByteString -> Either String () checkEntryName prev name | BS.null name = Left "empty NAR directory entry name"- -- Backslash is a directory separator on Windows - this library's- -- primary consumer - so a name like "..\out.exe" is as much a- -- traversal vector as one with '/'. A colon is a drive prefix- -- ("C:evil") or an NTFS alternate data stream ("a:b"), either of- -- which resolves the write somewhere other than a file of this name.- | name == "." || name == ".." || BS8.any (\c -> c == '/' || c == '\\' || c == '\0' || c == ':') name =+ | name == "." || name == ".." || BS8.any (\c -> c == '/' || c == '\0') name = Left ("unsafe NAR directory entry name: " ++ show name)- -- Windows-unsafe categories, shared with the store-key allowlist- -- (NovaCache.SafeName): a device name resolves to the device, and- -- NTFS strips a trailing dot or space so the on-disk name would- -- silently diverge from the NAR name.- | isReservedDeviceName name =- Left ("Windows reserved device name as NAR directory entry: " ++ show name)- | hasTrailingDotOrSpace name =- Left ("NAR directory entry name ends with a dot or space: " ++ show name) | Just p <- prev, name <= p = Left ("NAR directory entries not strictly increasing: " ++ show name) | otherwise = Right () +-- | Does the name resolve, on a Windows filesystem, to something other+-- than an ordinary file of this exact spelling? Backslash is a+-- directory separator there, so @..\\out.exe@ traverses like a name+-- with @/@; a colon is a drive prefix (@C:evil@) or an NTFS alternate+-- data stream (@a:b@); a reserved device stem (@nul@, @aux.c@) opens+-- the device; and NTFS strips a trailing dot or space, silently+-- diverging the on-disk name from the NAR name. The parser accepts+-- all of these because upstream does and real cache.nixos.org+-- archives carry them (perl man pages named @ExtUtils::MakeMaker.3@,+-- kernel trees carrying @aux.c@); a store writer applies this+-- predicate at materialization when the target filesystem needs it.+-- Every check is ASCII-structural, so it stays exact whether or not+-- the name decodes as text (see "NovaCache.SafeName").+isWindowsHazardName :: ByteString -> Bool+isWindowsHazardName name =+ BS8.any (\c -> c == '\\' || c == ':') name+ || isReservedDeviceName name+ || hasTrailingDotOrSpace name+ -- --------------------------------------------------------------------------- -- Chunk-fed primitives -- ---------------------------------------------------------------------------@@ -341,8 +364,9 @@ ++ "-byte wire-string bound" ) else- -- Safe narrowing: declared <= bound, and narStreamBounded- -- clamps every bound to Int's range.+ -- Safe narrowing and a safe padded demand: declared <=+ -- bound <= structuralBoundCeiling, which sits enough+ -- below Int's ceiling that len + narPad len cannot wrap. let len = fromIntegral declared in exactly (len + narPad len) what $ \whole -> case BS.splitAt len whole of
src/NovaCache/SafeName.hs view
@@ -1,8 +1,9 @@ -- | Windows-unsafe name categories, shared by the store-key allowlist--- ('NovaCache.Store.sanitizePath') and the NAR entry-name guard in--- "NovaCache.NAR": names Windows resolves to something other than an--- ordinary file of that exact spelling. Both guards reject the same--- categories from one definition, so they cannot drift apart.+-- ('NovaCache.Store.sanitizePath') and the NAR materialization+-- predicate ('NovaCache.NAR.Stream.isWindowsHazardName'): names+-- Windows resolves to something other than an ordinary file of that+-- exact spelling. Both guards reject the same categories from one+-- definition, so they cannot drift apart. -- -- The predicates take raw bytes, the form NAR entry names have. The -- categories are ASCII-structural - except the superscript device@@ -26,9 +27,9 @@ -- @com0@-@com9@, @lpt0@-@lpt9@, or a superscript-digit @com@\/@lpt@ -- form)? The comparison runs on the stem - the portion before the -- first dot, trailing spaces trimmed - since @nul.txt@ and @NUL .txt@--- also open the device. Enforced on every platform so a--- Windows-hosted consumer is safe too, and kept in step with the twin--- guard nova-nix applies when it materializes NAR entries.+-- also open the device. Surfaced to store writers through+-- 'NovaCache.NAR.Stream.isWindowsHazardName', and kept in step with+-- the twin guard nova-nix applies when it materializes NAR entries. -- -- Device matching is ASCII case-insensitive, so only @A@-@Z@ fold; any -- other byte passes through and can never match the named set.
src/NovaCache/Xz.hs view
@@ -26,13 +26,14 @@ ( XzLimits (..), defaultXzDecoderMemoryBytes, XzError (..),+ truncatedInputMessage, decompress, withXzSource, ) where import qualified Codec.Compression.Lzma as Lzma-import Control.Exception (Exception, throwIO)+import Control.Exception (Exception, SomeException, throwIO, try) -- decompressST runs in lazy ST (the upstream package's own lazy -- API drives it the same way); the driver's accumulator bangs and -- guard-before-recurse keep the bound checks strict regardless.@@ -112,11 +113,10 @@ Lzma.DecompressInputRequired supply -> case pending of Just bytes -> drive Nothing produced acc =<< supply bytes Nothing -> drive Nothing produced acc =<< supply BS.empty- Lzma.DecompressOutputAvailable out next- | grown > bound -> pure (Left (XzOutputOverBound bound))- | otherwise -> drive pending grown (out : acc) =<< next- where- grown = produced + fromIntegral (BS.length out)+ Lzma.DecompressOutputAvailable out next ->+ case growWithinBound bound produced out of+ Nothing -> pure (Left (XzOutputOverBound bound))+ Just grown -> drive pending grown (out : acc) =<< next Lzma.DecompressStreamEnd leftover | BS.null leftover -> pure (Right (BS.concat (reverse acc))) | otherwise -> pure (Left (XzStreamError trailingDataMessage))@@ -132,6 +132,14 @@ data XzSourceState = XzStreaming !(Lzma.DecompressStream IO) !Word64 | XzDrained+ | -- | A pull failed; the exception is held so every later pull+ -- re-throws it. Collapsing failure into 'XzDrained' would let a+ -- consumer that catches the first throw pull once more and read+ -- the empty chunk - the clean-end signal - presenting truncated+ -- output as complete. Held at 'SomeException', not 'XzError':+ -- the compressed source throwing mid-pull leaves the transfer+ -- just as unfinishable as a decoder error does.+ XzFailed !SomeException -- | Decompress a chunk source into a chunk source, under the limits. -- The continuation's pull yields decompressed chunks; the empty chunk@@ -141,7 +149,21 @@ -- decompress, hash, and unpack in one bounded pass. -- -- Limit violations and malformed input are thrown as 'XzError' from--- the pull.+-- the pull; once a pull has let any exception escape - decoder error+-- or the compressed source failing - every later pull re-throws the+-- same exception.+--+-- Despite the bracket-shaped name there is no bracket to run: the+-- binding ("Codec.Compression.Lzma") exposes no teardown for a live+-- 'Lzma.DecompressStream' - it runs @lzma_end@ itself on the clean+-- end path and otherwise leaves it to the stream's ForeignPtr+-- finalizer. A pull that throws, or a consumer that exits early,+-- therefore strands the decoder state (up to 'xzMaxDecoderMemoryBytes')+-- until a GC runs the finalizer. Undo condition: a lzma-static+-- release surfacing live-stream teardown in the high-level API (its+-- internal @LibLzma.endLzmaStream@ is what the fix needs), at which+-- point this becomes a real bracket ending the stream on every exit+-- path. withXzSource :: XzLimits -> IO ByteString -> (IO ByteString -> IO a) -> IO a withXzSource limits compressedSource consume = do start <- Lzma.decompressIO (decompressParams limits)@@ -150,40 +172,51 @@ -- | Produce the next decompressed chunk. pullDecompressed :: XzLimits -> IO ByteString -> IORef XzSourceState -> IO ByteString-pullDecompressed limits compressedSource stateRef = advance =<< readIORef stateRef+pullDecompressed limits compressedSource stateRef = dispatch =<< readIORef stateRef where bound = xzMaxOutputBytes limits- advance XzDrained = pure BS.empty- advance (XzStreaming step produced) = case step of+ dispatch XzDrained = pure BS.empty+ dispatch (XzFailed failure) = throwIO failure+ dispatch (XzStreaming step produced) = do+ outcome <- tryPull (advance step produced)+ case outcome of+ Left failure -> do+ writeIORef stateRef (XzFailed failure)+ throwIO failure+ Right chunk -> pure chunk+ advance step produced = case step of Lzma.DecompressInputRequired supply -> do chunk <- compressedSource next <- supply chunk- advance (XzStreaming next produced)- Lzma.DecompressOutputAvailable out nextAction -> do- let grown = produced + fromIntegral (BS.length out)- if grown > bound- then do- writeIORef stateRef XzDrained- throwIO (XzOutputOverBound bound)- else do+ advance next produced+ Lzma.DecompressOutputAvailable out nextAction ->+ case growWithinBound bound produced out of+ Nothing -> throwIO (XzOutputOverBound bound)+ Just grown -> do next <- nextAction writeIORef stateRef (XzStreaming next grown) -- liblzma may hand back an empty buffer at stream -- boundaries; returning it would read as end of output. if BS.null out- then advance (XzStreaming next grown)+ then advance next grown else pure out- Lzma.DecompressStreamEnd leftover -> do- writeIORef stateRef XzDrained- if BS.null leftover- then pure BS.empty- else throwIO (XzStreamError trailingDataMessage)- Lzma.DecompressStreamError ret -> do- writeIORef stateRef XzDrained- throwIO (mapRet limits ret)+ Lzma.DecompressStreamEnd leftover+ | BS.null leftover -> do+ writeIORef stateRef XzDrained+ pure BS.empty+ | otherwise -> throwIO (XzStreamError trailingDataMessage)+ Lzma.DecompressStreamError ret -> throwIO (mapRet limits ret) +-- | 'try' at 'SomeException', monomorphic so the catch-all needs no+-- annotation at the call site. Any exception escaping a pull - the+-- compressed source failing included - leaves the transfer+-- unfinishable, and the only sound later answer is the same failure+-- again, so the caller latches whatever this catches.+tryPull :: IO ByteString -> IO (Either SomeException ByteString)+tryPull = try+ -- ------------------------------------------------------------------------------ Shared decoder configuration+-- Shared decoder machinery -- --------------------------------------------------------------------------- -- | Decoder parameters under the limits: concatenated-stream decoding@@ -195,11 +228,63 @@ Lzma.decompressMemLimit = xzMaxDecoderMemoryBytes limits } --- | Map liblzma's status to the error vocabulary.+-- | Total output after one more chunk, if it stays within the+-- inclusive bound. The pure driver and the streaming pull both decide+-- the boundary here, so output of exactly the bound - a narinfo's+-- NarSize is exact - passes in both paths by construction.+growWithinBound :: Word64 -> Word64 -> ByteString -> Maybe Word64+growWithinBound bound produced chunk+ | grown > bound = Nothing+ | otherwise = Just grown+ where+ grown = produced + fromIntegral (BS.length chunk)++-- | Map liblzma's status to the error vocabulary. The binding hands+-- over the raw 'Lzma.LzmaRet'; shown as-is, a zero-byte input would+-- fail with the message @LzmaRetOK@ - which reads as success - so the+-- terminal statuses get real diagnoses instead. mapRet :: XzLimits -> Lzma.LzmaRet -> XzError mapRet limits ret = case ret of Lzma.LzmaRetMemlimitError -> XzMemoryOverBound (xzMaxDecoderMemoryBytes limits)- other -> XzStreamError (show other)+ -- Input exhausted mid-stream: the binding reports LzmaRetOK when+ -- the decoder was still content at end of input (a zero-byte input+ -- lands here) and LzmaRetBufError when it could make no further+ -- progress; both mean the input ran out before the stream did.+ Lzma.LzmaRetOK -> XzStreamError truncatedInputMessage+ Lzma.LzmaRetBufError -> XzStreamError truncatedInputMessage+ Lzma.LzmaRetFormatError -> XzStreamError formatErrorMessage+ Lzma.LzmaRetDataError -> XzStreamError dataErrorMessage+ Lzma.LzmaRetOptionsError -> XzStreamError optionsErrorMessage+ Lzma.LzmaRetUnsupportedCheck -> XzStreamError unsupportedCheckMessage+ Lzma.LzmaRetMemError -> XzStreamError decoderAllocationMessage+ -- LzmaRetStreamEnd, LzmaRetGetCheck, LzmaRetProgError never reach+ -- the error path under this module's parameters; if the binding+ -- surfaces one anyway, name it honestly rather than invent a cause.+ other -> XzStreamError (unexpectedStatusPrefix ++ show other) +-- | Diagnosis for input that ends before the xz stream does. A+-- zero-byte input and a truncated download both land here; exported so+-- consumers can match the condition without parsing prose.+truncatedInputMessage :: String+truncatedInputMessage = "compressed input is empty or truncated before the end of the xz stream"+ trailingDataMessage :: String trailingDataMessage = "trailing data after the xz stream"++formatErrorMessage :: String+formatErrorMessage = "input is not an xz stream (magic bytes not recognized)"++dataErrorMessage :: String+dataErrorMessage = "corrupt xz stream"++optionsErrorMessage :: String+optionsErrorMessage = "xz stream declares unsupported filter options"++unsupportedCheckMessage :: String+unsupportedCheckMessage = "xz stream declares an unsupported integrity check"++decoderAllocationMessage :: String+decoderAllocationMessage = "decoder memory allocation failed"++unexpectedStatusPrefix :: String+unexpectedStatusPrefix = "unexpected liblzma status: "
src/NovaCache/Zstd.hs view
@@ -11,22 +11,38 @@ -- ('zstdMaxOutputBytes'), so a small compressed input cannot expand -- to arbitrary memory ahead of the hash check. ----- Decoder state is bounded differently from 'NovaCache.Xz': the--- @zstd@ binding exposes no window-limit parameter, but libzstd--- itself refuses any frame declaring a window past its default+-- The decoder drives @ZSTD_decompressStream@ through the binding's+-- FFI module rather than its high-level streaming driver, for two+-- properties the driver cannot give:+--+-- * The decompression context is created and freed in a bracket+-- ('withDecoder'), so its window buffer - sized by the incoming+-- frame header, i.e. by the peer, up to libzstd's 128 MiB default+-- ceiling - is released deterministically on every exit: success,+-- bound violation, corrupt frame, or an exception in the+-- consumer. The driver frees contexts only when the GC runs a+-- finalizer.+--+-- * The stream's end state is observable: @ZSTD_decompressStream@+-- returns 0 exactly when a frame is completely decoded and fully+-- flushed. Input that ends anywhere else - a frame cut off+-- mid-way, or trailing bytes the decoder buffered as a+-- prospective next frame header - refuses with 'ZstdStreamError',+-- the same complete-stream contract as 'NovaCache.Xz'. The+-- driver discards this return value at end of input and reports a+-- clean end regardless.+--+-- Decoder window memory is bounded by libzstd itself: the binding+-- exposes no window-limit parameter, but the streaming decoder+-- refuses any frame declaring a window past its default -- @ZSTD_WINDOWLOG_LIMIT_DEFAULT@ (2^27, 128 MiB), so decoder memory -- is capped by the library rather than by a caller-chosen number. -- Take the tunable cap here too if the binding ever exposes -- @ZSTD_d_windowLogMax@. ----- A truncated input yields truncated output at this layer rather--- than an error: the binding's stream driver cannot observe--- libzstd's more-input-expected state at end of input. The signed--- NarSize and NarHash checks above this layer are the arbiter of--- completeness - the same layering upstream relies on.------ Everything here is IO: the binding's streaming interface is--- IO-native, unlike lzma's lazy-ST driver under 'NovaCache.Xz'.+-- Everything here is IO: streaming decompression is stateful C+-- calls against a bracketed context, unlike lzma's lazy-ST driver+-- under 'NovaCache.Xz'. -- -- This module lives in the public @nova-cache:zstandard@ sublibrary -- (a component named @zstd@ would shadow the @zstd@ dependency), the@@ -38,18 +54,28 @@ ZstdError (..), decompress, compress,+ ZstdCompressionLevel,+ zstdCompressionLevel,+ lowestCompressionLevel,+ maxCompressionLevel, defaultCompressionLevel, withZstdSource, ) where import qualified Codec.Compression.Zstd as OneShot-import qualified Codec.Compression.Zstd.Streaming as S-import Control.Exception (Exception, throwIO)+import Codec.Compression.Zstd.FFI (Buffer (..), In, Out)+import qualified Codec.Compression.Zstd.FFI as FFI+import Control.Exception (Exception, SomeException, bracket, throwIO, try)+import Control.Monad (when) import Data.ByteString (ByteString) import qualified Data.ByteString as BS+import qualified Data.ByteString.Unsafe as BSU import Data.IORef (IORef, newIORef, readIORef, writeIORef)-import Data.Word (Word64)+import Data.Word (Word64, Word8)+import Foreign.Marshal.Alloc (free, malloc, mallocBytes)+import Foreign.Ptr (Ptr, castPtr, nullPtr)+import Foreign.Storable (peek, poke) -- --------------------------------------------------------------------------- -- Limits@@ -75,8 +101,10 @@ -- 'decompress' returns these in 'Left'; the pull source behind -- 'withZstdSource' throws them (see the 'Exception' instance). data ZstdError- = -- | The compressed stream is malformed (libzstd's error name,- -- rendered with the failing call site).+ = -- | The compressed stream is unacceptable: malformed (libzstd's+ -- error name, rendered with the failing call site), or ended+ -- anywhere but exactly between frames (truncated mid-frame, or+ -- trailing bytes after the last frame). ZstdStreamError !String | -- | Decompressed output would exceed the bound (carried here). ZstdOutputOverBound !Word64@@ -87,7 +115,74 @@ -- throwing pull composes with consumers built around one. instance Exception ZstdError +-- | One libzstd failure in this module's error vocabulary.+renderError :: String -> String -> ZstdError+renderError site name = ZstdStreamError (site <> ": " <> name)++-- | Call sites named in 'ZstdStreamError' messages.+dstreamCreateSite, dstreamInitSite, decompressStreamSite, endOfInputSite :: String+dstreamCreateSite = "ZSTD_createDStream"+dstreamInitSite = "ZSTD_initDStream"+decompressStreamSite = "ZSTD_decompressStream"+endOfInputSite = "end of input"++-- | The refusal for a stream that ends anywhere but exactly between+-- frames. One error covers both shapes deliberately: libzstd+-- buffers a truncated frame header and one to three trailing+-- garbage bytes identically (either could be the start of a next+-- frame), so the two are not distinguishable here.+incompleteStreamError :: ZstdError+incompleteStreamError = renderError endOfInputSite "truncated frame or trailing bytes"+ -- ---------------------------------------------------------------------------+-- Compression levels+-- ---------------------------------------------------------------------------++-- | A compression level the binding accepts: 'lowestCompressionLevel'+-- through 'maxCompressionLevel'. The constructor is not exported, so+-- an out-of-range level is unrepresentable and 'compress' is total;+-- the binding's own compress calls 'error' (under unsafePerformIO)+-- on a level outside this range.+newtype ZstdCompressionLevel = ZstdCompressionLevel Int+ deriving (Eq, Ord, Show)++-- | Validate a level into 'ZstdCompressionLevel'; 'Nothing' outside+-- the accepted range.+zstdCompressionLevel :: Int -> Maybe ZstdCompressionLevel+zstdCompressionLevel level+ | level >= lowestCompressionLevel && level <= maxCompressionLevel =+ Just (ZstdCompressionLevel level)+ | otherwise = Nothing++-- | The highest level libzstd supports (@ZSTD_maxCLevel@; 22 in+-- current releases).+maxCompressionLevel :: Int+maxCompressionLevel = FFI.maxCLevel++-- | The lowest level the binding accepts. libzstd itself reads 0 as+-- "use the default" and negative values as the fast modes, but the+-- binding's compress rejects anything below 1, so 1 is the floor of+-- the representable range.+lowestCompressionLevel :: Int+lowestCompressionLevel = 1++-- | libzstd's own default (level 3): the ratio/speed point the+-- library authors tuned for, and far cheaper than xz at push time.+defaultCompressionLevel :: ZstdCompressionLevel+defaultCompressionLevel = ZstdCompressionLevel 3++-- ---------------------------------------------------------------------------+-- Compression (push path)+-- ---------------------------------------------------------------------------++-- | Compress one payload at the given level. The produced frame+-- records its content size, so consumers with a one-shot decoder can+-- allocate exactly. Total by construction: 'ZstdCompressionLevel'+-- cannot hold a level the binding's pure one-shot API would reject.+compress :: ZstdCompressionLevel -> ByteString -> ByteString+compress (ZstdCompressionLevel level) = OneShot.compress level++-- --------------------------------------------------------------------------- -- Bounded decode -- --------------------------------------------------------------------------- @@ -95,60 +190,39 @@ -- stops accumulating the moment it would pass the bound, so a -- high-expansion input costs at most the bound plus one decoder -- buffer, never what it claims to hold. Concatenated frames decode--- as one output, as upstream's decompression sink accepts.+-- as one output, as upstream's decompression sink accepts; input+-- that ends mid-frame or carries trailing bytes refuses (see the+-- module header). decompress :: ZstdLimits -> ByteString -> IO (Either ZstdError ByteString)-decompress limits input = drive (Just input) 0 [] =<< S.decompress- where- bound = zstdMaxOutputBytes limits- drive pending !produced acc step = case step of- -- The whole input feeds on the first request; the second- -- request gets the empty string, the driver's end-of-input- -- signal.- S.Consume supply -> case pending of- Just bytes -> drive Nothing produced acc =<< supply bytes- Nothing -> drive Nothing produced acc =<< supply BS.empty- S.Produce out next- | grown > bound -> pure (Left (ZstdOutputOverBound bound))- | otherwise -> drive pending grown (out : acc) =<< next- where- grown = produced + fromIntegral (BS.length out)- S.Done out- | produced + fromIntegral (BS.length out) > bound ->- pure (Left (ZstdOutputOverBound bound))- | otherwise -> pure (Right (BS.concat (reverse (out : acc))))- S.Error site name -> pure (Left (renderError site name))---- | One libzstd failure in this module's error vocabulary.-renderError :: String -> String -> ZstdError-renderError site name = ZstdStreamError (site <> ": " <> name)---- ------------------------------------------------------------------------------ Compression (push path)--- ---------------------------------------------------------------------------+decompress limits input = do+ remainingRef <- newIORef (Just input)+ try (withZstdSource limits (oneShotSource remainingRef) drainSource) --- | Compress one payload at the given level (1 to the library--- maximum). The produced frame records its content size, so--- consumers with a one-shot decoder can allocate exactly. The--- binding's one-shot API is pure and total for in-range levels.-compress :: Int -> ByteString -> ByteString-compress = OneShot.compress+-- | Yield the held payload on the first pull, the end-of-input empty+-- chunk on every later one.+oneShotSource :: IORef (Maybe ByteString) -> IO ByteString+oneShotSource remainingRef = do+ remaining <- readIORef remainingRef+ case remaining of+ Nothing -> pure BS.empty+ Just bytes -> do+ writeIORef remainingRef Nothing+ pure bytes --- | libzstd's own default (level 3): the ratio/speed point the--- library authors tuned for, and far cheaper than xz at push time.-defaultCompressionLevel :: Int-defaultCompressionLevel = 3+-- | Collect a pull source's chunks into one strict ByteString.+drainSource :: IO ByteString -> IO ByteString+drainSource pull = collect []+ where+ collect acc = do+ chunk <- pull+ if BS.null chunk+ then pure (BS.concat (reverse acc))+ else collect (chunk : acc) -- --------------------------------------------------------------------------- -- Streaming bounded decode (IO boundary) -- --------------------------------------------------------------------------- --- | What the pull source is doing between calls. The 'IORef'--- holding this is the module's one piece of mutable state - the--- same deliberate, documented boundary as the xz source.-data ZstdSourceState- = ZstdStreaming !S.Result !Word64- | ZstdDrained- -- | Decompress a chunk source into a chunk source, under the -- limits. The continuation's pull yields decompressed chunks; the -- empty chunk means end of output and repeats on further pulls.@@ -157,44 +231,199 @@ -- substituter can fetch, decompress, hash, and unpack in one -- bounded pass. ----- Limit violations and malformed input are thrown as 'ZstdError'--- from the pull.+-- Limit violations and unacceptable input are thrown as 'ZstdError'+-- from the pull; once a pull has let any exception escape - decoder+-- error or the compressed source failing - every later pull rethrows+-- the same exception. The decompression context lives exactly as+-- long as the continuation. withZstdSource :: ZstdLimits -> IO ByteString -> (IO ByteString -> IO a) -> IO a-withZstdSource limits compressedSource consume = do- start <- S.decompress- stateRef <- newIORef (ZstdStreaming start 0)- consume (pullDecompressed limits compressedSource stateRef)+withZstdSource limits compressedSource consume =+ withDecoder $ \decoder -> do+ stateRef <- newIORef (ZstdStreaming initialProgress)+ consume (pullDecompressed limits compressedSource decoder stateRef) +-- | What the pull source is doing between calls. The 'IORef'+-- holding this is the module's one piece of mutable state - the+-- same deliberate, documented boundary as the xz source. A failure+-- is remembered: a consumer that catches the exception and pulls+-- again gets it rethrown, never a phantom clean end of stream.+-- Held at 'SomeException', not 'ZstdError': the compressed source+-- throwing mid-pull leaves the transfer just as unfinishable as a+-- decoder error does.+data ZstdSourceState+ = ZstdStreaming !DecodeProgress+ | ZstdFailed !SomeException+ | ZstdDrained++-- | Where a decode stands between pulls.+data DecodeProgress = DecodeProgress+ { -- | Compressed bytes handed over by the source but not yet+ -- consumed by the decoder (the output buffer filled first).+ pendingCompressed :: !ByteString,+ -- | Decompressed bytes delivered so far, for the bound check.+ producedBytes :: !Word64,+ -- | The last @ZSTD_decompressStream@ call returned 0, or none+ -- has run: the decoder sits exactly between frames, the only+ -- state in which end of input is a clean end of stream.+ atFrameBoundary :: !Bool,+ -- | The compressed source has delivered its empty end chunk.+ sourceExhausted :: !Bool+ }++initialProgress :: DecodeProgress+initialProgress = DecodeProgress BS.empty 0 True False+ -- | Produce the next decompressed chunk.-pullDecompressed :: ZstdLimits -> IO ByteString -> IORef ZstdSourceState -> IO ByteString-pullDecompressed limits compressedSource stateRef = advance =<< readIORef stateRef+pullDecompressed :: ZstdLimits -> IO ByteString -> ZstdDecoder -> IORef ZstdSourceState -> IO ByteString+pullDecompressed limits compressedSource decoder stateRef =+ dispatch =<< readIORef stateRef where bound = zstdMaxOutputBytes limits- advance ZstdDrained = pure BS.empty- advance (ZstdStreaming step produced) = case step of- S.Consume supply -> do- chunk <- compressedSource- next <- supply chunk- advance (ZstdStreaming next produced)- S.Produce out nextAction -> do- let grown = produced + fromIntegral (BS.length out)- if grown > bound- then do- writeIORef stateRef ZstdDrained- throwIO (ZstdOutputOverBound bound)- else do- next <- nextAction- writeIORef stateRef (ZstdStreaming next grown)- -- The driver may hand back an empty buffer at frame- -- boundaries; returning it would read as end of output.- if BS.null out- then advance (ZstdStreaming next grown)- else pure out- S.Done out -> do- writeIORef stateRef ZstdDrained- if produced + fromIntegral (BS.length out) > bound- then throwIO (ZstdOutputOverBound bound)- else pure out- S.Error site name -> do- writeIORef stateRef ZstdDrained- throwIO (renderError site name)++ dispatch ZstdDrained = pure BS.empty+ dispatch (ZstdFailed failure) = throwIO failure+ dispatch (ZstdStreaming progress) = do+ outcome <- tryPull (advance progress)+ case outcome of+ Left failure -> do+ writeIORef stateRef (ZstdFailed failure)+ throwIO failure+ Right chunk -> pure chunk++ advance progress+ | not (BS.null (pendingCompressed progress)) = decodeStep progress+ | sourceExhausted progress = finishStep progress+ | otherwise = do+ chunk <- compressedSource+ if BS.null chunk+ then finishStep progress {sourceExhausted = True}+ else decodeStep progress {pendingCompressed = chunk}++ decodeStep progress =+ deliver progress =<< decodeChunk decoder (pendingCompressed progress)++ -- End of input. Between frames it is the clean end of stream.+ -- Inside a frame, first flush what the decoder still buffers+ -- (bounded by one block per call); a flush that yields nothing+ -- short of a frame boundary means the remaining state is a+ -- frame cut off mid-way or buffered trailing bytes - refuse.+ finishStep progress+ | atFrameBoundary progress = do+ writeIORef stateRef ZstdDrained+ pure BS.empty+ | otherwise = do+ outcome <- decodeChunk decoder BS.empty+ case outcome of+ Right step+ | BS.null (stepOutput step) && not (stepAtBoundary step) ->+ throwIO incompleteStreamError+ _ -> deliver progress outcome++ deliver _ (Left err) = throwIO err+ deliver progress (Right step)+ | grown > bound = throwIO (ZstdOutputOverBound bound)+ | BS.null (stepOutput step) = advance nextProgress+ | otherwise = do+ writeIORef stateRef (ZstdStreaming nextProgress)+ pure (stepOutput step)+ where+ grown = producedBytes progress + fromIntegral (BS.length (stepOutput step))+ nextProgress =+ progress+ { pendingCompressed = stepRemaining step,+ producedBytes = grown,+ atFrameBoundary = stepAtBoundary step+ }++-- | 'try' at 'SomeException', monomorphic so the catch-all needs no+-- annotation at the call site. Any exception escaping a pull - the+-- compressed source failing included - leaves the transfer+-- unfinishable, and the only sound later answer is the same failure+-- again, so the caller latches whatever this catches.+tryPull :: IO ByteString -> IO (Either SomeException ByteString)+tryPull = try++-- ---------------------------------------------------------------------------+-- Decoder plumbing (FFI boundary)+-- ---------------------------------------------------------------------------++-- | A bracketed @ZSTD_DStream@ with the reusable buffers one+-- @ZSTD_decompressStream@ call needs.+data ZstdDecoder = ZstdDecoder+ { decoderStream :: !(Ptr FFI.DStream),+ decoderInBuffer :: !(Ptr (Buffer In)),+ decoderOutBuffer :: !(Ptr (Buffer Out)),+ decoderOutBytes :: !(Ptr Word8)+ }++-- | Output capacity per @ZSTD_decompressStream@ call:+-- @ZSTD_DStreamOutSize@, sized by libzstd so one call can always+-- flush a full decoded block.+outputBufferBytes :: Int+outputBufferBytes = fromIntegral FFI.dstreamOutSize++-- | Run an action with a decompression context and its buffers,+-- freeing all four allocations on any exit. This bracket is the+-- point of driving the FFI directly: the context grows a window+-- buffer sized by the incoming frame header, and 'FFI.freeDStream'+-- here releases it the moment the action ends instead of at a GC+-- finalizer's leisure.+withDecoder :: (ZstdDecoder -> IO a) -> IO a+withDecoder action =+ bracket (FFI.checkAlloc dstreamCreateSite FFI.createDStream) FFI.freeDStream $ \stream ->+ bracket malloc free $ \inBuffer ->+ bracket malloc free $ \outBuffer ->+ bracket (mallocBytes outputBufferBytes) free $ \outBytes -> do+ initRet <- FFI.initDStream stream+ when (FFI.isError initRet) $+ throwIO (renderError dstreamInitSite (FFI.getErrorName initRet))+ action (ZstdDecoder stream inBuffer outBuffer outBytes)++-- | What one @ZSTD_decompressStream@ call yielded.+data DecodeStep = DecodeStep+ { -- | Decompressed bytes flushed into the output buffer.+ stepOutput :: !ByteString,+ -- | The unconsumed tail of the fed input.+ stepRemaining :: !ByteString,+ -- | The call returned 0, the library's only signal that a frame+ -- is completely decoded AND fully flushed.+ stepAtBoundary :: !Bool+ }++-- | One @ZSTD_decompressStream@ call: feed a chunk (empty for a pure+-- flush), collect whatever fits in the output buffer. The output is+-- copied out immediately, so the shared buffer can be reused.+decodeChunk :: ZstdDecoder -> ByteString -> IO (Either ZstdError DecodeStep)+decodeChunk decoder input =+ supplyInput (decoderInBuffer decoder) input $ do+ poke+ (decoderOutBuffer decoder)+ (Buffer (decoderOutBytes decoder) (fromIntegral outputBufferBytes) 0)+ ret <-+ FFI.decompressStream+ (decoderStream decoder)+ (decoderOutBuffer decoder)+ (decoderInBuffer decoder)+ if FFI.isError ret+ then pure (Left (renderError decompressStreamSite (FFI.getErrorName ret)))+ else do+ -- The binding hides its FFI.Types module, so the filled and+ -- consumed positions are read by peeking the whole (three+ -- field) struct rather than its exposed peekPos helper.+ outFilled <- bufPos <$> peek (decoderOutBuffer decoder)+ inConsumed <- bufPos <$> peek (decoderInBuffer decoder)+ output <- BS.packCStringLen (castPtr (decoderOutBytes decoder), fromIntegral outFilled)+ pure (Right (DecodeStep output (BS.drop (fromIntegral inConsumed) input) (ret == 0)))++-- | Point the input buffer at the chunk for the duration of the+-- action. An empty chunk becomes a null zero-length buffer -+-- libzstd reads nothing from a zero-size buffer, and this is the+-- shape its own examples use for a flush call.+supplyInput :: Ptr (Buffer In) -> ByteString -> IO a -> IO a+supplyInput inBuffer bytes action+ | BS.null bytes = do+ poke inBuffer (Buffer (nullPtr :: Ptr Word8) 0 0)+ action+ | otherwise = BSU.unsafeUseAsCStringLen bytes $ \(inPtr, inLen) -> do+ poke inBuffer (Buffer inPtr (fromIntegral inLen) 0)+ action
+ test/Bzip2Test.hs view
@@ -0,0 +1,243 @@+-- | Tests for the bounded bzip2 decoder. A separate suite because+-- the decoder lives in the nova-cache:bzip2 sublibrary; the fixtures+-- are real @bzip2 -9@ output embedded as hex, so no external tool+-- runs at test time.+module Main (main) where++import Control.Exception (throwIO, try)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.Char (isDigit)+import Data.IORef (newIORef, readIORef, writeIORef)+import qualified NovaCache.Bzip2 as Bzip2+import System.Exit (exitFailure, exitSuccess)+import System.IO (hFlush, stdout)+import System.IO.Error (isUserError)++-- ---------------------------------------------------------------------------+-- Harness (mirrors test/Main.hs)+-- ---------------------------------------------------------------------------++test :: String -> IO Bool -> IO Bool+test name action = do+ putStr (" " ++ name ++ "... ")+ hFlush stdout+ result <- action+ putStrLn (if result then "OK" else "FAILED")+ pure result++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++assertTrue :: String -> Bool -> IO Bool+assertTrue _ True = pure True+assertTrue label False = do+ putStrLn ""+ putStrLn (" " ++ label ++ ": expected True")+ pure False++-- ---------------------------------------------------------------------------+-- Fixtures+-- ---------------------------------------------------------------------------++-- | Decode a hex fixture literal. Fixtures are constants, so a+-- malformed one decodes short and the assertions fail loudly.+unhex :: String -> ByteString+unhex = BS.pack . pairs+ where+ pairs (hi : lo : rest) = case (hexVal hi, hexVal lo) of+ (Just h, Just l) -> fromIntegral (h * 16 + l) : pairs rest+ _ -> []+ pairs _ = []+ hexVal c+ | isDigit c = Just (fromEnum c - fromEnum '0')+ | c >= 'a' && c <= 'f' = Just (fromEnum c - fromEnum 'a' + 10)+ | otherwise = Nothing++-- | @bzip2 -9@ of "nova-cache bzip2 fixture\n" (25 bytes of output).+textBz2 :: ByteString+textBz2 =+ unhex+ "425a6839314159265359c032547900000859800010400210003b61d750200022\+ \8326862687a85309a680d3112446fdca60e188c3b44780043e2ee48a70a12180\+ \64a8f2"++-- | The bytes 'textBz2' decompresses to.+textPlain :: ByteString+textPlain = "nova-cache bzip2 fixture\n"++-- | @bzip2 -9@ of 65536 zero bytes: 43 bytes in, 64 KiB out - the+-- expansion shape the output bound exists for.+zerosBz2 :: ByteString+zerosBz2 =+ unhex+ "425a6839314159265359d771e9eb000080c000c000000820003080291a01a403\+ \8bb9229c28486bb8f4f580"++-- | Output size of 'zerosBz2'.+zerosLength :: Word+zerosLength = 65536++-- | A generous bound for the happy paths.+openLimits :: Bzip2.Bzip2Limits+openLimits = boundedTo (1024 * 1024)++-- | Limits with the given output bound.+boundedTo :: Word -> Bzip2.Bzip2Limits+boundedTo bound = Bzip2.Bzip2Limits {Bzip2.bzip2MaxOutputBytes = fromIntegral bound}++-- | Split a byte string into fixed-size pieces.+chunksOf :: Int -> ByteString -> [ByteString]+chunksOf n bs+ | BS.null bs = []+ | otherwise = case BS.splitAt n bs of+ (piece, rest) -> piece : chunksOf n rest++-- | A chunk source over a fixed list (empty chunk on exhaustion),+-- for feeding 'Bzip2.withBzip2Source'.+listSource :: [ByteString] -> IO (IO ByteString)+listSource chunks = scriptedSource (map pure chunks)++-- | A chunk source that performs the given actions in order and+-- returns the empty chunk after they run out; an action may throw,+-- which is how the errored-source tests stage a failure.+scriptedSource :: [IO ByteString] -> IO (IO ByteString)+scriptedSource steps = do+ remaining <- newIORef steps+ pure $ do+ held <- readIORef remaining+ case held of+ [] -> pure BS.empty+ (act : rest) -> do+ writeIORef remaining rest+ act++-- ---------------------------------------------------------------------------+-- Tests+-- ---------------------------------------------------------------------------++main :: IO ()+main = do+ putStrLn "nova-cache bzip2 test suite"+ putStrLn "==========================="+ results <-+ sequence+ [ test "roundtrip under the exact output bound" $ do+ -- NarSize is exact, so output == bound must pass.+ outcome <- Bzip2.decompress (boundedTo (fromIntegral (BS.length textPlain))) textBz2+ assertEqual "text fixture" (Right textPlain) outcome,+ test "high-expansion input inflates fully under an open bound" $ do+ outcome <- Bzip2.decompress openLimits zerosBz2+ case outcome of+ Left err -> do+ putStrLn (" unexpected error: " ++ show err)+ pure False+ Right out -> do+ ok1 <- assertEqual "length" zerosLength (fromIntegral (BS.length out))+ ok2 <- assertTrue "all zero" (BS.all (== 0) out)+ pure (ok1 && ok2),+ test "output over the bound is refused" $ do+ outcome <- Bzip2.decompress (boundedTo 1000) zerosBz2+ assertEqual "far bound" (Left (Bzip2.Bzip2OutputOverBound 1000)) outcome,+ test "one byte under the true size is refused" $ do+ outcome <- Bzip2.decompress (boundedTo (zerosLength - 1)) zerosBz2+ assertEqual+ "tight bound"+ (Left (Bzip2.Bzip2OutputOverBound (fromIntegral (zerosLength - 1))))+ outcome,+ test "garbage input is a stream error" $ do+ outcome <- Bzip2.decompress openLimits "not a bzip2 stream"+ assertTrue "garbage" (isStreamError outcome),+ test "a truncated stream is a stream error" $ do+ outcome <- Bzip2.decompress openLimits (BS.take 20 textBz2)+ assertTrue "truncated" (isStreamError outcome),+ test "concatenated streams decode as one output" $ do+ -- Upstream's sink re-initializes at stream end while input+ -- remains; two streams back-to-back are one valid input.+ outcome <- Bzip2.decompress openLimits (textBz2 <> textBz2)+ assertEqual "two text streams" (Right (textPlain <> textPlain)) outcome,+ test "trailing garbage after the stream is refused" $ do+ outcome <- Bzip2.decompress openLimits (textBz2 <> "garbage!")+ assertTrue "trailing garbage" (isStreamError outcome),+ test "withBzip2Source decompresses a chunked source" $ do+ source <- listSource (chunksOf 7 textBz2)+ out <- Bzip2.withBzip2Source openLimits source drainSource+ assertEqual "streamed output" textPlain out,+ test "withBzip2Source decompresses one-byte chunks" $ do+ source <- listSource (chunksOf 1 textBz2)+ out <- Bzip2.withBzip2Source openLimits source drainSource+ assertEqual "byte-fed output" textPlain out,+ test "withBzip2Source succeeds at the exact output bound" $ do+ source <- listSource (chunksOf 16 zerosBz2)+ out <-+ Bzip2.withBzip2Source+ (boundedTo (fromIntegral zerosLength))+ source+ drainSource+ assertEqual "streamed length" zerosLength (fromIntegral (BS.length out)),+ test "withBzip2Source throws past the output bound" $ do+ source <- listSource (chunksOf 16 zerosBz2)+ outcome <-+ try (Bzip2.withBzip2Source (boundedTo 1000) source drainSource) ::+ IO (Either Bzip2.Bzip2Error ByteString)+ assertEqual "thrown" (Left (Bzip2.Bzip2OutputOverBound 1000)) outcome,+ test "withBzip2Source keeps returning empty after the end" $ do+ source <- listSource [textBz2]+ ends <- Bzip2.withBzip2Source openLimits source $ \pull -> do+ _ <- drainSource pull+ endA <- pull+ endB <- pull+ pure (endA, endB)+ assertEqual "stable end" ("", "") ends,+ test "a thrown decode error repeats on later pulls" $ do+ source <- listSource (chunksOf 16 zerosBz2)+ Bzip2.withBzip2Source (boundedTo 1000) source $ \pull -> do+ first <- try (drainSource pull) :: IO (Either Bzip2.Bzip2Error ByteString)+ again <- try pull :: IO (Either Bzip2.Bzip2Error ByteString)+ ok1 <- assertEqual "first pull" (Left (Bzip2.Bzip2OutputOverBound 1000)) first+ ok2 <- assertEqual "later pull" (Left (Bzip2.Bzip2OutputOverBound 1000)) again+ pure (ok1 && ok2),+ test "a source failure never becomes a clean end" $ do+ -- The source delivers a full stream, errors on the pull+ -- that would confirm the end, then reads as exhausted. An+ -- unlatched decoder would answer the retry with the empty+ -- chunk - a failed transfer posing as complete output.+ source <-+ scriptedSource [pure textBz2, throwIO (userError sourceFailureText)]+ Bzip2.withBzip2Source openLimits source $ \pull -> do+ chunk <- pull+ first <- try pull :: IO (Either IOError ByteString)+ again <- try pull :: IO (Either IOError ByteString)+ ok1 <- assertEqual "decoded chunk" textPlain chunk+ ok2 <- assertTrue "first pull throws" (either isUserError (const False) first)+ ok3 <- assertTrue "later pull throws" (either isUserError (const False) again)+ pure (ok1 && ok2 && ok3)+ ]+ if and results+ then do+ putStrLn ""+ putStrLn ("All " ++ show (length results) ++ " tests passed.")+ exitSuccess+ else do+ putStrLn ""+ putStrLn "Some tests FAILED."+ exitFailure+ where+ sourceFailureText = "staged transfer failure"+ isStreamError outcome = case outcome of+ Left (Bzip2.Bzip2StreamError _) -> True+ _ -> False+ drainSource pull = go []+ where+ go acc = do+ chunk <- pull+ if BS.null chunk+ then pure (BS.concat (reverse acc))+ else go (chunk : acc)
test/Main.hs view
@@ -17,7 +17,7 @@ import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as TE-import Data.Word (Word8)+import Data.Word (Word64, Word8) import qualified Network.HTTP.Types as HTTP import Network.Wai (RequestBodyLength (..), defaultRequest, pathInfo, requestBodyLength, requestHeaders, requestMethod) import qualified Network.Wai.Test as WT@@ -363,10 +363,10 @@ let entry = NAR.NarRegular True BS.empty in assertRight "exec empty" entry (NAR.deserialise (NAR.serialise entry)), -- Cache-served archives are untrusted input: every name that could- -- traverse out of an extraction root must fail the parse.+ -- traverse out of a POSIX extraction root must fail the parse. test "unsafe directory entry names rejected" $ let evil name = NAR.serialise (NAR.NarDirectory [(name, NAR.NarRegular False "x")])- names = ["..", ".", "", "a/b", "a\\b", "a\0b"]+ names = ["..", ".", "", "a/b", "a\0b"] rejected bytes = either (const True) (const False) (NAR.deserialise bytes) in assertTrue "all unsafe names rejected" (all (rejected . evil) names), test "duplicate directory entries rejected" $@@ -395,17 +395,29 @@ ["nix-archive-1", "(", "type", "regular", "executable", "X", "contents", "hi", ")"] ) in assertLeft "nonempty marker" (NAR.deserialise marked),+ -- Upstream's restore accepts these on Unix, and real+ -- cache.nixos.org archives carry them (perl man pages named+ -- ExtUtils::MakeMaker.3, kernel trees carrying aux.c): the+ -- parser must too, or substitution fails where upstream+ -- succeeds. Rejecting them is the store writer's call, via+ -- NAR.isWindowsHazardName, where the target filesystem needs it.+ test "Windows-hazard names parse, as upstream accepts" $+ let entryFor name = NAR.NarDirectory [(name, NAR.NarRegular False "x")]+ names = ["ExtUtils::MakeMaker.3", "aux.c", "a:b", "a\\b", "nul", "foo.", "foo "]+ roundTrips name = NAR.deserialise (NAR.serialise (entryFor name)) == Right (entryFor name)+ in assertTrue "all parse and round-trip" (all roundTrips names), -- Windows resolves these names to something other than a file of- -- this spelling (drive/stream colon, device, NTFS dot/space strip).- test "Windows-hazard entry names rejected" $- let evil name = NAR.serialise (NAR.NarDirectory [(name, NAR.NarRegular False "x")])- -- The last three: COM0/LPT0 are reserved alongside COM1-9,- -- the device stem is compared with trailing spaces trimmed- -- ("NUL .txt" still opens the device), and the superscript- -- digits (here U+00B9 as UTF-8) count as device digits.- names =+ -- this spelling (drive/stream colon, separator backslash, device,+ -- NTFS dot/space strip).+ test "isWindowsHazardName flags the hazard categories" $+ -- Among the devices: COM0/LPT0 are reserved alongside COM1-9,+ -- the device stem is compared with trailing spaces trimmed+ -- ("NUL .txt" still opens the device), and the superscript+ -- digits (here U+00B9 as UTF-8) count as device digits.+ let names = [ "C:evil", "a:b",+ "a\\b", "nul", "NUL", "com1",@@ -418,16 +430,16 @@ "CON .x", "com" <> BS.pack [0xC2, 0xB9] ]- rejected bytes = either (const True) (const False) (NAR.deserialise bytes)- in assertTrue "all hazard names rejected" (all (rejected . evil) names),- test "near-miss names still parse" $+ in assertTrue "all hazard names flagged" (all NAR.isWindowsHazardName names),+ test "near-miss names parse and pass the hazard predicate" $ let plain name = NAR.serialise (NAR.NarDirectory [(name, NAR.NarRegular False "x")]) -- "com" followed by a non-digit non-superscript byte (here -- U+00B4, acute accent) is an ordinary name; so are stems -- one character too long. names = ["nul2", "com10", "conx", "foo.bar", "a.b.c", "lpt00", "com" <> BS.pack [0xC2, 0xB4]] accepted bytes = either (const False) (const True) (NAR.deserialise bytes)- in assertTrue "all near-miss names accepted" (all (accepted . plain) names),+ clean name = accepted (plain name) && not (NAR.isWindowsHazardName name)+ in assertTrue "all near-miss names accepted" (all clean names), -- Upstream carries names and targets as raw bytes: entries that -- do not decode as UTF-8 parse and round-trip. test "non-UTF-8 entry name round-trips" $@@ -453,11 +465,9 @@ pure False, -- The hazard checks are ASCII-structural, so they fire inside -- names that do not decode as text.- test "hazards inside non-UTF-8 names still rejected" $- let evil name = NAR.serialise (NAR.NarDirectory [(name, NAR.NarRegular False "x")])- names = ["nul." <> BS.pack [0xFF], BS.pack [0xFF, 0x2E], BS.pack [0xFF] <> ":x"]- rejected bytes = either (const True) (const False) (NAR.deserialise bytes)- in assertTrue "all hazard bytes rejected" (all (rejected . evil) names),+ test "hazards inside non-UTF-8 names still flagged" $+ let names = ["nul." <> BS.pack [0xFF], BS.pack [0xFF, 0x2E], BS.pack [0xFF] <> ":x"]+ in assertTrue "all hazard bytes flagged" (all NAR.isWindowsHazardName names), -- The case-hack strip: a tree materialized with upstream's -- collision suffix serialises back under its NAR names. test "serialiseFromPathWith strips the case-hack suffix" $ do@@ -572,7 +582,12 @@ -- | Drive the streaming parser over the given chunks (all non-empty), -- then signal end of input, collecting events. runStream :: [ByteString] -> Either String [Stream.NarEvent]-runStream chunks = go Stream.narStream chunks []+runStream = runStreamFrom Stream.narStream++-- | 'runStream' from an explicitly constructed machine, for tests that+-- need a bound other than the default.+runStreamFrom :: Stream.NarStep -> [ByteString] -> Either String [Stream.NarEvent]+runStreamFrom start chunks = go start chunks [] where go step pending acc = case step of Stream.NarFail err -> Left err@@ -692,7 +707,7 @@ NAR.serialise (NAR.NarRegular False "x") <> "junk1234", evil "..", evil "a/b",- evil "nul"+ evil "" ] bothReject bytes = isLeft (runStream [bytes]) && isLeft (NAR.deserialise bytes) in assertTrue "all rejected by both parsers" (all bothReject malformed),@@ -709,6 +724,21 @@ test "a truncated archive fails" $ let bytes = NAR.serialise (NAR.NarRegular False "some contents here") in assertLeft "eof" (runStream [BS.take (BS.length bytes - 9) bytes]),+ -- Regression: under a huge caller bound, a declared length near+ -- maxBound Int once wrapped the padded Int demand negative, so+ -- the machine "read" the string instantly as empty at an unmoved+ -- position and this archive parsed as a complete empty symlink.+ -- The parse must fail, as upstream would at end of input.+ test "a near-maxBound declared length fails under a huge bound" $+ let declared = fromIntegral (maxBound :: Int) :: Word64+ lenPrefix = BS.pack [fromIntegral ((declared `shiftR` (8 * i)) .&. 0xff) | i <- [0 .. 7]]+ bytes =+ BS.concat (map (narWireStr 0) ["nix-archive-1", "(", "type", "symlink", "target"])+ <> lenPrefix+ <> narWireStr 0 ")"+ in assertLeft+ "overflowing padded demand"+ (runStreamFrom (Stream.narStreamBounded (maxBound :: Word64)) [bytes]), test "the declared contents size arrives before the bytes" $ case runStream [NAR.serialise (NAR.NarRegular False (BS.replicate 24 0x2A))] of Right (Stream.EventRegularBegin False declared : _) ->
test/XzTest.hs view
@@ -3,7 +3,7 @@ -- output embedded as hex, so no external tool runs at test time. module Main (main) where -import Control.Exception (try)+import Control.Exception (throwIO, try) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.Char (isDigit)@@ -11,6 +11,7 @@ import qualified NovaCache.Xz as Xz import System.Exit (exitFailure, exitSuccess) import System.IO (hFlush, stdout)+import System.IO.Error (isUserError) -- --------------------------------------------------------------------------- -- Harness (mirrors test/Main.hs)@@ -109,15 +110,21 @@ -- | A chunk source over a fixed list (empty chunk on exhaustion), for -- feeding 'Xz.withXzSource'. listSource :: [ByteString] -> IO (IO ByteString)-listSource chunks = do- remaining <- newIORef chunks+listSource chunks = scriptedSource (map pure chunks)++-- | A chunk source that performs the given actions in order and+-- returns the empty chunk after they run out; an action may throw,+-- which is how the errored-source tests stage a failure.+scriptedSource :: [IO ByteString] -> IO (IO ByteString)+scriptedSource steps = do+ remaining <- newIORef steps pure $ do held <- readIORef remaining case held of [] -> pure BS.empty- (c : cs) -> do- writeIORef remaining cs- pure c+ (act : rest) -> do+ writeIORef remaining rest+ act -- --------------------------------------------------------------------------- -- Tests@@ -156,8 +163,22 @@ (Xz.decompress (boundedTo (zerosLength - 1)) zerosXz), test "garbage input is a stream error" $ assertTrue "garbage" (isStreamError (Xz.decompress openLimits "not an xz stream")),- test "a truncated stream is a stream error" $- assertTrue "truncated" (isStreamError (Xz.decompress openLimits (BS.take 40 textXz))),+ test "a truncated stream is diagnosed as truncated" $+ -- The binding reports truncation as LzmaRetBufError (or+ -- LzmaRetOK); the message must be the diagnosis, not the+ -- raw constructor.+ assertEqual+ "truncated"+ (Left (Xz.XzStreamError Xz.truncatedInputMessage))+ (Xz.decompress openLimits (BS.take 40 textXz)),+ test "empty input is diagnosed as truncated" $+ -- Zero bytes drive the decoder straight to end of input+ -- while the binding still reports LzmaRetOK, which shown+ -- raw would read as success.+ assertEqual+ "empty input"+ (Left (Xz.XzStreamError Xz.truncatedInputMessage))+ (Xz.decompress openLimits BS.empty), test "concatenated streams decode as one output" $ -- Upstream decodes with LZMA_CONCATENATED; two streams -- back-to-back are one valid input.@@ -179,6 +200,16 @@ source <- listSource (chunksOf 7 textXz) out <- Xz.withXzSource openLimits source drainSource assertEqual "streamed output" textPlain out,+ test "withXzSource succeeds at the exact output bound" $ do+ -- NarSize is exact, so the streaming path must accept+ -- output == bound just as the pure path does.+ source <- listSource (chunksOf 7 textXz)+ out <-+ Xz.withXzSource+ (boundedTo (fromIntegral (BS.length textPlain)))+ source+ drainSource+ assertEqual "exact-bound streamed output" textPlain out, test "withXzSource throws past the output bound" $ do source <- listSource (chunksOf 16 zerosXz) outcome <-@@ -192,7 +223,34 @@ endA <- pull endB <- pull pure (endA, endB)- assertEqual "stable end" ("", "") ends+ assertEqual "stable end" ("", "") ends,+ test "withXzSource re-throws the same error on pulls after a failure" $ do+ -- A caught error must not turn the next pull into the empty+ -- chunk, the clean-end signal; a failed source stays failed.+ source <- listSource (chunksOf 16 zerosXz)+ Xz.withXzSource (boundedTo 1000) source $ \pull -> do+ firstPull <- try (drainSource pull) :: IO (Either Xz.XzError ByteString)+ secondPull <- try pull :: IO (Either Xz.XzError ByteString)+ okFirst <-+ assertEqual "first pull" (Left (Xz.XzOutputOverBound 1000)) firstPull+ okSecond <-+ assertEqual "later pull" (Left (Xz.XzOutputOverBound 1000)) secondPull+ pure (okFirst && okSecond),+ test "a source failure never becomes a clean end" $ do+ -- The source delivers a full stream, errors on the pull+ -- that would confirm the end, then reads as exhausted. An+ -- unlatched decoder would answer the retry with the empty+ -- chunk - a failed transfer posing as complete output.+ source <-+ scriptedSource [pure textXz, throwIO (userError sourceFailureText)]+ Xz.withXzSource openLimits source $ \pull -> do+ chunk <- pull+ firstPull <- try pull :: IO (Either IOError ByteString)+ laterPull <- try pull :: IO (Either IOError ByteString)+ okChunk <- assertEqual "decoded chunk" textPlain chunk+ okFirst <- assertTrue "first pull throws" (either isUserError (const False) firstPull)+ okLater <- assertTrue "later pull throws" (either isUserError (const False) laterPull)+ pure (okChunk && okFirst && okLater) ] if and results then do@@ -205,6 +263,7 @@ exitFailure where smallMemory = 1024 * 1024+ sourceFailureText = "staged transfer failure" isStreamError outcome = case outcome of Left (Xz.XzStreamError _) -> True _ -> False
test/ZstdTest.hs view
@@ -1,16 +1,21 @@ -- | Tests for the bounded zstd codec. A separate suite because the--- codec lives in the nova-cache:zstandard sublibrary; the compressed--- fixtures come from the sublibrary's own pure 'Zstd.compress', so--- no external tool runs at test time.+-- codec lives in the nova-cache:zstandard sublibrary. Most+-- compressed fixtures come from the sublibrary's own pure+-- 'Zstd.compress'; two frames are embedded as bytes produced offline+-- by the reference zstd CLI (v1.5.7), grounding the decoder against+-- the reference encoder - no external tool runs at test time. module Main (main) where -import Control.Exception (try)+import Control.Exception (throwIO, try) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.IORef (newIORef, readIORef, writeIORef)+import Data.Maybe (isJust, isNothing)+import Data.Word (Word8) import qualified NovaCache.Zstd as Zstd import System.Exit (exitFailure, exitSuccess) import System.IO (hFlush, stdout)+import System.IO.Error (isUserError) -- --------------------------------------------------------------------------- -- Harness (mirrors test/XzTest.hs)@@ -58,15 +63,130 @@ compressedPayload :: ByteString compressedPayload = Zstd.compress Zstd.defaultCompressionLevel payload +-- | A byte no zstd magic number starts with, for trailing-garbage+-- tails.+garbageByte :: Word8+garbageByte = 0x47++-- | What 'referenceFrame' decompresses to: 16 copies of the+-- reference line, 544 bytes.+referencePayload :: ByteString+referencePayload = BS.concat (replicate 16 "nova-cache zstd reference fixture\n")++-- | 'referencePayload' compressed offline by the reference CLI+-- (@zstd -3@ over a pipe, so the header carries no content size and+-- an XXH64 content checksum), byte for byte.+referenceFrame :: ByteString+referenceFrame =+ BS.pack+ [ 0x28,+ 0xb5,+ 0x2f,+ 0xfd,+ 0x04,+ 0x58,+ 0x5d,+ 0x01,+ 0x00,+ 0x24,+ 0x02,+ 0x6e,+ 0x6f,+ 0x76,+ 0x61,+ 0x2d,+ 0x63,+ 0x61,+ 0x63,+ 0x68,+ 0x65,+ 0x20,+ 0x7a,+ 0x73,+ 0x74,+ 0x64,+ 0x20,+ 0x72,+ 0x65,+ 0x66,+ 0x65,+ 0x72,+ 0x65,+ 0x6e,+ 0x63,+ 0x65,+ 0x20,+ 0x66,+ 0x69,+ 0x78,+ 0x74,+ 0x75,+ 0x72,+ 0x65,+ 0x0a,+ 0x01,+ 0x00,+ 0xda,+ 0x2f,+ 0xaa,+ 0x7a,+ 0x02,+ 0xd1,+ 0x58,+ 0x21,+ 0xe9+ ]++-- | A frame whose header declares a 1 GiB window (@zstd --long=30@+-- over a pipe, offline): past libzstd's default window limit+-- (@ZSTD_WINDOWLOG_LIMIT_DEFAULT@, 2^27 = 128 MiB), so the decoder+-- must refuse rather than allocate what the peer's header asks for.+wideWindowFrame :: ByteString+wideWindowFrame =+ BS.pack+ [ 0x28,+ 0xb5,+ 0x2f,+ 0xfd,+ 0x04,+ 0xa0,+ 0x69,+ 0x00,+ 0x00,+ 0x77,+ 0x69,+ 0x6e,+ 0x64,+ 0x6f,+ 0x77,+ 0x20,+ 0x70,+ 0x72,+ 0x6f,+ 0x62,+ 0x65,+ 0x0a,+ 0x46,+ 0x3e,+ 0x21,+ 0x43+ ]+ -- | A pull source yielding the given chunks, then empty forever. chunkSource :: [ByteString] -> IO (IO ByteString)-chunkSource chunks = do- ref <- newIORef chunks+chunkSource chunks = scriptedSource (map pure chunks)++-- | A pull source that performs the given actions in order and+-- returns the empty chunk after they run out; an action may throw,+-- which is how the errored-source tests stage a failure.+scriptedSource :: [IO ByteString] -> IO (IO ByteString)+scriptedSource steps = do+ ref <- newIORef steps pure $ do remaining <- readIORef ref case remaining of [] -> pure BS.empty- (c : cs) -> writeIORef ref cs >> pure c+ (act : rest) -> writeIORef ref rest >> act -- | Split a payload into bounded chunks so the streaming path sees -- many small feeds, as a network body would deliver.@@ -85,6 +205,10 @@ then pure (BS.concat (reverse acc)) else go (chunk : acc) +isStreamError :: Either Zstd.ZstdError a -> Bool+isStreamError (Left (Zstd.ZstdStreamError _)) = True+isStreamError _ = False+ -- --------------------------------------------------------------------------- -- Tests -- ---------------------------------------------------------------------------@@ -102,9 +226,7 @@ assertEqual "over-bound" (Left (Zstd.ZstdOutputOverBound (fromIntegral (payloadSize - 1)))) out, test "garbage refuses" $ do out <- Zstd.decompress (limitsOf 64) "not a zstd stream"- assertTrue "stream error" $ case out of- Left (Zstd.ZstdStreamError _) -> True- _ -> False,+ assertTrue "stream error" (isStreamError out), test "concatenated frames decode as one output" $ do let second = BS.concat (replicate 8 "second frame\n") joined = compressedPayload <> Zstd.compress Zstd.defaultCompressionLevel second@@ -112,12 +234,45 @@ assertEqual "concatenated" (Right (payload <> second)) out, test "trailing garbage after a frame refuses" $ do out <- Zstd.decompress (limitsOf (payloadSize + 64)) (compressedPayload <> "trailing garbage")- assertTrue "trailing" $ case out of- Left (Zstd.ZstdStreamError _) -> True- _ -> False,+ assertTrue "trailing" (isStreamError out),+ test "trailing garbage of one to four bytes refuses" $ do+ outs <-+ mapM+ ( \n ->+ Zstd.decompress+ (limitsOf (payloadSize + 64))+ (compressedPayload <> BS.replicate n garbageByte)+ )+ [1 .. 4]+ assertTrue "each tail refuses" (all isStreamError outs),+ test "truncated input refuses" $ do+ out <- Zstd.decompress (limitsOf payloadSize) (BS.dropEnd 5 compressedPayload)+ assertTrue "truncated" (isStreamError out), test "empty input is empty output" $ do out <- Zstd.decompress (limitsOf 0) BS.empty assertEqual "empty" (Right BS.empty) out,+ test "reference CLI frame roundtrips" $ do+ out <-+ Zstd.decompress+ (limitsOf (fromIntegral (BS.length referencePayload)))+ referenceFrame+ assertEqual "reference" (Right referencePayload) out,+ test "window past the default limit refuses" $ do+ out <- Zstd.decompress (limitsOf 4096) wideWindowFrame+ assertTrue "wide window" (isStreamError out),+ test "compression level constructor enforces the range" $+ pure+ ( isNothing (Zstd.zstdCompressionLevel 0)+ && isJust (Zstd.zstdCompressionLevel 1)+ && isJust (Zstd.zstdCompressionLevel Zstd.maxCompressionLevel)+ && isNothing (Zstd.zstdCompressionLevel (Zstd.maxCompressionLevel + 1))+ ),+ test "roundtrip at a constructed level" $+ case Zstd.zstdCompressionLevel 19 of+ Nothing -> assertTrue "level 19 representable" False+ Just level -> do+ out <- Zstd.decompress (limitsOf payloadSize) (Zstd.compress level payload)+ assertEqual "constructed level" (Right payload) out, test "source: chunked roundtrip" $ do source <- chunkSource (chunksOf 7 compressedPayload) out <- Zstd.withZstdSource (limitsOf payloadSize) source collectSource@@ -129,8 +284,43 @@ test "source: garbage throws" $ do source <- chunkSource ["not a zstd stream"] out <- try (Zstd.withZstdSource (limitsOf 64) source collectSource) :: IO (Either Zstd.ZstdError ByteString)- assertTrue "source garbage" $ case out of- Left (Zstd.ZstdStreamError _) -> True- _ -> False+ assertTrue "source garbage" (isStreamError out),+ test "source: truncated input throws" $ do+ source <- chunkSource (chunksOf 7 (BS.dropEnd 5 compressedPayload))+ out <- try (Zstd.withZstdSource (limitsOf payloadSize) source collectSource) :: IO (Either Zstd.ZstdError ByteString)+ assertTrue "source truncated" (isStreamError out),+ test "source: pull after an error keeps throwing" $ do+ source <- chunkSource ["not a zstd stream"]+ Zstd.withZstdSource (limitsOf 64) source $ \pull -> do+ first <- try pull :: IO (Either Zstd.ZstdError ByteString)+ second <- try pull :: IO (Either Zstd.ZstdError ByteString)+ initial <- assertTrue "first pull throws" (isStreamError first)+ repeated <- assertEqual "second pull rethrows the same error" first second+ pure (initial && repeated),+ test "source: a source failure never becomes a clean end" $ do+ -- The source delivers a full frame, errors on the pull that+ -- would confirm the end, then reads as exhausted. An+ -- unlatched decoder would answer the retry with the empty+ -- chunk - a failed transfer posing as complete output.+ source <-+ scriptedSource [pure compressedPayload, throwIO (userError sourceFailureText)]+ Zstd.withZstdSource (limitsOf payloadSize) source $ \pull -> do+ chunk <- pull+ firstPull <- try pull :: IO (Either IOError ByteString)+ laterPull <- try pull :: IO (Either IOError ByteString)+ okChunk <- assertEqual "decoded chunk" payload chunk+ okFirst <- assertTrue "first pull throws" (either isUserError (const False) firstPull)+ okLater <- assertTrue "later pull throws" (either isUserError (const False) laterPull)+ pure (okChunk && okFirst && okLater) ]- if and results then exitSuccess else exitFailure+ if and results+ then do+ putStrLn ""+ putStrLn ("All " ++ show (length results) ++ " tests passed.")+ exitSuccess+ else do+ putStrLn ""+ putStrLn "Some tests FAILED."+ exitFailure+ where+ sourceFailureText = "staged transfer failure"