Repository: mirage/decompress
Pull request #142 (2022-07-06 15:48:32)

Be able to create a zlib/gzip document without compression
This patch unlock the ability to create a `zlib`/`gzip` document without compression. It can be useful specially for video/image or any documents which are already compressed. This patch **breaks** the API  where the kind of block `Flat` does not requires anymore a size (in bytes).

The `Flat` block has a new - and more homogeneous - behavior than `Fixed` or `Dynamic`. Instead to asks the user to require bytes, it will just look up into the shared queue and emit `command` without huffman compression. However, we can apply an huffman compression even if the `Lz77` does not do any compression.

This big change is due to the internal loop of `Zl`/`Gz` which expects a certain sequence of instructions. Tests (only `deflate` tests) are modified as well to fit with this new behavior. The `level = 0` for `Zl`/`Gz` means **no compression now**! Be aware that you probably should increment the level if you uses `0` before. I will let this PR open to see implications on upper layers (specially for Git).


Patch:
diff --git a/.ocamlformat b/.ocamlformat
index a8fe6dd..ea42de1 100644
--- a/.ocamlformat
+++ b/.ocamlformat
@@ -1,4 +1,4 @@
-version=0.21.0
+version=0.22.4
 profile=conventional
 break-struct=natural
 break-infix=fit-or-vertical
diff --git a/README.md b/README.md
index b2d0e5f..2aeb3e1 100644
--- a/README.md
+++ b/README.md
@@ -26,16 +26,30 @@ Each sub-package provide 3 sub-modules:
 
 ## How to use it
 
+### The binary
+
+The distribution provides a simple binary which is able to compress/uncompress
+anything:
+```sh
+$ decompress -fgzip --deflate < my_document.txt > my_document.gzip
+$ decompress -fgzip < my_document.gzip > my_document.out
+$ diff my_document.txt my_document.out
+```
+
+It does the GZip compression, the Zlib one and the DEFLATE one. It can do an
+LZO compression too.
+
 ### Link issue
 
 `decompress` uses [`checkseum`][checkseum] to compute CRC of streams.
 `checkseum` provides 2 implementations:
 - a C implementation to be fast
-- an OCaml implementation to be usable with `js_of_ocaml` (or, at least, require
-  only the _caml runtime_)
+- an OCaml implementation to be usable with `js_of_ocaml` (or, at least,
+  require only the _caml runtime_)
 
-When the user wants to make an OCaml executable, it must choose which implementation
-of `checkseum` he wants. A compilation of an executable with `decompress.zl` is:
+When the user wants to make an OCaml executable, it must choose which
+implementation of `checkseum` he wants. A compilation of an executable with
+`decompress.zl` is:
 ```
 $ ocamlfind opt -linkpkg -package checkseum.c,decompress.zl main.ml
 ```
@@ -45,9 +59,9 @@ Otherwise, the end-user should have a linking error (see
 
 #### With `dune`
 
-`checkseum` uses a mechanism integrated into `dune` which solves the link issue.
-It provides a way to silently choose the default implementation of `checkseum`:
-`checkseum.c`.
+`checkseum` uses a mechanism integrated into `dune` which solves the link
+issue. It provides a way to silently choose the default implementation of
+`checkseum`: `checkseum.c`.
 
 By this way (and only with `dune`), an executable with `decompress.zl` is:
 ```
@@ -72,8 +86,8 @@ Of course, the user still is able to choose which implementation he wants:
 #### Input / Output
 
 The process of the inflation/deflation is non-blocking and it does not require
-any _syscalls_ (as an usual MirageOS project). The user can decide how to get the
-input and how to store the output.
+any _syscalls_ (as an usual MirageOS project). The user can decide how to get
+the input and how to store the output.
 
 An usual _loop_ (which can fit into `lwt` or `async`) of `decompress.zl` is:
 ```ocaml
@@ -114,7 +128,8 @@ let () =
 let () =
   Lwt_main.run @@
     Lwt.join [ (decompress ~window:w0 stdin stdout |> Lwt.return)
-             ; (decompress ~window:w0 (open_in "file.z") (open_out "file") |> Lwt.return) ]
+             ; (decompress ~window:w0 (open_in "file.z") (open_out "file")
+	       |> Lwt.return) ]
 ```
 
 This ability can be used on:
@@ -125,37 +140,61 @@ This ability can be used on:
 
 ### Example
 
-An example exists into [bin/decompress.ml][decompress.ml] where you can see how to use
-`decompress.zl` and `decompress.de`.
+An example exists into [bin/decompress.ml][decompress.ml] where you can see how
+to use `decompress.zl` and `decompress.de`.
 
 ### Higher interface
 
-However, `decompress` provides a _higher_ interface close to what `camlzip` provides
-to help newcomers to use `decompress`:
+However, `decompress` provides a _higher_ interface close to what `camlzip`
+provides to help newcomers to use `decompress`:
 ```ocaml
-val compress : refill:(bigstring -> int) -> flush:(bigstring -> int -> unit) -> unit
-val uncompress : refill:(bigstring -> int) -> flush:(bigstring -> int -> unit) -> unit
+val compress :
+     refill:(bigstring -> int)
+  -> flush:(bigstring -> int -> unit)
+  -> unit
+val uncompress :
+     refill:(bigstring -> int)
+  -> flush:(bigstring -> int -> unit)
+  -> unit
 ```
 
 ### Benchmark
 
-`decompress` has a benchmark about _inflation_ to see if any update has a performance
-implication. The process try to _inflate_ a stream and stop at N second(s) (default is 30),
-The benchmark requires `libzlib-dev`, `cmdliner` and `bos` to be able to compile `zpipe`
-and the executable to produce the CSV file. To build the benchmark:
+`decompress` has a benchmark about _inflation_ to see if any update has a
+performance implication. The process try to _inflate_ a stream and stop at N
+second(s) (default is 30), The benchmark requires `libzlib-dev`, `cmdliner` and
+`bos` to be able to compile `zpipe` and the executable to produce the CSV file.
+To build the benchmark:
 
 ```sh
 $ dune build --profile benchmark bench/output.csv
 ```
 
-On linux machines, `/dev/urandom` will generate the random input for piping to zpipe. To 
-run the benchmark:
+On linux machines, `/dev/urandom` will generate the random input for piping to
+zpipe. To run the benchmark:
+```sh
+$ cat /dev/urandom | ./_build/default/bench/zpipe \
+  | ./_build/default/bench/bench.exe 2> /dev/null
+```
+
+The output file is a CSV file which can be processed by a _plot_ software. It
+records input bytes, output bytes and memory usage at each second. You can
+show results with `gnuplot`:
 ```sh
