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
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
open Common_
open Proto.Trace
type t = span
type id = Span_id.t
type kind = Span_kind.t =
| Span_kind_unspecified
| Span_kind_internal
| Span_kind_server
| Span_kind_client
| Span_kind_producer
| Span_kind_consumer
type key_value =
string
* [ `Int of int
| `String of string
| `Bool of bool
| `Float of float
| `None
]
let[@inline] id self = Span_id.of_bytes self.span_id
let[@inline] trace_id self = Trace_id.of_bytes self.trace_id
let[@inline] is_not_dummy self = Span_id.is_valid (id self)
let pp = Proto.Trace.pp_span
let default_kind = ref Proto.Trace.Span_kind_unspecified
let make ?(kind = !default_kind) ?trace_state ?(attrs = []) ?(events = [])
?status ~trace_id ~id ?parent ?(links = []) ~start_time ~end_time name : t =
let trace_id = Trace_id.to_bytes trace_id in
let parent_span_id = Option.map Span_id.to_bytes parent in
let attributes = List.map Key_value.conv attrs in
let span =
make_span ~trace_id ?parent_span_id ~span_id:(Span_id.to_bytes id)
~attributes ~events ?trace_state ?status ~kind ~name ~links
~start_time_unix_nano:start_time ~end_time_unix_nano:end_time ()
in
span
let dummy : t =
Proto.Trace.make_span
~trace_id:Trace_id.(dummy |> to_bytes)
~span_id:Span_id.(dummy |> to_bytes)
()
let create_new ?kind ?(id = Span_id.create ()) ?trace_state ?attrs ?events
?status ~trace_id ?parent ?links ~start_time ~end_time name : t =
make ?kind ~id ~trace_id ?trace_state ?attrs ?events ?status ?parent ?links
~start_time ~end_time name
let attrs self = self.attributes |> List.rev_map Key_value.of_otel
let events self = self.events
let links self : Span_link.t list = self.links
let status self = self.status
let kind self =
let k = self.kind in
if k = Span_kind_unspecified then
None
else
Some k
let to_span_link (self : t) : Span_link.t =
make_span_link ~attributes:self.attributes
?flags:
(if span_has_flags self then
Some self.flags
else
None)
?dropped_attributes_count:
(if span_has_dropped_attributes_count self then
Some self.dropped_attributes_count
else
None)
?trace_state:
(if span_has_trace_state self then
Some self.trace_state
else
None)
~trace_id:self.trace_id ~span_id:self.span_id ()
let[@inline] to_span_ctx (self : t) : Span_ctx.t =
Span_ctx.make ~trace_id:(trace_id self) ~parent_id:(id self) ()
let[@inline] add_event self ev : unit =
if is_not_dummy self then span_set_events self (ev :: self.events)
let add_event' self ev : unit =
if is_not_dummy self then span_set_events self (ev () :: self.events)
let record_exception (self : t) (exn : exn) (bt : Printexc.raw_backtrace) : unit
=
if is_not_dummy self then (
let exn_msg = Printexc.to_string exn in
let ev =
Event.make "exception"
~attrs:
[
"exception.message", `String exn_msg;
"exception.type", `String (Printexc.exn_slot_name exn);
( "exception.stacktrace",
`String (Printexc.raw_backtrace_to_string bt) );
]
in
add_event self ev;
let status = make_status ~code:Status_code_error ~message:exn_msg () in
span_set_status self status
)
let add_attrs (self : t) (attrs : Key_value.t list) : unit =
if is_not_dummy self then (
let attrs = List.rev_map Key_value.conv attrs in
let attrs = List.rev_append attrs self.attributes in
span_set_attributes self attrs
)
let add_attrs' (self : t) (attrs : unit -> Key_value.t list) : unit =
if is_not_dummy self then (
let attrs = List.rev_map Key_value.conv (attrs ()) in
let attrs = List.rev_append attrs self.attributes in
span_set_attributes self attrs
)
let add_links (self : t) (links : Span_link.t list) : unit =
if is_not_dummy self && links <> [] then (
let links = List.rev_append links self.links in
span_set_links self links
)
let add_links' (self : t) (links : unit -> Span_link.t list) : unit =
if is_not_dummy self then (
let links = List.rev_append (links ()) self.links in
span_set_links self links
)
let set_status self st = if is_not_dummy self then span_set_status self st
let set_kind self k = if is_not_dummy self then span_set_kind self k
let k_ambient : t Context.key = Context.new_key ()