CCSDS 502.0-B-3 Orbit Ephemeris Message parser and interpolator
fix(ocaml-requests): update tests and fuzz for cstruct→Bytes migration
Test files still referenced Cstruct.t where the API now uses bytes.
Fixed all H2 frame, HPACK, client, and connection tests.
Fixed fuzz test. 330 tests pass.
+160
-150
+13
dune-project
+13
dune-project
···
2
2
(name oem)
3
3
(source (tangled gazagnaire.org/ocaml-oem))
4
4
(formatting (enabled_for ocaml))
5
+
6
+
(generate_opam_files true)
7
+
8
+
(license ISC)
9
+
(authors "Thomas Gazagnaire <thomas@gazagnaire.org>")
10
+
(maintainers "Thomas Gazagnaire <thomas@gazagnaire.org>")
11
+
12
+
(package
13
+
(name oem)
14
+
(synopsis "CCSDS 502.0-B-3 Orbit Ephemeris Message parser and interpolator")
15
+
(depends
16
+
fmt
17
+
ptime))
+3
-4
fuzz/fuzz_oem.ml
+3
-4
fuzz/fuzz_oem.ml
···
5
5
6
6
(** Fuzz tests for OEM parsing.
7
7
8
-
Key properties:
9
-
1. Parsing never crashes on arbitrary input
10
-
2. Successfully parsed OEM can always be interpolated without crash
11
-
3. Pretty-printer never crashes *)
8
+
Key properties: 1. Parsing never crashes on arbitrary input 2. Successfully
9
+
parsed OEM can always be interpolated without crash 3. Pretty-printer never
10
+
crashes *)
12
11
13
12
open Alcobar
14
13
+2
-2
fuzz/fuzz_oem.mli
+2
-2
fuzz/fuzz_oem.mli
···
1
1
(** Fuzz tests for OEM parsing and interpolation.
2
2
3
-
Tests crash safety on arbitrary KVN input and interpolation
4
-
with degenerate data. *)
3
+
Tests crash safety on arbitrary KVN input and interpolation with degenerate
4
+
data. *)
5
5
6
6
val suite : string * Alcobar.test_case list
7
7
(** [suite] is the OEM fuzz test suite. *)
+97
-106
lib/oem.ml
+97
-106
lib/oem.ml
···
10
10
(* ------------------------------------------------------------------ *)
11
11
12
12
type vec3 = { x : float; y : float; z : float }
13
-
14
-
type state_vector = {
15
-
epoch : Ptime.t;
16
-
pos : vec3;
17
-
vel : vec3;
18
-
}
19
-
20
-
type covariance = {
21
-
epoch : Ptime.t;
22
-
ref_frame : string;
23
-
matrix : float array;
24
-
}
13
+
type state_vector = { epoch : Ptime.t; pos : vec3; vel : vec3 }
14
+
type covariance = { epoch : Ptime.t; ref_frame : string; matrix : float array }
25
15
26
16
type metadata = {
27
17
object_name : string;
···
41
31
covariances : covariance list;
42
32
}
43
33
44
-
type header = {
45
-
version : string;
46
-
creation_date : string;
47
-
originator : string;
48
-
}
49
-
50
-
type t = {
51
-
header : header;
52
-
segments : segment list;
53
-
}
34
+
type header = { version : string; creation_date : string; originator : string }
35
+
type t = { header : header; segments : segment list }
54
36
55
37
type error =
56
38
| Unexpected_eof
···
62
44
63
45
let pp_error ppf = function
64
46
| Unexpected_eof -> Fmt.pf ppf "Unexpected end of file"
65
-
| Bad_keyword { line; got } ->
66
-
Fmt.pf ppf "Line %d: bad keyword %S" line got
67
-
| Bad_epoch { line; value } ->
68
-
Fmt.pf ppf "Line %d: bad epoch %S" line value
69
-
| Bad_float { line; value } ->
70
-
Fmt.pf ppf "Line %d: bad float %S" line value
47
+
| Bad_keyword { line; got } -> Fmt.pf ppf "Line %d: bad keyword %S" line got
48
+
| Bad_epoch { line; value } -> Fmt.pf ppf "Line %d: bad epoch %S" line value
49
+
| Bad_float { line; value } -> Fmt.pf ppf "Line %d: bad float %S" line value
71
50
| Missing_keyword kw -> Fmt.pf ppf "Missing required keyword %S" kw
72
51
| Bad_state_vector { line; expected; got } ->
73
52
Fmt.pf ppf "Line %d: expected %d fields, got %d" line expected got
···
76
55
(* Epoch parsing *)
77
56
(* ------------------------------------------------------------------ *)
78
57
79
-
(** Parse CCSDS epoch: "YYYY-MM-DDThh:mm:ss.sss" or "YYYY-MM-DD hh:mm:ss.sss". *)
58
+
(** Parse CCSDS epoch: "YYYY-MM-DDThh:mm:ss.sss" or "YYYY-MM-DD hh:mm:ss.sss".
59
+
*)
80
60
let parse_epoch s =
81
61
let s = String.trim s in
82
62
let rfc =
···
92
72
93
73
type line_content =
94
74
| Keyword of string * string (** KEY = VALUE *)
95
-
| Data of string (** Epoch + numeric data *)
96
-
| Blank (** Empty or comment *)
75
+
| Data of string (** Epoch + numeric data *)
76
+
| Blank (** Empty or comment *)
97
77
98
78
let classify_line s =
99
79
let s = String.trim s in
···
106
86
match String.index_opt s '=' with
107
87
| Some i ->
108
88
let key = String.trim (String.sub s 0 i) in
109
-
let value = String.trim (String.sub s (i + 1) (String.length s - i - 1)) in
89
+
let value =
90
+
String.trim (String.sub s (i + 1) (String.length s - i - 1))
91
+
in
110
92
Keyword (key, value)
111
93
| None -> Data s
112
94
113
-
type parser_state = {
114
-
lines : (int * string) array;
115
-
mutable pos : int;
116
-
}
95
+
type parser_state = { lines : (int * string) array; mutable pos : int }
117
96
118
97
let peek st =
119
-
if st.pos >= Array.length st.lines then None
120
-
else Some st.lines.(st.pos)
98
+
if st.pos >= Array.length st.lines then None else Some st.lines.(st.pos)
121
99
122
100
let advance st = st.pos <- st.pos + 1
123
101
···
146
124
let cont = ref true in
147
125
while !cont do
148
126
match peek st with
149
-
| Some (_, s) ->
150
-
(match classify_line s with
127
+
| Some (_, s) -> (
128
+
match classify_line s with
151
129
| Keyword ("CCSDS_OEM_VERS", v) ->
152
130
version := v;
153
131
advance st
···
162
140
| _ -> cont := false)
163
141
| None -> cont := false
164
142
done;
165
-
Ok { version = !version; creation_date = !creation_date;
166
-
originator = !originator }
143
+
Ok
144
+
{
145
+
version = !version;
146
+
creation_date = !creation_date;
147
+
originator = !originator;
148
+
}
167
149
168
-
(** Parse a metadata block (META_START ... META_STOP). *)
169
150
type meta_acc = {
170
151
mutable m_object_name : string;
171
152
mutable m_object_id : string;
···
177
158
mutable m_interpolation : string option;
178
159
mutable m_interp_degree : int option;
179
160
}
161
+
(** Parse a metadata block (META_START ... META_STOP). *)
180
162
181
163
let set_meta_field acc key value =
182
164
match key with
···
185
167
| "CENTER_NAME" -> acc.m_center_name <- value
186
168
| "REF_FRAME" -> acc.m_ref_frame <- value
187
169
| "TIME_SYSTEM" -> acc.m_time_system <- value
188
-
| "START_TIME" ->
189
-
(match parse_epoch value with Some t -> acc.m_start_time <- t | None -> ())
190
-
| "STOP_TIME" ->
191
-
(match parse_epoch value with Some t -> acc.m_stop_time <- t | None -> ())
170
+
| "START_TIME" -> (
171
+
match parse_epoch value with
172
+
| Some t -> acc.m_start_time <- t
173
+
| None -> ())
174
+
| "STOP_TIME" -> (
175
+
match parse_epoch value with Some t -> acc.m_stop_time <- t | None -> ())
192
176
| "INTERPOLATION" -> acc.m_interpolation <- Some value
193
177
| "INTERPOLATION_DEGREE" ->
194
178
acc.m_interp_degree <-
···
216
200
| _ -> ());
217
201
let acc =
218
202
{
219
-
m_object_name = ""; m_object_id = ""; m_center_name = "EARTH";
220
-
m_ref_frame = "EME2000"; m_time_system = "UTC";
221
-
m_start_time = Ptime.epoch; m_stop_time = Ptime.epoch;
222
-
m_interpolation = None; m_interp_degree = None;
203
+
m_object_name = "";
204
+
m_object_id = "";
205
+
m_center_name = "EARTH";
206
+
m_ref_frame = "EME2000";
207
+
m_time_system = "UTC";
208
+
m_start_time = Ptime.epoch;
209
+
m_stop_time = Ptime.epoch;
210
+
m_interpolation = None;
211
+
m_interp_degree = None;
223
212
}
224
213
in
225
214
let cont = ref true in
226
215
while !cont do
227
216
match peek st with
228
-
| Some (_, s) ->
229
-
(match classify_line s with
230
-
| Keyword ("META_STOP", _) -> advance st; cont := false
217
+
| Some (_, s) -> (
218
+
match classify_line s with
219
+
| Keyword ("META_STOP", _) ->
220
+
advance st;
221
+
cont := false
231
222
| Keyword ("COMMENT", _) -> advance st
232
-
| Keyword (k, v) -> set_meta_field acc k v; advance st
223
+
| Keyword (k, v) ->
224
+
set_meta_field acc k v;
225
+
advance st
233
226
| Blank -> advance st
234
227
| Data _ -> cont := false)
235
228
| None -> cont := false
236
229
done;
237
230
meta_acc_to_metadata acc
238
231
239
-
(** Parse state vector data lines until next META_START or COVARIANCE_START
240
-
or end of file. *)
232
+
(** Parse state vector data lines until next META_START or COVARIANCE_START or
233
+
end of file. *)
241
234
let parse_data st =
242
235
skip_blanks st;
243
236
let vectors = ref [] in
244
237
let cont = ref true in
245
238
while !cont do
246
239
match peek st with
247
-
| Some (n, s) ->
240
+
| Some (n, s) -> (
248
241
let trimmed = String.trim s in
249
-
if trimmed = "META_START" || trimmed = "COVARIANCE_START"
250
-
|| trimmed = "" then
251
-
cont := false
242
+
if
243
+
trimmed = "META_START" || trimmed = "COVARIANCE_START" || trimmed = ""
244
+
then cont := false
252
245
else
253
-
(match classify_line s with
246
+
match classify_line s with
254
247
| Keyword _ -> cont := false
255
248
| Blank -> advance st
256
-
| Data d ->
249
+
| Data d -> (
257
250
let parts =
258
251
String.split_on_char ' ' d
259
252
|> List.filter (fun s -> String.length (String.trim s) > 0)
260
253
in
261
-
(match parts with
262
-
| epoch_s :: nums when List.length nums >= 6 ->
263
-
(match parse_epoch epoch_s with
254
+
match parts with
255
+
| epoch_s :: nums when List.length nums >= 6 -> (
256
+
match parse_epoch epoch_s with
264
257
| Some epoch ->
265
258
let floats =
266
259
List.map
267
-
(fun s -> try float_of_string s with Failure _ -> 0.)
260
+
(fun s ->
261
+
try float_of_string s with Failure _ -> 0.)
268
262
nums
269
263
in
270
264
let a = Array.of_list floats in
···
342
336
(* Hermite interpolation *)
343
337
(* ------------------------------------------------------------------ *)
344
338
345
-
(** Hermite interpolation between two state vectors.
346
-
Given (pos0, vel0) at t0 and (pos1, vel1) at t1,
347
-
interpolate position and velocity at t in [t0, t1]. *)
339
+
(** Hermite interpolation between two state vectors. Given (pos0, vel0) at t0
340
+
and (pos1, vel1) at t1, interpolate position and velocity at t in [t0, t1].
341
+
*)
348
342
let hermite_interp (sv0 : state_vector) (sv1 : state_vector) t =
349
343
let t0 = Ptime.to_float_s sv0.epoch in
350
344
let t1 = Ptime.to_float_s sv1.epoch in
···
364
358
(h00 *. p0) +. (h10 *. dt *. v0) +. (h01 *. p1) +. (h11 *. dt *. v1)
365
359
in
366
360
let vel_component p0 v0 p1 v1 =
367
-
let dh00 = (6. *. tau2 -. 6. *. tau) /. dt in
368
-
let dh10 = (3. *. tau2 -. 4. *. tau +. 1.) in
369
-
let dh01 = (-6. *. tau2 +. 6. *. tau) /. dt in
370
-
let dh11 = (3. *. tau2 -. 2. *. tau) in
361
+
let dh00 = ((6. *. tau2) -. (6. *. tau)) /. dt in
362
+
let dh10 = (3. *. tau2) -. (4. *. tau) +. 1. in
363
+
let dh01 = ((-6. *. tau2) +. (6. *. tau)) /. dt in
364
+
let dh11 = (3. *. tau2) -. (2. *. tau) in
371
365
(dh00 *. p0) +. (dh10 *. v0) +. (dh01 *. p1) +. (dh11 *. v1)
372
366
in
373
367
({
374
-
epoch = t;
375
-
pos =
376
-
{
377
-
x = interp_component sv0.pos.x sv0.vel.x sv1.pos.x sv1.vel.x;
378
-
y = interp_component sv0.pos.y sv0.vel.y sv1.pos.y sv1.vel.y;
379
-
z = interp_component sv0.pos.z sv0.vel.z sv1.pos.z sv1.vel.z;
380
-
};
381
-
vel =
382
-
{
383
-
x = vel_component sv0.pos.x sv0.vel.x sv1.pos.x sv1.vel.x;
384
-
y = vel_component sv0.pos.y sv0.vel.y sv1.pos.y sv1.vel.y;
385
-
z = vel_component sv0.pos.z sv0.vel.z sv1.pos.z sv1.vel.z;
386
-
};
387
-
} : state_vector)
368
+
epoch = t;
369
+
pos =
370
+
{
371
+
x = interp_component sv0.pos.x sv0.vel.x sv1.pos.x sv1.vel.x;
372
+
y = interp_component sv0.pos.y sv0.vel.y sv1.pos.y sv1.vel.y;
373
+
z = interp_component sv0.pos.z sv0.vel.z sv1.pos.z sv1.vel.z;
374
+
};
375
+
vel =
376
+
{
377
+
x = vel_component sv0.pos.x sv0.vel.x sv1.pos.x sv1.vel.x;
378
+
y = vel_component sv0.pos.y sv0.vel.y sv1.pos.y sv1.vel.y;
379
+
z = vel_component sv0.pos.z sv0.vel.z sv1.pos.z sv1.vel.z;
380
+
};
381
+
}
382
+
: state_vector)
388
383
389
384
(** Binary search for the interval containing time [t]. *)
390
385
let interval (data : state_vector array) t =
···
404
399
else hi := mid
405
400
done;
406
401
(* Check which interval *)
407
-
if Ptime.to_float_s data.(!lo).epoch <= t_s
408
-
&& t_s <= Ptime.to_float_s data.(!lo + 1).epoch then
409
-
Some !lo
410
-
else if !lo + 1 < n - 1
411
-
&& Ptime.to_float_s data.(!lo + 1).epoch <= t_s then
412
-
Some (!lo + 1)
413
-
else Some (Float.max 0. (Float.of_int (!lo)) |> Float.to_int)
402
+
if
403
+
Ptime.to_float_s data.(!lo).epoch <= t_s
404
+
&& t_s <= Ptime.to_float_s data.(!lo + 1).epoch
405
+
then Some !lo
406
+
else if !lo + 1 < n - 1 && Ptime.to_float_s data.(!lo + 1).epoch <= t_s
407
+
then Some (!lo + 1)
408
+
else Some (Float.max 0. (Float.of_int !lo) |> Float.to_int)
414
409
415
410
let interpolate seg t =
416
411
match interval seg.data t with
···
446
441
(min_t, max_t)
447
442
448
443
let object_name oem =
449
-
match oem.segments with
450
-
| seg :: _ -> seg.metadata.object_name
451
-
| [] -> ""
444
+
match oem.segments with seg :: _ -> seg.metadata.object_name | [] -> ""
452
445
453
446
let object_id oem =
454
-
match oem.segments with
455
-
| seg :: _ -> seg.metadata.object_id
456
-
| [] -> ""
447
+
match oem.segments with seg :: _ -> seg.metadata.object_id | [] -> ""
457
448
458
449
(* ------------------------------------------------------------------ *)
459
450
(* Pretty-printing *)
···
462
453
let pp_vec3 ppf v = Fmt.pf ppf "(%.3f, %.3f, %.3f)" v.x v.y v.z
463
454
464
455
let pp_state_vector ppf (sv : state_vector) =
465
-
Fmt.pf ppf "%a pos=%a vel=%a"
466
-
(Ptime.pp_rfc3339 ()) sv.epoch pp_vec3 sv.pos pp_vec3 sv.vel
456
+
Fmt.pf ppf "%a pos=%a vel=%a" (Ptime.pp_rfc3339 ()) sv.epoch pp_vec3 sv.pos
457
+
pp_vec3 sv.vel
467
458
468
459
let pp_metadata ppf m =
469
-
Fmt.pf ppf "%s [%s] %s %s %a–%a" m.object_name m.object_id
470
-
m.ref_frame m.time_system (Ptime.pp_rfc3339 ()) m.start_time
471
-
(Ptime.pp_rfc3339 ()) m.stop_time
460
+
Fmt.pf ppf "%s [%s] %s %s %a–%a" m.object_name m.object_id m.ref_frame
461
+
m.time_system (Ptime.pp_rfc3339 ()) m.start_time (Ptime.pp_rfc3339 ())
462
+
m.stop_time
472
463
473
464
let pp ppf oem =
474
465
Fmt.pf ppf "OEM v%s by %s (%d segments)@," oem.header.version
+14
-30
lib/oem.mli
+14
-30
lib/oem.mli
···
1
1
(** CCSDS 502.0-B-3 Orbit Ephemeris Message (OEM) parser and interpolator.
2
2
3
-
Parses the KVN (Keyword=Value Notation) text format for orbit
4
-
ephemeris data. Provides Hermite interpolation between state vectors
5
-
for smooth position queries at arbitrary times.
3
+
Parses the KVN (Keyword=Value Notation) text format for orbit ephemeris
4
+
data. Provides Hermite interpolation between state vectors for smooth
5
+
position queries at arbitrary times.
6
6
7
-
Reference: {{:https://public.ccsds.org/Pubs/502x0b3e1.pdf}
8
-
CCSDS 502.0-B-3} Orbit Data Messages. *)
7
+
Reference: {{:https://public.ccsds.org/Pubs/502x0b3e1.pdf} CCSDS 502.0-B-3}
8
+
Orbit Data Messages. *)
9
9
10
10
(** {1 Types} *)
11
11
12
12
type vec3 = { x : float; y : float; z : float }
13
13
(** Position or velocity vector (km or km/s). *)
14
14
15
-
type state_vector = {
16
-
epoch : Ptime.t;
17
-
pos : vec3;
18
-
vel : vec3;
19
-
}
15
+
type state_vector = { epoch : Ptime.t; pos : vec3; vel : vec3 }
20
16
(** A single ephemeris data point: position and velocity at an epoch. *)
21
17
22
-
type covariance = {
23
-
epoch : Ptime.t;
24
-
ref_frame : string;
25
-
matrix : float array;
26
-
}
18
+
type covariance = { epoch : Ptime.t; ref_frame : string; matrix : float array }
27
19
(** Optional covariance matrix (upper triangle, 6x6 = 21 elements). *)
28
20
29
21
type metadata = {
···
46
38
}
47
39
(** One ephemeris segment (metadata + data + optional covariance). *)
48
40
49
-
type header = {
50
-
version : string;
51
-
creation_date : string;
52
-
originator : string;
53
-
}
41
+
type header = { version : string; creation_date : string; originator : string }
54
42
(** OEM file header. *)
55
43
56
-
type t = {
57
-
header : header;
58
-
segments : segment list;
59
-
}
44
+
type t = { header : header; segments : segment list }
60
45
(** A complete OEM file with header and one or more segments. *)
61
46
62
47
(** {1 Parsing} *)
···
84
69
(** {1 Interpolation} *)
85
70
86
71
val interpolate : segment -> Ptime.t -> state_vector option
87
-
(** [interpolate seg t] returns the interpolated state vector at time [t]
88
-
within segment [seg], or [None] if [t] is outside the segment's
89
-
time range. Uses Hermite interpolation for position continuity. *)
72
+
(** [interpolate seg t] returns the interpolated state vector at time [t] within
73
+
segment [seg], or [None] if [t] is outside the segment's time range. Uses
74
+
Hermite interpolation for position continuity. *)
90
75
91
76
val interpolate_all : t -> Ptime.t -> state_vector option
92
-
(** [interpolate_all oem t] searches all segments for one containing
93
-
time [t] and interpolates. Returns the first matching segment's
94
-
result. *)
77
+
(** [interpolate_all oem t] searches all segments for one containing time [t]
78
+
and interpolates. Returns the first matching segment's result. *)
95
79
96
80
(** {1 Queries} *)
97
81
+27
-2
oem.opam
+27
-2
oem.opam
···
1
1
# This file is generated by dune, edit dune-project instead
2
2
opam-version: "2.0"
3
-
name: "oem"
4
3
synopsis: "CCSDS 502.0-B-3 Orbit Ephemeris Message parser and interpolator"
5
-
depends: []
4
+
maintainer: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
5
+
authors: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
6
+
license: "ISC"
7
+
homepage: "https://tangled.org/gazagnaire.org/ocaml-oem"
8
+
bug-reports: "https://tangled.org/gazagnaire.org/ocaml-oem/issues"
9
+
depends: [
10
+
"dune" {>= "3.21"}
11
+
"fmt"
12
+
"ptime"
13
+
"odoc" {with-doc}
14
+
]
15
+
build: [
16
+
["dune" "subst"] {dev}
17
+
[
18
+
"dune"
19
+
"build"
20
+
"-p"
21
+
name
22
+
"-j"
23
+
jobs
24
+
"@install"
25
+
"@runtest" {with-test}
26
+
"@doc" {with-doc}
27
+
]
28
+
]
29
+
dev-repo: "git+https://tangled.org/gazagnaire.org/ocaml-oem"
30
+
x-maintenance-intent: ["(latest)"]
+4
-6
test/test_oem.ml
+4
-6
test/test_oem.ml
···
1
1
(** OEM parsing and interpolation tests.
2
2
3
-
Test vectors from CCSDS 502.0-B-3 Annex A (normative examples)
4
-
and real-world OEM files. *)
3
+
Test vectors from CCSDS 502.0-B-3 Annex A (normative examples) and
4
+
real-world OEM files. *)
5
5
6
6
let eps = 1e-3
7
7
···
51
51
Alcotest.(check string) "originator" "NASA/JPL" oem.header.originator;
52
52
Alcotest.(check int) "segments" 1 (List.length oem.segments);
53
53
let seg = List.hd oem.segments in
54
-
Alcotest.(check string) "name" "MARS GLOBAL SURVEYOR"
55
-
seg.metadata.object_name;
54
+
Alcotest.(check string) "name" "MARS GLOBAL SURVEYOR" seg.metadata.object_name;
56
55
Alcotest.(check int) "data points" 5 (Array.length seg.data);
57
56
let sv0 = seg.data.(0) in
58
57
check_float "pos.x" 2789.619 sv0.pos.x;
···
84
83
let test_leo () =
85
84
let oem = check_ok "parse" (Oem.of_string leo_oem) in
86
85
Alcotest.(check string) "name" "ISS (ZARYA)" (Oem.object_name oem);
87
-
Alcotest.(check int) "points" 6
88
-
(Array.length (List.hd oem.segments).data)
86
+
Alcotest.(check int) "points" 6 (Array.length (List.hd oem.segments).data)
89
87
90
88
let multi_segment =
91
89
{|CCSDS_OEM_VERS = 2.0