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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
(*─────────────────────────────────────────────────────────────────────────────┐
│ SPDX-FileCopyrightText: 2025 toastal <https://toast.al/contact/> │
│ SPDX-License-Identifier: LGPL-2.1-or-later WITH OCaml-LGPL-linking-exception │
└─────────────────────────────────────────────────────────────────────────────*)
module Hash = struct
type t = {
algorithm: Input.Hash.algorithm;
value: string;
}
[@@deriving show]
let make_from_opts blake3 sha256 sha512 =
match blake3, sha256, sha512 with
| Some value, None, None -> {algorithm = Input.Hash.BLAKE3; value}
| None, Some value, None -> {algorithm = Input.Hash.SHA256; value}
| None, None, Some value -> {algorithm = Input.Hash.SHA512; value}
| None, None, None ->
Jsont.Error.msgf Jsont.Meta.none "Missing supported hash type"
| _, _, _ ->
Jsont.Error.msgf Jsont.Meta.none "Multiple supported hash types; expecting just 1"
let add_jsont_case obj =
let open Jsont in
obj
|> Object.opt_mem "blake3" string
|> Object.opt_mem "sha256" string
|> Object.opt_mem "sha512" string
end
module File = struct
type t = {
path: string;
hash_value: string;
}
(* env can assert it is a path *)
let of_stdout ?env (stdout : string) : t option =
match String.split_on_char '\n' (String.trim stdout), env with
| hash_value :: path :: _, None ->
Some {path; hash_value}
| hash_value :: path :: _, Some env' when Option.is_some (Eio.Path.native (Eio.Path.(Eio.Stdenv.fs env' / path))) ->
Some {path; hash_value}
| _ ->
None
end
module Archive = struct
type t = {
path: string;
hash_value: string;
}
(* env can assert it is a path *)
let of_stdout ?env (stdout : string) : t option =
match String.split_on_char '\n' (String.trim stdout), env with
| hash_value :: path :: _, None ->
Some {path; hash_value}
| hash_value :: path :: _, Some env' when Option.is_some (Eio.Path.native (Eio.Path.(Eio.Stdenv.fs env' / path))) ->
Some {path; hash_value}
| _ ->
None
end
module Git = struct
type t = {
datetime: string option;
path: string;
rev: string;
hash: Hash.t;
}
[@@deriving make, show]
let jsont : t Jsont.t =
let open Jsont in
Object.map
~kind: "Prefetch_Git"
(fun path datetime rev blake3 sha256 sha512 ->
let hash = Hash.make_from_opts blake3 sha256 sha512 in
make ~path ?datetime ~rev ~hash ()
)
|> Object.mem "path" string ~enc: (fun i -> i.path)
|> Object.opt_mem "date" string ~enc: (fun i -> i.datetime)
|> Object.mem "rev" string ~enc: (fun i -> i.rev)
|> Hash.add_jsont_case
|> Object.finish
end
module Darcs = struct
type t = {
path: string;
datetime: string option;
context: string;
weak_hash: string;
hash: Hash.t;
}
[@@deriving make, show]
let jsont : t Jsont.t =
let open Jsont in
Object.map
~kind: "Prefetch_Darcs"
(fun path datetime context weak_hash blake3 sha256 sha512 ->
let hash = Hash.make_from_opts blake3 sha256 sha512 in
make ~path ?datetime ~context ~weak_hash ~hash ()
)
|> Object.mem "path" string ~enc: (fun i -> i.path)
|> Object.opt_mem "date" string ~enc: (fun i -> i.datetime)
|> Object.mem "context" string ~enc: (fun i -> i.context)
|> Object.mem "weak-hash" string ~enc: (fun i -> i.weak_hash)
|> Hash.add_jsont_case
|> Object.finish
end
module Pijul = struct
type t = {
path: string;
datetime: string option;
state: string;
hash: Hash.t
}
[@@deriving make, show]
let jsont : t Jsont.t =
let open Jsont in
Object.map
~kind: "Prefetch_Pijul"
(fun path datetime state blake3 sha256 sha512 ->
let hash = Hash.make_from_opts blake3 sha256 sha512 in
make ~path ?datetime ~state ~hash ()
)
|> Object.mem "path" string ~enc: (fun i -> i.path)
|> Object.opt_mem "date" string ~enc: (fun i -> i.datetime)
|> Object.mem "state" string ~enc: (fun i -> i.state)
|> Hash.add_jsont_case
|> Object.finish
end
|