-$ cat /dev/urandom | ./build/default/bench/zpipe | ./_build/default/bench/bench.exe
+$ gnuplot -p -e \
+  'set datafile separator ",";
+   set key autotitle columnhead;
+   plot "_build/default/bench/output.csv" using 1:2 with lines,
+        "" using 1:3 with lines'
+$ gnuplot -p -e \
+  'set datafile separator ",";
+   set key autotitle columnhead;
+   plot "_build/default/bench/output.csv" using 1:4 with lines'
 ```
 
-The output file is a CSV file which can be processed by a _plot_ software. It records
-input bytes, output bytes and memory usage at each second.
+The second graph ensure that the inflation does not allocate while it
+processes. It ensure that, at another layer, `decompress` does not leak
+memory.
 
 ## Build Requirements
 
diff --git a/bench/bench.ml b/bench/bench.ml
index 9580eb3..5240efd 100644
--- a/bench/bench.ml
+++ b/bench/bench.ml
@@ -103,6 +103,8 @@ let json =
   Arg.(value & flag & info ["j"; "json"] ~doc)
 
 let cmd =
-  Term.(const inflate $ max $ json), Term.info "bench" ~doc:"Run benchmarks"
+  Cmd.v
+    (Cmd.info "bench" ~doc:"Run benchmarks")
+    Term.(const inflate $ max $ json)
 
-let () = Term.(exit @@ eval cmd)
+let () = exit @@ Cmd.eval cmd
diff --git a/bench/run.ml b/bench/run.ml
index 09a4af7..6de2d53 100644
--- a/bench/run.ml
+++ b/bench/run.ml
@@ -33,5 +33,5 @@ let path =
 let output = Arg.(value & opt (some path) None & info ["o"])
 let max = Arg.(value & pos ~rev:true 0 int 30 & info [])
 let json = Arg.(value & flag & info ["j"; "json"])
-let cmd = Term.(const run $ output $ max $ json), Term.info "run"
-let () = Term.(exit @@ eval cmd)
+let cmd = Cmd.v (Cmd.info "run") Term.(const run $ output $ max $ json)
+let () = exit @@ Cmd.eval cmd
diff --git a/bin/decompress.ml b/bin/decompress.ml
index 997c440..b309cfb 100644
--- a/bin/decompress.ml
+++ b/bin/decompress.ml
@@ -44,9 +44,9 @@ let run_inflate ic oc =
       ; `Ok 0 in
   go ()
 
-let run_deflate ic oc =
+let run_deflate ~level ic oc =
   let open De in
