[OCaml] High Intensity Training Online
feat tag the stored workout layout with a version
A stored workout is one opaque text blob in a hand-rolled layout, and nothing in the blob said which layout. The schema migrations are versioned; the payload inside a row was not, so a future layout change could not tell old rows from new. Every encoded workout now opens with a version line, currently 1. A row with no version line predates the tag and carries this same layout, so every existing row still reads. A row naming a version this codec does not know is refused as Unsupported_version rather than misread, so a downgraded binary never corrupts what it does not understand. Bump current_version when the layout changes and keep a reader for every version still on disk.
lib/persistence/codec.ml
@@ -4,7 +4,14 @@
4
4
| Unknown_routine of string
5
5
| Unknown_workout_name of { routine : string; workout : string }
6
6
| Replay_rejected of string
7
Added:
| Unsupported_version of int
7
8
9
Added:
(* The layout this codec writes and reads. A stored record names its version on
10
Added:
its first line, so a future layout change can tell old rows from new. A row
11
Added:
with no version line predates the tag and carries this same layout. Bump this
12
Added:
when the layout changes, and keep a reader for every version still on disk. *)
13
Added:
let current_version = 1
14
Added:
8
15
let pp_error ppf = function
9
16
| Malformed detail -> Format.fprintf ppf "malformed record: %s" detail
10
17
| Unknown_exercise id -> Format.fprintf ppf "unknown exercise %S" id
@@ -13,6 +20,10 @@
13
20
Format.fprintf ppf "routine %S has no workout %S" routine workout
14
21
| Replay_rejected detail ->
15
22
Format.fprintf ppf "stored record rejected: %s" detail
23
Added:
| Unsupported_version n ->
24
Added:
Format.fprintf ppf
25
Added:
"record version %d is newer than this codec's version %d" n
26
Added:
current_version
16
27
17
28
(* --- extension and outcome codes --- *)
18
29
@@ -172,6 +183,7 @@
172
183
Buffer.add_string buf s;
173
184
Buffer.add_char buf '\n'
174
185
in
186
Added:
line (Printf.sprintf "version\t%d" current_version);
175
187
line (Printf.sprintf "routine\t%s" routine_name);
176
188
line
177
189
(Printf.sprintf "prescription\t%s"
@@ -229,8 +241,15 @@
229
241
| Error _ -> Error (Malformed label)
230
242
231
243
(* Fold one line into the accumulator. A line either sets a header field or
232
Removed:
appends a stimulus. Anything else is malformed. *)
244
Added:
appends a stimulus. Anything else is malformed. The version line, when
245
Added:
present, must be one this codec knows; a record from a newer codec is refused
246
Added:
rather than misread. *)
233
247
let step acc = function
248
Added:
| [ "version"; v ] -> (
249
Added:
match int_of_string_opt v with
250
Added:
| Some n when n = current_version -> Ok acc
251
Added:
| Some n -> Error (Unsupported_version n)
252
Added:
| None -> Error (Malformed (Printf.sprintf "version %S" v)))
234
253
| [ "routine"; name ] -> Ok { acc with a_routine = Some name }
235
254
| [ "prescription"; name ] -> Ok { acc with a_prescription = Some name }
236
255
| "clearance" :: rest ->
lib/persistence/codec.mli
@@ -18,12 +18,21 @@
18
18
| Unknown_workout_name of { routine : string; workout : string }
19
19
| Replay_rejected of string
20
20
(** The core refused a stored stimulus. The store is inconsistent. *)
21
Added:
| Unsupported_version of int
22
Added:
(** The record was written by a newer codec. It is refused rather than
23
Added:
misread, so a downgraded binary never corrupts what it does not
24
Added:
understand. *)
21
25
22
26
val pp_error : Format.formatter -> error -> unit
23
27
28
Added:
val current_version : int
29
Added:
(** The layout this codec writes. Every stored workout names its version on its
30
Added:
first line; a row without one predates the tag and carries this layout. *)
31
Added:
24
32
val encode_workout : routine_name:string -> Evidence.Workout.t -> string
25
Removed:
(** A stable, single-string encoding of a performed or in-progress workout.
26
Removed:
[routine_name] identifies the catalog routine the prescription came from. *)
33
Added:
(** A stable, single-string encoding of a performed or in-progress workout,
34
Added:
tagged with {!current_version}. [routine_name] identifies the catalog
35
Added:
routine the prescription came from. *)
27
36
28
37
val decode_workout :
29
38
find_routine:(string -> Prescription.Routine.t option) ->
test/test_codec.ml
@@ -138,6 +138,52 @@
138
138
match Codec.decode_workout ~find_routine encoded with
139
139
| Error (Codec.Unknown_routine "Nonexistent") -> ()
140
140
| _ -> Alcotest.fail "expected Unknown_routine" );
141
Added:
( "an encoded workout names its layout version on the first line",
142
Added:
`Quick,
143
Added:
fun () ->
144
Added:
let w = sample_workout () in
145
Added:
let encoded = Codec.encode_workout ~routine_name:"Ideal Routine" w in
146
Added:
let first = List.hd (String.split_on_char '\n' encoded) in
147
Added:
Alcotest.(check string)
148
Added:
"version line"
149
Added:
(Printf.sprintf "version\t%d" Codec.current_version)
150
Added:
first );
151
Added:
( "a legacy record with no version line still decodes",
152
Added:
`Quick,
153
Added:
fun () ->
154
Added:
(* Rows written before the tag carry the current layout unchanged. Strip
155
Added:
the version line from a fresh encoding to model one. *)
156
Added:
let w = sample_workout () in
157
Added:
let encoded = Codec.encode_workout ~routine_name:"Ideal Routine" w in
158
Added:
let legacy =
159
Added:
String.split_on_char '\n' encoded
160
Added:
|> List.filter (fun l ->
161
Added:
not (String.length l >= 7 && String.sub l 0 7 = "version"))
162
Added:
|> String.concat "\n"
163
Added:
in
164
Added:
match Codec.decode_workout ~find_routine legacy with
165
Added:
| Ok _ -> ()
166
Added:
| Error e -> Alcotest.failf "legacy decode failed: %a" Codec.pp_error e
167
Added:
);
168
Added:
( "a record from a newer codec is refused, not misread",
169
Added:
`Quick,
170
Added:
fun () ->
171
Added:
let w = sample_workout () in
172
Added:
let encoded = Codec.encode_workout ~routine_name:"Ideal Routine" w in
173
Added:
let newer =
174
Added:
Printf.sprintf "version\t%d\n" (Codec.current_version + 1)
175
Added:
^ (String.split_on_char '\n' encoded
176
Added:
|> List.filter (fun l ->
177
Added:
not (String.length l >= 7 && String.sub l 0 7 = "version"))
178
Added:
|> String.concat "\n")
179
Added:
in
180
Added:
match Codec.decode_workout ~find_routine newer with
181
Added:
| Error (Codec.Unsupported_version n) ->
182
Added:
Alcotest.(check int)
183
Added:
"names the version"
184
Added:
(Codec.current_version + 1)
185
Added:
n
186
Added:
| _ -> Alcotest.fail "expected Unsupported_version" );
141
187
( "a malformed line is reported as malformed",
142
188
`Quick,
143
189
fun () ->