[OCaml] High Intensity Training Online
feat store timestamps as UTC ISO 8601
Changed files
lib/app/codec.ml
@@ -165,13 +165,10 @@
165
165
(Prescription.Workout.name (Evidence.Workout.prescription workout)));
166
166
line (encode_clearance (Evidence.Workout.clearance workout));
167
167
line
168
Removed:
(Printf.sprintf "started\t%d"
169
Removed:
(Recovery.timestamp_to_unix_seconds
170
Removed:
(Evidence.Workout.started_at workout)));
168
Added:
(Printf.sprintf "started\t%s"
169
Added:
(Timestamp.encode (Evidence.Workout.started_at workout)));
171
170
(match Evidence.Workout.ended_at workout with
172
Removed:
| Some ended ->
173
Removed:
line
174
Removed:
(Printf.sprintf "ended\t%d" (Recovery.timestamp_to_unix_seconds ended))
171
Added:
| Some ended -> line (Printf.sprintf "ended\t%s" (Timestamp.encode ended))
175
172
| None -> ());
176
173
List.iter
177
174
(fun (slot, stimulus) -> line (encode_stimulus ~slot stimulus))
@@ -213,10 +210,10 @@
213
210
a_stimuli_rev = [];
214
211
}
215
212
216
Removed:
let parse_seconds label secs =
217
Removed:
match int_of_string_opt secs with
218
Removed:
| Some s -> Ok (Recovery.timestamp_of_unix_seconds s)
219
Removed:
| None -> Error (Malformed label)
213
Added:
let parse_timestamp label text =
214
Added:
match Timestamp.decode text with
215
Added:
| Ok timestamp -> Ok timestamp
216
Added:
| Error _ -> Error (Malformed label)
220
217
221
218
(* Fold one line into the accumulator. A line either sets a header field or
222
219
appends a stimulus; anything else is malformed. *)
@@ -226,12 +223,12 @@
226
223
| "clearance" :: rest ->
227
224
let* c = decode_clearance rest in
228
225
Ok { acc with a_clearance = Some c }
229
Removed:
| [ "started"; secs ] ->
230
Removed:
let* t = parse_seconds "started" secs in
231
Removed:
Ok { acc with a_started = Some t }
232
Removed:
| [ "ended"; secs ] ->
233
Removed:
let* t = parse_seconds "ended" secs in
234
Removed:
Ok { acc with a_ended = Some t }
226
Added:
| [ "started"; text ] ->
227
Added:
let* timestamp = parse_timestamp "started timestamp" text in
228
Added:
Ok { acc with a_started = Some timestamp }
229
Added:
| [ "ended"; text ] ->
230
Added:
let* timestamp = parse_timestamp "ended timestamp" text in
231
Added:
Ok { acc with a_ended = Some timestamp }
235
232
| "stimulus" :: rest ->
236
233
let* s = decode_stimulus rest in
237
234
Ok { acc with a_stimuli_rev = s :: acc.a_stimuli_rev }
@@ -357,20 +354,18 @@
357
354
| _ -> Error (Malformed (Printf.sprintf "signal %S" code))
358
355
359
356
let encode_feedback report =
360
Removed:
let reported_at =
361
Removed:
Recovery.timestamp_to_unix_seconds (Evidence.Feedback.reported_at report)
362
Removed:
in
357
Added:
let reported_at = Timestamp.encode (Evidence.Feedback.reported_at report) in
363
358
let signals =
364
359
String.concat "," (List.map signal_code (Evidence.Feedback.signals report))
365
360
in
366
Removed:
Printf.sprintf "%d\t%s" reported_at signals
361
Added:
Printf.sprintf "%s\t%s" reported_at signals
367
362
368
363
let decode_feedback text =
369
364
match String.split_on_char '\t' text with
370
Removed:
| [ secs; signals ] -> (
371
Removed:
match int_of_string_opt secs with
372
Removed:
| None -> Error (Malformed "feedback timestamp")
373
Removed:
| Some secs ->
365
Added:
| [ timestamp; signals ] -> (
366
Added:
match Timestamp.decode timestamp with
367
Added:
| Error _ -> Error (Malformed "feedback timestamp")
368
Added:
| Ok reported_at ->
374
369
let codes =
375
370
String.split_on_char ',' signals
376
371
|> List.filter (fun s -> String.length s > 0)
@@ -383,6 +378,5 @@
383
378
| Error _ as e -> e)
384
379
in
385
380
let* signals = go [] codes in
386
Removed:
let reported_at = Recovery.timestamp_of_unix_seconds secs in
387
381
Ok (Evidence.Feedback.make ~reported_at signals))
388
382
| _ -> Error (Malformed "feedback arity")
lib/app/migrations.ml
@@ -60,7 +60,7 @@
60
60
{|CREATE TABLE IF NOT EXISTS app_feedback (
61
61
trainee_id TEXT NOT NULL,
62
62
seq INTEGER NOT NULL,
63
Removed:
submitted_at INTEGER NOT NULL,
63
Added:
submitted_at TEXT NOT NULL,
64
64
message TEXT NOT NULL,
65
65
PRIMARY KEY (trainee_id, seq)
66
66
)|};
@@ -73,6 +73,55 @@
73
73
name = "application feedback votes";
74
74
statements =
75
75
[
76
Added:
{|CREATE TABLE IF NOT EXISTS app_feedback_vote (
77
Added:
feedback_trainee_id TEXT NOT NULL,
78
Added:
feedback_seq INTEGER NOT NULL,
79
Added:
voter_id TEXT NOT NULL,
80
Added:
PRIMARY KEY (feedback_trainee_id, feedback_seq, voter_id)
81
Added:
)|};
82
Added:
{|CREATE INDEX IF NOT EXISTS app_feedback_vote_by_voter
83
Added:
ON app_feedback_vote (voter_id)|};
84
Added:
];
85
Added:
};
86
Added:
{
87
Added:
version = 5;
88
Added:
name = "ISO 8601 UTC timestamps";
89
Added:
statements =
90
Added:
[
91
Added:
{|DROP TABLE IF EXISTS app_feedback_vote|};
92
Added:
{|DROP TABLE IF EXISTS app_feedback|};
93
Added:
{|DROP TABLE IF EXISTS feedback|};
94
Added:
{|DROP TABLE IF EXISTS workout|};
95
Added:
{|DROP TABLE IF EXISTS in_progress|};
96
Added:
{|CREATE TABLE IF NOT EXISTS in_progress (
97
Added:
trainee_id TEXT PRIMARY KEY,
98
Added:
encoded TEXT NOT NULL
99
Added:
)|};
100
Added:
{|CREATE TABLE IF NOT EXISTS workout (
101
Added:
id TEXT PRIMARY KEY,
102
Added:
trainee_id TEXT NOT NULL,
103
Added:
seq INTEGER NOT NULL,
104
Added:
encoded TEXT NOT NULL
105
Added:
)|};
106
Added:
{|CREATE INDEX IF NOT EXISTS workout_by_trainee
107
Added:
ON workout (trainee_id, seq DESC)|};
108
Added:
{|CREATE TABLE IF NOT EXISTS feedback (
109
Added:
trainee_id TEXT NOT NULL,
110
Added:
seq INTEGER NOT NULL,
111
Added:
encoded TEXT NOT NULL,
112
Added:
PRIMARY KEY (trainee_id, seq)
113
Added:
)|};
114
Added:
{|CREATE INDEX IF NOT EXISTS feedback_by_trainee
115
Added:
ON feedback (trainee_id, seq DESC)|};
116
Added:
{|CREATE TABLE IF NOT EXISTS app_feedback (
117
Added:
trainee_id TEXT NOT NULL,
118
Added:
seq INTEGER NOT NULL,
119
Added:
submitted_at TEXT NOT NULL,
120
Added:
message TEXT NOT NULL,
121
Added:
PRIMARY KEY (trainee_id, seq)
122
Added:
)|};
123
Added:
{|CREATE INDEX IF NOT EXISTS app_feedback_by_trainee
124
Added:
ON app_feedback (trainee_id, seq DESC)|};
76
125
{|CREATE TABLE IF NOT EXISTS app_feedback_vote (
77
126
feedback_trainee_id TEXT NOT NULL,
78
127
feedback_seq INTEGER NOT NULL,
lib/app/sqlite_repo.ml
@@ -88,12 +88,12 @@
88
88
"SELECT COALESCE(MAX(seq), 0) + 1 FROM app_feedback WHERE trainee_id = ?"
89
89
90
90
let insert_app_feedback =
91
Removed:
(t4 string int int string ->. unit)
91
Added:
(t4 string int string string ->. unit)
92
92
"INSERT INTO app_feedback (trainee_id, seq, submitted_at, message) \
93
93
VALUES (?, ?, ?, ?)"
94
94
95
95
let app_feedback =
96
Removed:
(unit ->* t7 string int string int string int int)
96
Added:
(unit ->* t7 string int string string string int int)
97
97
"SELECT f.trainee_id, f.seq, t.username, f.submitted_at, f.message, \
98
98
(SELECT COUNT(*) FROM app_feedback c WHERE c.trainee_id = \
99
99
f.trainee_id), (SELECT COUNT(*) FROM app_feedback_vote v WHERE \
@@ -372,10 +372,7 @@
372
372
>>= fun seq ->
373
373
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
374
374
Db.exec Q.insert_app_feedback
375
Removed:
( trainee,
376
Removed:
seq,
377
Removed:
Recovery.timestamp_to_unix_seconds submitted_at,
378
Removed:
message ))
375
Added:
(trainee, seq, Timestamp.encode submitted_at, message))
379
376
>|= fun () ->
380
377
Repository.
381
378
{
@@ -398,12 +395,18 @@
398
395
List.map
399
396
(fun (trainee, seq, author, submitted_at, message, contributions, upvotes)
400
397
->
398
Added:
let submitted_at =
399
Added:
match Timestamp.decode submitted_at with
400
Added:
| Ok timestamp -> timestamp
401
Added:
| Error _ ->
402
Added:
raise (Corrupt (Codec.Malformed "application feedback timestamp"))
403
Added:
in
401
404
Repository.
402
405
{
403
406
feedback_id = app_feedback_id (Printf.sprintf "%s:%d" trainee seq);
404
407
author;
405
408
contributions;
406
Removed:
submitted_at = Recovery.timestamp_of_unix_seconds submitted_at;
409
Added:
submitted_at;
407
410
message;
408
411
upvotes;
409
412
viewer_upvoted = List.mem (trainee, seq) voted;
lib/app/timestamp.ml
@@ -0,0 +1,73 @@
1
Added:
type error = Malformed of string
2
Added:
3
Added:
let pp_error ppf = function
4
Added:
| Malformed detail -> Format.fprintf ppf "malformed timestamp: %s" detail
5
Added:
6
Added:
let encode timestamp =
7
Added:
let time =
8
Added:
Unix.gmtime (float_of_int (Recovery.timestamp_to_unix_seconds timestamp))
9
Added:
in
10
Added:
Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ" (time.Unix.tm_year + 1900)
11
Added:
(time.Unix.tm_mon + 1) time.Unix.tm_mday time.Unix.tm_hour time.Unix.tm_min
12
Added:
time.Unix.tm_sec
13
Added:
14
Added:
let digit text index =
15
Added:
let value = Char.code text.[index] - Char.code '0' in
16
Added:
if value >= 0 && value <= 9 then Some value else None
17
Added:
18
Added:
let number text start length =
19
Added:
let rec loop index value =
20
Added:
if index = start + length then Some value
21
Added:
else
22
Added:
match digit text index with
23
Added:
| None -> None
24
Added:
| Some value' -> loop (index + 1) ((value * 10) + value')
25
Added:
in
26
Added:
loop start 0
27
Added:
28
Added:
(* Return the number of days from 1970-01-01 for a Gregorian date. *)
29
Added:
let days_from_civil year month day =
30
Added:
let year = year - if month <= 2 then 1 else 0 in
31
Added:
let era = if year >= 0 then year / 400 else (year - 399) / 400 in
32
Added:
let year_of_era = year - (era * 400) in
33
Added:
let month = month + if month > 2 then -3 else 9 in
34
Added:
let day_of_year = (((153 * month) + 2) / 5) + day - 1 in
35
Added:
let day_of_era =
36
Added:
(year_of_era * 365) + (year_of_era / 4) - (year_of_era / 100) + day_of_year
37
Added:
in
38
Added:
(era * 146097) + day_of_era - 719468
39
Added:
40
Added:
let decode text =
41
Added:
let malformed detail = Error (Malformed detail) in
42
Added:
if String.length text <> 20 then malformed "expected YYYY-MM-DDTHH:MM:SSZ"
43
Added:
else if
44
Added:
text.[4] <> '-'
45
Added:
|| text.[7] <> '-'
46
Added:
|| text.[10] <> 'T'
47
Added:
|| text.[13] <> ':'
48
Added:
|| text.[16] <> ':'
49
Added:
|| text.[19] <> 'Z'
50
Added:
then malformed "expected YYYY-MM-DDTHH:MM:SSZ"
51
Added:
else
52
Added:
match
53
Added:
( number text 0 4,
54
Added:
number text 5 2,
55
Added:
number text 8 2,
56
Added:
number text 11 2,
57
Added:
number text 14 2,
58
Added:
number text 17 2 )
59
Added:
with
60
Added:
| Some year, Some month, Some day, Some hour, Some minute, Some second ->
61
Added:
if
62
Added:
month < 1 || month > 12 || day < 1 || day > 31 || hour > 23
63
Added:
|| minute > 59 || second > 59
64
Added:
then malformed "timestamp component out of range"
65
Added:
else
66
Added:
let seconds =
67
Added:
(days_from_civil year month day * 86_400)
68
Added:
+ (hour * 3_600) + (minute * 60) + second
69
Added:
in
70
Added:
let timestamp = Recovery.timestamp_of_unix_seconds seconds in
71
Added:
if String.equal (encode timestamp) text then Ok timestamp
72
Added:
else malformed "invalid calendar date"
73
Added:
| _ -> malformed "timestamp contains a non-digit"
lib/app/timestamp.mli
@@ -0,0 +1,10 @@
1
Added:
(** Strict UTC Zulu timestamps used at persistence boundaries. *)
2
Added:
type error = Malformed of string
3
Added:
4
Added:
val encode : Recovery.timestamp -> string
5
Added:
(** Encode seconds as [YYYY-MM-DDTHH:MM:SSZ]. *)
6
Added:
7
Added:
val decode : string -> (Recovery.timestamp, error) result
8
Added:
(** Decode a strict UTC Zulu timestamp. *)
9
Added:
10
Added:
val pp_error : Format.formatter -> error -> unit
test/test_codec.ml
@@ -58,6 +58,33 @@
58
58
| Ok decoded -> decoded
59
59
| Error e -> Alcotest.failf "decode failed: %a" Codec.pp_error e
60
60
61
Added:
let timestamp_tests =
62
Added:
[
63
Added:
( "encodes Unix epoch in UTC Zulu form",
64
Added:
`Quick,
65
Added:
fun () ->
66
Added:
Alcotest.(check string)
67
Added:
"epoch" "1970-01-01T00:00:00Z"
68
Added:
(Timestamp.encode (at 0)) );
69
Added:
( "round-trips an ISO timestamp",
70
Added:
`Quick,
71
Added:
fun () ->
72
Added:
let original = at 1_700_000_000 in
73
Added:
match Timestamp.decode (Timestamp.encode original) with
74
Added:
| Ok decoded ->
75
Added:
Alcotest.(check int)
76
Added:
"same seconds"
77
Added:
(Recovery.timestamp_to_unix_seconds original)
78
Added:
(Recovery.timestamp_to_unix_seconds decoded)
79
Added:
| Error _ -> Alcotest.fail "expected a valid timestamp" );
80
Added:
( "rejects an invalid calendar date",
81
Added:
`Quick,
82
Added:
fun () ->
83
Added:
match Timestamp.decode "2024-02-30T00:00:00Z" with
84
Added:
| Error _ -> ()
85
Added:
| Ok _ -> Alcotest.fail "expected an invalid date" );
86
Added:
]
87
Added:
61
88
let codec_tests =
62
89
[
63
90
( "a finished workout round-trips faithfully",
@@ -157,4 +184,4 @@
157
184
(List.hd (Stimulus.efforts (List.hd (Workout.stimuli d))))) );
158
185
]
159
186
160
Removed:
let suite = [ ("codec", codec_tests) ]
187
Added:
let suite = [ ("timestamp", timestamp_tests); ("codec", codec_tests) ]