-  let state = Lz77.state ~level:4 ~q ~w:l (`Channel ic) in
+  let state = Lz77.state ~level ~q ~w:l (`Channel ic) in
   let encoder = Def.encoder (`Channel oc) ~q in
 
   let rec compress () =
@@ -95,9 +95,9 @@ let run_zlib_inflate ic oc =
       ; `Ok 0 in
   go decoder
 
-let run_zlib_deflate ic oc =
+let run_zlib_deflate ~level ic oc =
   let open Zl in
-  let encoder = Def.encoder `Manual `Manual ~q ~w:l ~level:0 in
+  let encoder = Def.encoder `Manual `Manual ~q ~w:l ~level in
 
   let rec go encoder =
     match Def.encode encoder with
@@ -136,10 +136,10 @@ let run_gzip_inflate ic oc =
 
 let now () = Int32.of_float (Unix.gettimeofday ())
 
-let run_gzip_deflate ic oc =
+let run_gzip_deflate ~level ic oc =
   let open Gz in
   let encoder =
-    Def.encoder `Manual `Manual ~q ~w:l ~level:0 ~mtime:(now ()) Gz.Unix in
+    Def.encoder `Manual `Manual ~q ~w:l ~level ~mtime:(now ()) Gz.Unix in
 
   let rec go encoder =
     match Def.encode encoder with
@@ -235,7 +235,7 @@ let run_lzo_inflate ic oc =
   | Ok str -> output_string oc str ; `Ok 0
   | Error err -> `Error (false, str "%a." Lzo.pp_error err)
 
-let run deflate format filename_ic filename_oc =
+let run deflate format level filename_ic filename_oc =
   let ic, close_ic =
     match filename_ic with
     | Some filename ->
@@ -250,11 +250,11 @@ let run deflate format filename_ic filename_oc =
     | None -> stdout, ignore in
   let res =
     match deflate, format with
-    | true, `Deflate -> run_deflate ic oc
+    | true, `Deflate -> run_deflate ~level ic oc
     | false, `Deflate -> run_inflate ic oc
-    | true, `Zlib -> run_zlib_deflate ic oc
+    | true, `Zlib -> run_zlib_deflate ~level ic oc
     | false, `Zlib -> run_zlib_inflate ic oc
-    | true, `Gzip -> run_gzip_deflate ic oc
+    | true, `Gzip -> run_gzip_deflate ~level ic oc
     | false, `Gzip -> run_gzip_inflate ic oc
     | true, `Lzo -> run_lzo_deflate ic oc
     | false, `Lzo -> run_lzo_inflate ic oc in
@@ -285,6 +285,15 @@ let format =
 let input = Arg.(value & pos 0 (some file) None & info [] ~docv:"<filename>")
 let output = Arg.(value & pos 1 (some string) None & info [] ~docv:"<filename>")
 
+let level =
+  let parser str =
+    match int_of_string str with
+    | n when n >= 0 -> Ok n
+    | _ -> Error (`Msg "The compression level must be positive")
+    | exception _ -> Error (`Msg "Invalid level") in
+  let positive_int = Arg.conv (parser, Format.pp_print_int) in
+  Arg.(value & opt positive_int 4 & info ["l"; "level"] ~docv:"<level>")
+
 let command =
   let doc =
     "A tool to deflate/inflate a stream/file throught a specified format." in
@@ -305,9 +314,8 @@ let command =
         , "GZip is a file format based on the DEFLATE algorithm, which is a \
            combination of LZ77 and Huffman coding. It encodes few informations \
            such as: the timestamp, the filename, or the operating system \
-           (which operates the deflation). It generates\n\
-          \           a CRC-32 checksum at the end of the stream. It is \
-           described by the RFC 1952 \
+           (which operates the deflation). It generates a CRC-32 checksum at \
+           the end of the stream. It is described by the RFC 1952 \
            <https://datatracker.ietf.org/doc/html/rfc1952>." ); `Noblank
     ; `I
         ( "Zlib"
@@ -329,7 +337,7 @@ let command =
          \\$"; `S Manpage.s_bugs
     ; `P "Check bug reports at <https://github.com/mirage/decompress>"
     ] in
-  let term = Term.(ret (const run $ deflate $ format $ input $ output))
+  let term = Term.(ret (const run $ deflate $ format $ level $ input $ output))
   and info = Cmd.info "decompress" ~doc ~man in
   Cmd.v info term
 
diff --git a/fuzz/fuzz.ml b/fuzz/fuzz.ml
index f0992a8..185a23b 100644
--- a/fuzz/fuzz.ml
+++ b/fuzz/fuzz.ml
@@ -344,36 +344,30 @@ let () =
       Queue.push_exn q (Queue.literal s.[i])
     done in
 
-  let rec go = function
-    | `Ok -> Buffer.contents res
-    | `Partial -> assert false
-    | `Block -> (
+  let rec go last = function
+    | `Ok when last -> Buffer.contents res
+    | `Ok -> (
       match !payloads with
-      | [] ->
-        assert false (* XXX(dinosaure): or [{ kind= Flat 0; last= true; }] *)
-      | [x] ->
-        fill q x
-        ; payloads := []
-        ; go
-            (Def.encode encoder
-               (`Block {Def.kind= Def.Flat (String.length x); last= true}))
+      | [] -> assert false
       | x :: r ->
         fill q x
         ; payloads := r
-        ; go
-            (Def.encode encoder
-               (`Block {Def.kind= Def.Flat (String.length x); last= false})))
+        ; go last (Def.encode encoder `Flush))
+    | `Partial -> assert false
+    | `Block ->
+      let last = List.length !payloads <= 0 in
+      go last (Def.encode encoder (`Block {Def.kind= Def.Flat; last})) in
+  let res0 =
+    go false (Def.encode encoder (`Block {Def.kind= Def.Flat; last= false}))
   in
-  Queue.push_exn q Queue.eob
-  ; let res0 = go (Def.encode encoder `Flush) in
-    let buf1 = Buffer.create 4096 in
+  let buf1 = Buffer.create 4096 in
 
-    let flush b l =
-      for i = 0 to l - 1 do
-        Buffer.add_char buf1 b.{i}
-      done in
-    match Higher.of_string ~o ~w res0 ~flush with
-    | Ok () ->
-      Crowbar.check_eq ~eq:String.equal ~pp:pp_string ~cmp:String.compare
-        (Buffer.contents buf1) (String.concat "" inputs)
-    | Error (`Msg err) -> Crowbar.fail err
+  let flush b l =
+    for i = 0 to l - 1 do
+      Buffer.add_char buf1 b.{i}
+    done in
+  match Higher.of_string ~o ~w res0 ~flush with
+  | Ok () ->
+    Crowbar.check_eq ~eq:String.equal ~pp:pp_string ~cmp:String.compare
+      (Buffer.contents buf1) (String.concat "" inputs)
+  | Error (`Msg err) -> Crowbar.fail err
diff --git a/lib/de.ml b/lib/de.ml
index abbb801..0f399dd 100644
--- a/lib/de.ml
+++ b/lib/de.ml
@@ -2145,6 +2145,15 @@ module Queue = struct
     ; unsafe_set t.buf ((mask [@inlined]) t t.w) v
     ; t.w <- t.w + 1
 
+  let end_with_eob t =
+    if not (empty t) then
+      unsafe_get t.buf ((mask [@inlined]) t (t.w - 1)) == 256
+    else false
+
+  let rem_exn t n =
+    if size t >= n then t.w <- t.w - n
+    else invalid_arg "You requested too many commands to delete"
+
   let pop_exn t =
     if (empty [@inlined]) t then raise Empty
     ; let r = unsafe_get t.buf ((mask [@inlined]) t t.r) in
@@ -2327,13 +2336,13 @@ module Def = struct
 
   let invalid_encode () = invalid_arg "expected `Await encode"
 
-  type kind = Flat of int | Fixed | Dynamic of dynamic
+  type kind = Flat | Fixed | Dynamic of dynamic
   type block = {kind: kind; last: bool}
   type encode = [ `Await | `Flush | `Block of block ]
 
   let exists v block =
     match v, block.kind with
-    | (`Copy _ | `End), Flat _ ->
+    | (`Copy _ | `End), Flat ->
       invalid_arg "copy code in flat block can not exist"
     | `Literal chr, Dynamic dynamic ->
       dynamic.ltree.T.tree.Lookup.t.(Char.code chr) lsr _max_bits > 0
@@ -2342,8 +2351,7 @@ module Def = struct
       (* assert (off >= 1 && off <= 32767 + 1) ; *)
       dynamic.ltree.T.tree.Lookup.t.(256 + 1 + _length.(len)) lsr _max_bits > 0
       && dynamic.dtree.T.tree.Lookup.t.(_distance (pred off)) lsr _max_bits > 0
-    | `End, (Fixed | Dynamic _) | `Literal _, (Flat _ | Fixed) | `Copy _, Fixed
-      ->
+    | `End, (Fixed | Dynamic _) | `Literal _, (Flat | Fixed) | `Copy _, Fixed ->
       true
 
   type encoder = {
@@ -2353,6 +2361,7 @@ module Def = struct
     ; mutable bits: int
     ; mutable bits_rem: [ `Rem of int | `Pending ]
     ; mutable flat: int
+    ; mutable fmax: int
     ; mutable o: bigstring
     ; mutable o_pos: int
     ; mutable o_max: int
@@ -2446,12 +2455,12 @@ module Def = struct
         c_byte (e.hold land 0xff) k e
       else k e
 
-  let encode_flat_header last len k e =
+  let encode_flat_header last k e =
     let k3 e =
       assert (o_rem e >= 4)
 
-      ; unsafe_set_uint16_le e.o (e.o_pos + 0) len
-      ; unsafe_set_uint16_le e.o (e.o_pos + 2) (lnot len)
+      ; unsafe_set_uint16_le e.o (e.o_pos + 0) e.fmax
+      ; unsafe_set_uint16_le e.o (e.o_pos + 2) (lnot e.fmax)
       ; e.o_pos <- e.o_pos + 4
       ; e.flat <- 0
 
@@ -2553,12 +2562,15 @@ module Def = struct
               e.k <- encode
               ; write e)
             e
-        | Flat len ->
-          encode_flat_header block.last len
-            (fun e ->
-              e.k <- encode
-              ; write_flat e)
-            e in
+        | Flat ->
+          if Queue.end_with_eob e.b then Queue.rem_exn e.b 1
+          ; let len = min (Queue.length e.b) 0xffff in
+            e.fmax <- len
+            ; encode_flat_header block.last
+                (fun e ->
+                  e.k <- encode
+                  ; write_flat e)
+                e in
       e.blk <- block
       ; k e
     | (`Flush | `Await) as v -> encode e v
@@ -2799,36 +2811,45 @@ module Def = struct
       ; emit e
 
       ; block e (`Block blk)
-    | _ -> assert false
+    | {kind= Flat; _} ->
+      emit e
+      ; block e (`Block blk)
 
   (* XXX(dinosaure): should never occur! *)
   and write_flat e =
-    let[@warning "-8"] (Flat max) = e.blk.kind in
-
     let o_pos = ref e.o_pos in
     let flat = ref e.flat in
 
     while
-      e.o_max - !o_pos + 1 > 1 && (not (Queue.is_empty e.b)) && !flat < max
+      e.o_max - !o_pos + 1 > 0 && (not (Queue.is_empty e.b)) && !flat < e.fmax
     do
       let cmd = Queue.pop_exn e.b in
 
-      if (not (cmd land 0x2000000 == 0)) || cmd == 256 then
-        invalid_arg "Impossible to emit a copy code or a EOB in a Flat block"
-
-      ; unsafe_set_uint8 e.o !o_pos (cmd land 0xff)
-      ; incr o_pos
-      ; incr flat
+      if not (cmd land 0x2000000 == 0) then
+        invalid_arg "Impossible to emit a copy code in a Flat block (%08x)" cmd
+      ; if not (cmd == 256) then (
+          unsafe_set_uint8 e.o !o_pos (cmd land 0xff)
+          ; incr o_pos
+          ; incr flat)
     done
 
     ; e.flat <- !flat
     ; e.o_pos <- !o_pos
 
-    ; if !flat == max then
-        if e.blk.last then flush (fun _ -> `Ok) e
-        else (
-          e.k <- block
-          ; `Block)
+    ; if !flat == e.fmax then begin
+        e.fmax <- 0
+        ; (* XXX(dinosaure): clean it! *)
+          if e.blk.last then flush (fun _ -> `Ok) e
+          else (
+            e.k <-
+              (fun e v ->
+                match v with
+                | `Block _ -> block e v
+                | _ ->
+                  e.k <- block
+                  ; `Block)
+            ; `Ok)
+      end
       else if o_rem e == 0 then flush write_flat e
       else `Ok
 
@@ -2839,26 +2860,18 @@ module Def = struct
       ; `Ok (* XXX(dinosaure): do nothing. *)
     | `Flush -> (
       match e.blk.kind with
-      | Flat _ -> write_flat e
+      | Flat -> write_flat e
       | Dynamic _ | Fixed -> write e)
-    | `Block blk -> (
+    | `Block blk ->
       if e.blk.last then
         invalid_arg
           "Impossible to make a new block when the current block is the last \
            one"
 
-      ; match e.blk.kind with
-        | Flat max ->
-          if e.flat < max then
-            invalid_arg
-              "Impossible to make a new block when the current Flat block is \
-               not fully filled"
+      ; if o_rem e > 1 then force blk e else flush (fun e -> force blk e) e
 
-          ; block e (`Block blk)
-        | Dynamic _ | Fixed ->
-          if o_rem e > 1 then force blk e else flush (fun e -> force blk e) e)
-
-  let first_entry e = function
+  let first_entry e v =
+    match v with
     | `Block blk ->
       e.k <- encode
       ; block e (`Block blk)
@@ -2876,12 +2889,15 @@ module Def = struct
             e.k <- encode
             ; encode e v)
           e
