1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
open! Awso.Import
open Values
type t =
{ number : int
; start_offset : int64
; size : int64
}
let number p = p.number + 1
let cons_maybe hdo tl =
match hdo with
| Some hd -> hd :: tl
| None -> tl
;;
let build_parts_from_size ~part_size size =
let open Int64 in
let num_parts = size / part_size in
let part_start_offset n = n * part_size in
let last_part_size = rem size part_size in
let last_part_opt =
if last_part_size = 0L
then None
else
Some
{ number = to_int_exn num_parts
; start_offset = part_start_offset num_parts
; size = last_part_size
}
in
let rec range_acc acc i =
if Int64.( >= ) i num_parts
then acc
else
range_acc
({ start_offset = part_start_offset i; size = part_size; number = to_int_exn i }
:: acc)
(Int64.succ i)
in
range_acc [] 0L |> cons_maybe last_part_opt |> List.rev
;;
let to_json { number; start_offset; size } : Yojson.Safe.t =
`Assoc
[ "number", `Int number
; "start_offset", `Intlit (Int64.to_string start_offset)
; "size", `Intlit (Int64.to_string size)
]
;;
let%expect_test "build_parts_from_size" =
let test ~part_size size =
build_parts_from_size ~part_size size
|> List.map ~f:to_json
|> (fun l -> `List l)
|> Yojson.Safe.to_string
|> print_endline
in
test ~part_size:10L 30L;
[%expect
{| [{"number":0,"start_offset":0,"size":10},{"number":1,"start_offset":10,"size":10},{"number":2,"start_offset":20,"size":10}] |}];
test ~part_size:10L 34L;
[%expect
{| [{"number":0,"start_offset":0,"size":10},{"number":1,"start_offset":10,"size":10},{"number":2,"start_offset":20,"size":10},{"number":3,"start_offset":30,"size":4}] |}];
test ~part_size:10L 0L;
[%expect {| [] |}];
test ~part_size:10L 1L;
[%expect {| [{"number":0,"start_offset":0,"size":1}] |}]
;;
let build_parts path =
let stat = Unix.LargeFile.stat path in
build_parts_from_size ~part_size:0x500000L stat.st_size
;;
type params =
{ bucket : string
; key : string
; uploadId : string
}
let params_of_creation { CreateMultipartUploadOutput.bucket; key; uploadId; _ } =
let message s =
Printf.sprintf "missing field in multipart upload creation output: %s" s
in
{ bucket = Option.value_exn ~message:(message "bucket") bucket
; key = Option.value_exn ~message:(message "key") key
; uploadId = Option.value_exn ~message:(message "uploadId") uploadId
}
;;
let upload_request ~creation ~path part =
let { bucket; key; uploadId } = params_of_creation creation in
let partNumber = number part in
let body_s =
In_channel.with_open_bin path (fun ic ->
In_channel.seek ic part.start_offset;
let len = Int64.to_int_exn part.size in
Stdlib.really_input_string ic len)
in
let body = Body.of_string body_s in
UploadPartRequest.make ~bucket ~key ~partNumber ~uploadId ~body ()
;;
let completed_part part { UploadPartOutput.eTag; _ } =
let partNumber = number part in
let eTag = Option.value_exn ~message:"no ETag in output" eTag in
CompletedPart.make ~eTag ~partNumber ()
;;
let complete_request ~creation ~parts =
let { bucket; key; uploadId } = params_of_creation creation in
let multipartUpload = CompletedMultipartUpload.make ~parts () in
CompleteMultipartUploadRequest.make ~multipartUpload ~bucket ~key ~uploadId ()
;;