@@ -33,6 +33,62 @@ module None = struct
33
33
34
34
end
35
35
36
+ module M = struct
37
+
38
+ open Decompress
39
+
40
+ exception Deflate_error of Deflate. error
41
+
42
+ let deflate ?(level = 4 ) data =
43
+ let input_buffer = Bytes. create 0xFFFF in
44
+ let output_buffer = Bytes. create 0xFFFF in
45
+ let pos = ref 0 in
46
+ let res = Buffer. create (Cstruct. len data) in
47
+ Deflate. bytes input_buffer output_buffer (fun input_buffer -> function
48
+ | Some max ->
49
+ let n = min max (min 0xFFFF (Cstruct. len data - ! pos)) in
50
+ Cstruct. blit_to_string data ! pos input_buffer 0 n;
51
+ pos := ! pos + n;
52
+ n
53
+ | None ->
54
+ let n = min 0xFFFF (Cstruct. len data - ! pos) in
55
+ Cstruct. blit_to_string data ! pos input_buffer 0 n;
56
+ pos := ! pos + n;
57
+ n
58
+ ) (fun output_buffer len ->
59
+ Buffer. add_subbytes res output_buffer 0 len;
60
+ 0xFFFF )
61
+ (Deflate. default ~proof: B. proof_bytes level)
62
+ |> function
63
+ | Ok _ -> Buffer. contents res |> Cstruct. of_string
64
+ | Error exn -> raise (Deflate_error exn )
65
+
66
+ let inflate ?output_size (data :Mstruct.t ) =
67
+ let data = Mstruct. clone data in
68
+ let input_buffer = Bytes. create 0xFFFF in
69
+ let output_buffer = Bytes. create 0xFFFF in
70
+ let window = Window. create ~proof: B. proof_bytes in
71
+ let pos = ref 0 in
72
+ let res = match output_size with
73
+ | None -> Buffer. create (Mstruct. length data)
74
+ | Some n -> Buffer. create n
75
+ in
76
+ Inflate. bytes input_buffer output_buffer (fun input_buffer ->
77
+ let n = min 0xFFFF (Mstruct. length data - ! pos) in
78
+ let i = Mstruct. get_string data n in
79
+ Bytes. blit i 0 input_buffer 0 n;
80
+ pos := ! pos + n;
81
+ n
82
+ ) (fun output_buffer len ->
83
+ Buffer. add_subbytes res output_buffer 0 len;
84
+ 0xFFFF )
85
+ (Inflate. default window)
86
+ |> function
87
+ | Ok _ -> Some (Mstruct. of_string (Buffer. contents res))
88
+ | Error _ -> None
89
+
90
+ end
91
+
36
92
module type ZLIB = sig
37
93
38
94
exception Error of string * string
0 commit comments