-      | Flat len ->
-        encode_flat_header e.blk.last len
-          (fun e ->
-            e.k <- encode
-            ; encode e v)
-          e)
+      | Flat ->
+        if Queue.end_with_eob e.b then Queue.rem_exn e.b 1
+        ; let len = min (Queue.length e.b) 0xffff in
+          e.fmax <- len
+          ; encode_flat_header e.blk.last
+              (fun e ->
+                e.k <- encode
+                ; encode e v)
+              e)
 
   let dst_rem d = o_rem d
 
@@ -2903,6 +2919,7 @@ module Def = struct
     ; bits= 0
     ; bits_rem= `Pending
     ; flat= 0
+    ; fmax= 0
     ; o
     ; o_pos
     ; o_max
@@ -3893,22 +3910,36 @@ module Lz77 = struct
   let ( .![] ) buf pos = unsafe_get_uint16 buf pos
   let ( .!{} ) buf pos = unsafe_get_uint8 buf pos
 
-  type configuration = {
+  type deflate_configuration = {
       max_chain: int
     ; max_lazy: int
     ; good_length: int
     ; nice_length: int
   }
 
-  let _1 = {good_length= 4; max_lazy= 4; nice_length= 8; max_chain= 4}
-  let _2 = {good_length= 4; max_lazy= 5; nice_length= 16; max_chain= 8}
-  let _3 = {good_length= 4; max_lazy= 6; nice_length= 32; max_chain= 32}
-  let _4 = {good_length= 4; max_lazy= 4; nice_length= 16; max_chain= 16}
-  let _5 = {good_length= 8; max_lazy= 16; nice_length= 32; max_chain= 32}
-  let _6 = {good_length= 8; max_lazy= 16; nice_length= 128; max_chain= 128}
-  let _7 = {good_length= 8; max_lazy= 32; nice_length= 128; max_chain= 256}
-  let _8 = {good_length= 32; max_lazy= 128; nice_length= 258; max_chain= 1024}
-  let _9 = {good_length= 32; max_lazy= 258; nice_length= 258; max_chain= 4096}
+  type configuration = Copy | Deflate of deflate_configuration
+
+  let _0 = Copy
+  let _1 = Deflate {good_length= 4; max_lazy= 4; nice_length= 8; max_chain= 4}
+  let _2 = Deflate {good_length= 4; max_lazy= 5; nice_length= 16; max_chain= 8}
+  let _3 = Deflate {good_length= 4; max_lazy= 6; nice_length= 32; max_chain= 32}
+  let _4 = Deflate {good_length= 4; max_lazy= 4; nice_length= 16; max_chain= 16}
+
+  let _5 =
+    Deflate {good_length= 8; max_lazy= 16; nice_length= 32; max_chain= 32}
+
+  let _6 =
+    Deflate {good_length= 8; max_lazy= 16; nice_length= 128; max_chain= 128}
+
+  let _7 =
+    Deflate {good_length= 8; max_lazy= 32; nice_length= 128; max_chain= 256}
+
+  let _8 =
+    Deflate {good_length= 32; max_lazy= 128; nice_length= 258; max_chain= 1024}
+
+  let _9 =
+    Deflate {good_length= 32; max_lazy= 258; nice_length= 258; max_chain= 4096}
+
   let _mem_level = 8 (* default *)
   let _hash_bits = _mem_level + 7
   let _hash_size = 1 lsl _hash_bits
@@ -3955,7 +3986,7 @@ module Lz77 = struct
    * and its distance is <= _max_dist
    * prev_length >= 1
    * len >= _min_lookahead *)
-  let longest_match cfg s cur_match =
+  let longest_match (cfg : deflate_configuration) s cur_match =
     let wmask = (1 lsl s.wbits) - 1 in
     let str_end = s.strstart + (_max_match - 1) in
     let limit = if s.strstart > max_dist s then s.strstart - max_dist s else 0 in
@@ -4143,8 +4174,11 @@ module Lz77 = struct
     let wsize = 1 lsl s.wbits in
     let wmask = wsize - 1 in
     let more = (wsize * 2) - s.lookahead - s.strstart in
-    let deflate =
-      match s.level with 1 | 2 | 3 -> deflate_fast | _ -> deflate_slow in
+    let deflate cfg s =
+      match cfg, s.level with
+      | Copy, _ -> copy s
+      | Deflate deflate_cfg, (1 | 2 | 3) -> deflate_fast deflate_cfg s
+      | Deflate deflate_cfg, _ -> deflate_slow deflate_cfg s in
     (* max *)
     let more =
       if s.strstart >= wsize + max_dist s then begin
@@ -4188,14 +4222,15 @@ module Lz77 = struct
           else deflate cfg s
       with Break -> deflate cfg s
 
-  and enough cfg s =
+  and enough (cfg : configuration) s =
     if s.lookahead < _min_lookahead then fill_window cfg s
     else
-      match s.level with
-      | 1 | 2 | 3 -> deflate_fast cfg s
-      | _ -> deflate_slow cfg s
+      match cfg, s.level with
+      | Copy, _ -> copy s
+      | Deflate deflate_cfg, (1 | 2 | 3) -> deflate_fast deflate_cfg s
+      | Deflate deflate_cfg, _ -> deflate_slow deflate_cfg s
 
-  and deflate_fast cfg s =
+  and deflate_fast (cfg : deflate_configuration) s =
     let hash_head = ref 0 in
     let flush = ref false in
     if s.lookahead >= _min_match then hash_head := insert_string s s.strstart
@@ -4233,9 +4268,9 @@ module Lz77 = struct
       | true ->
         s.k <- enough
         ; `Flush
-      | false -> enough cfg s
+      | false -> enough (Deflate cfg) s
 
-  and deflate_slow cfg s =
+  and deflate_slow (cfg : deflate_configuration) s =
     let hash_head = ref 0 in
     if s.lookahead >= _min_match then hash_head := insert_string s s.strstart
     ; s.prev_length <- s.match_length
@@ -4275,7 +4310,7 @@ module Lz77 = struct
         ; if flush then (
             s.k <- enough
             ; `Flush)
-          else enough cfg s
+          else enough (Deflate cfg) s
       end
       else if s.match_available then begin
         match emit_literal s (unsafe_get_char s.w (s.strstart - 1)) with
@@ -4287,15 +4322,28 @@ module Lz77 = struct
         | false ->
           s.strstart <- s.strstart + 1
           ; s.lookahead <- s.lookahead - 1
-          ; enough cfg s
+          ; enough (Deflate cfg) s
       end
       else begin
         s.match_available <- true
         ; s.strstart <- s.strstart + 1
         ; s.lookahead <- s.lookahead - 1
-        ; enough cfg s
+        ; enough (Deflate cfg) s
       end
 
+  and copy s =
+    let flush = ref (Queue.available s.q <= 1) in
+    while (not !flush) && s.lookahead > 0 do
+      flush := emit_literal s (unsafe_get_char s.w s.strstart)
+      ; s.strstart <- s.strstart + 1
+      ; s.lookahead <- s.lookahead - 1
+    done
+    ; match !flush with
+      | true ->
+        s.k <- enough
+        ; `Flush
+      | false -> enough Copy s
+
   let _literals = 256
   let _length_codes = 29
   let _l_codes = _literals + 1 + _length_codes
@@ -4338,7 +4386,8 @@ module Lz77 = struct
     let wsize = 1 lsl wbits in
     let cfg =
       match level with
-      | 0 | 1 -> _1
+      | 0 -> _0
+      | 1 -> _1
       | 2 -> _2
       | 3 -> _3
       | 4 -> _4
@@ -4385,6 +4434,7 @@ module Lz77 = struct
   type window = bigstring
 
   let make_window ~bits = bigstring_create ((1 lsl bits) * 2)
+  let no_compression s = s.cfg = Copy
 end
 
 module Higher = struct
diff --git a/lib/de.mli b/lib/de.mli
index 405992a..80e9ca9 100644
--- a/lib/de.mli
+++ b/lib/de.mli
@@ -4,9 +4,36 @@
    codec to {{:#decode}decode} and {{:#encode}encode} DEFLATE encoding. It can
    efficiently work payload by payload without blocking IO.
 
-    Module provides {{:#compression}LZ77 compression} algorithm but let the
-   client to define his algorithm as long as he uses shared queue provided in
-   this module. *)
+    Module provides {{:#compression}LZ77 compression} algorithm but lets the
+   client to define his algorithm as long as he/she uses shared queue provided
+   in this module.
+
+    {1 Lz77 compression and huffman compression.}
+
+    [Lz77] does a compression such as it searches a repeated {i pattern} and
+   emits a [Copy] code (see {!type:Queue.cmd}) which tells us to copy a
+   previous pattern. For instance, this is an equivalence between a list
+   of {!type:Queue.cmd}s and a [string].
+
+    {[
+      let cmds = [ `Literal 'a'; `Copy (1, 3) ]
+      let results = "aaaa"
+    ]}
+
+     The goal of [Lz77] is to produce such list from a [string] to help then
+    a format such as [DEFLATE] to compress inputs.
+
+     [Def] does an huffman compression. From a list of {!type:Queue.cmd}, it
+    can calculate frequencies (see {!type:literals} and {!type:distances}) and
+    generate a smaller representation of the given {i alphabet}. Such
+    compression is available {i via} the {!const:Def.Fixed} or the
+    {!const:Def.Dynamic} block. The {!const:Def.Flat} block does a copy of any
+    literals into the output.
+
+     {b NOTE}: It's illegal to emit a [`Copy] {!type:Queue.cmd} and try to
+    serialize it with a {!const:Def.Flat} block. {!Queue.eob} is {b required}
+    for {!const:Def.Fixed} and {!const:Def.Dynamic} (to delimit the end of the
+    block) and ignored by the {!const:Def.Flat} block. *)
 
 (** {2 Prelude.}
 
@@ -212,6 +239,10 @@ module Queue : sig
   val eob : cmd
   (** [eob] is {i End Of Block} {!cmd}.*)
 
+  val end_with_eob : t -> bool
+  (** [end_with_eob t] returns [true] if the last inserted command
+      is {!eob}. Otherwise, it returns [false]. *)
+
   val cmd : [ `Literal of char | `Copy of int * int | `End ] -> cmd
   (** [cmd command] is {!cmd} from a human-readable value. *)
 
@@ -278,7 +309,7 @@ module Def : sig
 
   (** The type for DEFLATE header block. *)
   type kind =
-    | Flat of int
+    | Flat
         (** A [Flat len] block is a non-compressed block of [len] byte(s). After a
        {i flat} block, output is aligned on bytes. *)
     | Fixed
@@ -464,7 +495,20 @@ module Lz77 : sig
 
       The client can constrain lookup operation by a {i window}. Small window
      enforces {!compress} to emit small distances. However, large window allows
-     {!compress} to go furthermore to recognize a pattern which can be expensive. *)
+     {!compress} to go furthermore to recognize a pattern which can be expensive.
+
+      {b Level.}
+
+      [Lz77] has mainly 2 levels:
+      - [0] where we only copy inputs to outpus, we don't do a lookup
+      - [n] (to [9]) with a certain configuration of the lookup. The higher the
+        level, the longer it may take to find a pattern.
+
+      The [0] can be useful to {b only} {i pack} an input into a format such as
+      [DEFLATE] - as an already compressed document such as a video or an
+      image. Otherwise, [4] as the level is pretty common. *)
+
+  val no_compression : state -> bool
 end
 
 (** {2 Higher API.}
diff --git a/lib/gz.ml b/lib/gz.ml
index bd7dd3d..a9097e1 100644
--- a/lib/gz.ml
+++ b/lib/gz.ml
@@ -722,7 +722,8 @@ module Def = struct
     if o_rem e >= 8 then k e else flush checksum e
 
   let make_block ?(last = false) e =
-    if last = false then
+    if De.Lz77.no_compression e.s then {De.Def.kind= Flat; last}
+    else if last = false then
       let literals = De.Lz77.literals e.s in
       let distances = De.Lz77.distances e.s in
       let dynamic = De.Def.dynamic_of_frequencies ~literals ~distances in
diff --git a/lib/zl.ml b/lib/zl.ml
index a629a44..a838e03 100644
--- a/lib/zl.ml
+++ b/lib/zl.ml
@@ -498,7 +498,8 @@ module Def = struct
     if o_rem e >= 4 then k e else flush checksum e
 
   let make_block ?(last = false) e =
-    if last = false && e.dynamic then
+    if De.Lz77.no_compression e.s then {De.Def.kind= De.Def.Flat; last}
+    else if last = false && e.dynamic then
       let literals = De.Lz77.literals e.s in
       let distances = De.Lz77.distances e.s in
       let dynamic = De.Def.dynamic_of_frequencies ~literals ~distances in
@@ -574,7 +575,7 @@ module Def = struct
     ; o_pos
     ; o_len
     ; level=
-        (match level with 0 | 1 -> 0 | 2 | 3 | 4 | 5 -> 1 | 6 -> 2 | _ -> 3)
+        (match level with 0 -> 0 | 1 | 2 | 3 | 4 | 5 -> 1 | 6 -> 2 | _ -> 3)
     ; dynamic
     ; e= De.Def.encoder `Manual ~q
     ; s= De.Lz77.state ~level `Manual ~q ~w


Test patch:
diff --git a/test/bin/bindings.t b/test/bin/bindings.t
index fcd757c..b49ef68 100644
--- a/test/bin/bindings.t
+++ b/test/bin/bindings.t
@@ -23,7 +23,7 @@ Test reverse bindings
   >   return (0);
   > }
   > EOF
-  $ cc -o a.out main.c -I$(ocamlopt -where) -L../../bindings/stubs -I../../bindings/stubs -ldecompress -lm -ldl
+  $ cc -o a.out main.c -I$(ocamlopt -where) -L../../bindings/stubs -I../../bindings/stubs -ldecompress -lm -ldl 2> /dev/null
   $ ./a.out
   Hello World!
 
diff --git a/test/bin/simple.t b/test/bin/simple.t
index 73a6f40..c787ff2 100644
--- a/test/bin/simple.t
+++ b/test/bin/simple.t
@@ -20,3 +20,9 @@ Simple tests
   $ decompress -fzlib -d ../corpus/bib bib.zlib
   $ decompress -fzlib bib.zlib bib
   $ diff bib ../corpus/bib
+  $ decompress -fzlib -d --level 0 ../corpus/bib bib.zlib
+  $ decompress -fzlib bib.zlib bib
+  $ diff bib ../corpus/bib
+  $ decompress -fgzip -d --level 0 ../corpus/news news.gz
+  $ decompress -fgzip news.gz news
+  $ diff news ../corpus/news
diff --git a/test/test.ml b/test/test.ml
index 5d78bfa..879b54d 100644
--- a/test/test.ml
+++ b/test/test.ml
@@ -980,8 +980,7 @@ let flat () =
   let go = function
     | `Ok -> Buffer.contents b
     | `Partial | `Block -> assert false in
-  let res0 =
-    go (Def.encode encoder (`Block {Def.kind= Def.Flat 4; last= true})) in
+  let res0 = go (Def.encode encoder (`Block {Def.kind= Def.Flat; last= true})) in
   Alcotest.(check string)
     "deadbeef deflated" "\x01\x04\x00\xfb\xff\xde\xad\xbe\xef" res0
   ; let decoder = Inf.decoder (`String res0) ~w ~o in
@@ -1003,13 +1002,12 @@ let fixed_and_flat () =
     | `Ok -> Buffer.contents b
     | `Partial -> assert false
     | `Block ->
-      go
-        (Def.encode encoder
-           (`Block {Def.kind= Def.Flat (Queue.length q); last= true})) in
+      go (Def.encode encoder (`Block {Def.kind= Def.Flat; last= true})) in
   let res0 = go (Def.encode encoder `Flush) in
-  let decoder = Inf.decoder (`String res0) ~w ~o in
-  let res1 = unroll_inflate decoder in
-  Alcotest.(check string) "aaaadeadbeef" "aaaa\xde\xad\xbe\xef" res1
+  Fmt.epr ">>> %S\n%!" res0
+  ; let decoder = Inf.decoder (`String res0) ~w ~o in
+    let res1 = unroll_inflate decoder in
+    Alcotest.(check string) "aaaadeadbeef" "aaaa\xde\xad\xbe\xef" res1
 
 let flat_and_fixed () =
   Alcotest.test_case "flat+fixed" `Quick @@ fun () ->
@@ -1017,18 +1015,24 @@ let flat_and_fixed () =
     Queue.of_list
       [
         `Literal '\xDE'; `Literal '\xAD'; `Literal '\xBE'; `Literal '\xEF'
-      ; `Literal 'a'; `Copy (1, 3); `End
+      ; `Literal 'a'
       ] in
   let b = Buffer.create 16 in
   let encoder = Def.encoder (`Buffer b) ~q in
 
-  let rec go = function
-    | `Ok -> Buffer.contents b
+  let rec go0 = function
+    | `Ok ->
+      Queue.push_exn q (Queue.cmd (`Copy (1, 3)))
+      ; Queue.push_exn q Queue.eob
+      ; go1 (Def.encode encoder `Flush)
+    | `Partial | `Block -> assert false
+  and go1 = function
     | `Partial -> assert false
+    | `Ok -> Buffer.contents b
     | `Block ->
-      go (Def.encode encoder (`Block {Def.kind= Def.Fixed; last= true})) in
+      go0 (Def.encode encoder (`Block {Def.kind= Def.Fixed; last= true})) in
   let res0 =
-    go (Def.encode encoder (`Block {Def.kind= Def.Flat 4; last= false})) in
+    go0 (Def.encode encoder (`Block {Def.kind= Def.Flat; last= false})) in
   let decoder = Inf.decoder (`String res0) ~w ~o in
   let res1 = unroll_inflate decoder in
   Alcotest.(check string) "deadbeefaaaa" "\xde\xad\xbe\xefaaaa" res1
@@ -1276,7 +1280,7 @@ let gzip_compress_and_uncompress ~filename ic =
     let bf = Buffer.create 4096 in
     let encoder =
       Gz.Def.encoder (`Channel ic) `Manual ~filename ~mtime:0l Gz.Unix ~q ~w:l
-        ~level:0 in
+        ~level:4 in
     let decoder = Gz.Inf.decoder `Manual ~o in
 
     let rec go_encode decoder encoder =
@@ -1334,7 +1338,7 @@ let gzip_compress_and_uncompress ~filename ic =
 
 let zlib_compress_and_uncompress ic =
   De.Queue.reset q
-  ; let encoder = Zl.Def.encoder (`Channel ic) `Manual ~q ~w:l ~level:0 in
+  ; let encoder = Zl.Def.encoder (`Channel ic) `Manual ~q ~w:l ~level:4 in
     let decoder =
       Zl.Inf.decoder `Manual ~o ~allocate:(fun bits -> De.make_window ~bits)
     in
@@ -1731,7 +1735,7 @@ let test_generate_empty_gzip_with_name () =
   ; let buf = Buffer.create 16 in
     let encoder =
       Gz.Def.encoder (`String "") (`Buffer buf) ~filename:"foo" ~mtime:0l
-        Gz.Unix ~q ~w:l ~level:0 in
+        Gz.Unix ~q ~w:l ~level:4 in
     let go encoder =
       match Gz.Def.encode encoder with
       | `Await _ -> Alcotest.failf "Unexpected `Await signal"
@@ -1757,7 +1761,7 @@ let test_generate_foo_gzip () =
   ; let buf = Buffer.create 16 in
     let encoder =
       Gz.Def.encoder (`String "foo") (`Buffer buf) ~filename:"foo" ~mtime:0l
-        Gz.Unix ~q ~w:l ~level:0 in
+        Gz.Unix ~q ~w:l ~level:4 in
     let go encoder =
       match Gz.Def.encode encoder with
       | `Await _ -> Alcotest.failf "Unexpected `Await signal"
@@ -1785,7 +1789,7 @@ let test_with_camlzip () =
   let oc = open_out "foo.gz" in
   let encoder =
     Gz.Def.encoder (`String "foo") (`Channel oc) ~filename:"foo.gz" ~mtime:0l
-      Gz.Unix ~q ~w:l ~level:0 in
+      Gz.Unix ~q ~w:l ~level:4 in
   let go encoder =
     match Gz.Def.encode encoder with
     | `Await _ -> Alcotest.failf "Unexpected `Await signal"
@@ -1803,7 +1807,7 @@ let test_gzip_hcrc () =
   let oc = open_out "foo.gz" in
   let encoder =
     Gz.Def.encoder (`String "foo & bar") (`Channel oc) ~filename:"foo.gz"
-      ~mtime:0l Gz.Unix ~hcrc:true ~q ~w:l ~level:0 in
+      ~mtime:0l Gz.Unix ~hcrc:true ~q ~w:l ~level:4 in
   let go encoder =
     match Gz.Def.encode encoder with
     | `Await _ -> Alcotest.failf "Unexpected `Await signal"
@@ -1861,7 +1865,7 @@ let test_gzip_os v_os =
   let buf = Buffer.create 16 in
   let encoder =
     Gz.Def.encoder (`String input) (`Buffer buf) ~mtime:0l v_os ~hcrc:true ~q
-      ~w:l ~level:0 in
+      ~w:l ~level:4 in
   let go encoder =
     match Gz.Def.encode encoder with
     | `Await _ -> Alcotest.failf "Unexpected `Await signal"
diff --git a/test/test_deflate.ml b/test/test_deflate.ml
index 3aff3e6..be07093 100644
--- a/test/test_deflate.ml
+++ b/test/test_deflate.ml
@@ -107,7 +107,8 @@ let corpus =
 let () =
   Alcotest.run "lz"
     [
-      "1", List.map (deflate_with_level ~level:1) corpus
+      "0", List.map (deflate_with_level ~level:0) corpus
+    ; "1", List.map (deflate_with_level ~level:1) corpus
     ; "2", List.map (deflate_with_level ~level:2) corpus
     ; "3", List.map (deflate_with_level ~level:3) corpus
     ; "4", List.map (deflate_with_level ~level:4) corpus
diff --git a/test/test_ns.ml b/test/test_ns.ml
index 917deb3..c125e43 100644
--- a/test/test_ns.ml
+++ b/test/test_ns.ml
@@ -544,8 +544,7 @@ let flat () =
   let go = function
     | `Ok -> Buffer.contents b
     | `Partial | `Block -> assert false in
-  let res0 =
-    go (Def.encode encoder (`Block {Def.kind= Def.Flat 4; last= true})) in
+  let res0 = go (Def.encode encoder (`Block {Def.kind= Def.Flat; last= true})) in
   Alcotest.(check string)
     "deadbeef deflated" "\x01\x04\x00\xfb\xff\xde\xad\xbe\xef" res0
   ; let src = bigstring_of_string res0 in
@@ -574,9 +573,7 @@ let fixed_and_flat () =
     | `Ok -> Buffer.contents b
     | `Partial -> assert false
     | `Block ->
-      go
-        (Def.encode encoder
-           (`Block {Def.kind= Def.Flat (Queue.length q); last= true})) in
+      go (Def.encode encoder (`Block {Def.kind= Def.Flat; last= true})) in
   let res0 = go (Def.encode encoder `Flush) in
   let src = bigstring_of_string res0 in
   let res = Inf.Ns.inflate src dst in
@@ -595,18 +592,24 @@ let flat_and_fixed () =
     Queue.of_list
       [
         `Literal '\xDE'; `Literal '\xAD'; `Literal '\xBE'; `Literal '\xEF'
-      ; `Literal 'a'; `Copy (1, 3); `End
+      ; `Literal 'a'
       ] in
   let b = Buffer.create 16 in
   let encoder = Def.encoder (`Buffer b) ~q in
 
-  let rec go = function
-    | `Ok -> Buffer.contents b
+  let rec go0 = function
+    | `Ok ->
+      Queue.push_exn q (Queue.cmd (`Copy (1, 3)))
+      ; Queue.push_exn q Queue.eob
+      ; go0 (Def.encode encoder `Flush)
     | `Partial -> assert false
     | `Block ->
-      go (Def.encode encoder (`Block {Def.kind= Def.Fixed; last= true})) in
+      go1 (Def.encode encoder (`Block {Def.kind= Def.Fixed; last= true}))
+  and go1 = function
+    | `Partial | `Block -> assert false
+    | `Ok -> Buffer.contents b in
   let res0 =
-    go (Def.encode encoder (`Block {Def.kind= Def.Flat 4; last= false})) in
+    go0 (Def.encode encoder (`Block {Def.kind= Def.Flat; last= false})) in
 
   let src = bigstring_of_string res0 in
   let res = Inf.Ns.inflate src dst in