OCaml library for controlling Meross smart plugs via local HTTP API
Squashed 'ocaml-meross/' content from commit 2b82bf06 git-subtree-split: 2b82bf06891bc02cd4a21b673d69f8127e192590
+3743
+15
.gitignore
+15
.gitignore
+1
.ocamlformat
+1
.ocamlformat
···
1
+
version = 0.28.1
+21
LICENSE.md
+21
LICENSE.md
···
1
+
MIT License
2
+
3
+
Copyright (c) 2025 Thomas Gazagnaire
4
+
5
+
Permission is hereby granted, free of charge, to any person obtaining a copy
6
+
of this software and associated documentation files (the "Software"), to deal
7
+
in the Software without restriction, including without limitation the rights
8
+
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
9
+
copies of the Software, and to permit persons to whom the Software is
10
+
furnished to do so, subject to the following conditions:
11
+
12
+
The above copyright notice and this permission notice shall be included in all
13
+
copies or substantial portions of the Software.
14
+
15
+
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16
+
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17
+
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18
+
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19
+
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20
+
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21
+
SOFTWARE.
+79
README.md
+79
README.md
···
1
+
# meross
2
+
3
+
Control Meross smart plugs over local HTTP API without cloud.
4
+
5
+
## Overview
6
+
7
+
This library provides local control of Meross smart plugs (MSS310, MSS315, etc.) via their HTTP API. No cloud account or internet connection required.
8
+
9
+
## Features
10
+
11
+
- Power control (on/off/toggle/reboot)
12
+
- Real-time electricity monitoring (voltage, current, power)
13
+
- Historical energy consumption
14
+
- Countdown timers
15
+
- Automation triggers
16
+
- LED control (Do Not Disturb mode)
17
+
- WiFi signal monitoring
18
+
- Matter pairing support
19
+
- Device discovery/scanning
20
+
21
+
## Installation
22
+
23
+
```
24
+
opam install meross
25
+
```
26
+
27
+
## Usage
28
+
29
+
```ocaml
30
+
Eio_main.run @@ fun env ->
31
+
Eio.Switch.run @@ fun sw ->
32
+
let net = Eio.Stdenv.net env in
33
+
34
+
(* Get device info *)
35
+
match Meross.get_info ~net ~sw "192.168.0.6" with
36
+
| Ok info -> Fmt.pr "%a@." Meross.pp_info info
37
+
| Error (`Msg e) -> Fmt.epr "Error: %s@." e
38
+
39
+
(* Control power *)
40
+
let _ = Meross.turn_on ~net ~sw "192.168.0.6" in
41
+
let _ = Meross.turn_off ~net ~sw "192.168.0.6" in
42
+
43
+
(* Get electricity reading *)
44
+
match Meross.get_electricity ~net ~sw "192.168.0.6" with
45
+
| Ok e -> Fmt.pr "Power: %.1f W@." (Meross.Electricity.power e)
46
+
| Error _ -> ()
47
+
```
48
+
49
+
## Modules
50
+
51
+
- `Meross.Protocol` - HTTP protocol and authentication
52
+
- `Meross.Device` - Device info and power control
53
+
- `Meross.Electricity` - Real-time power monitoring
54
+
- `Meross.Consumption` - Historical energy usage
55
+
- `Meross.Timers` - Countdown timers
56
+
- `Meross.Triggers` - Automation rules
57
+
- `Meross.Dnd` - LED control
58
+
- `Meross.Runtime` - WiFi signal and stats
59
+
- `Meross.Abilities` - Feature discovery
60
+
- `Meross.Commissioning` - Matter pairing
61
+
62
+
## Supported Devices
63
+
64
+
Tested with:
65
+
- MSS310 (Smart Plug with Energy Monitor)
66
+
- MSS315 (Smart Plug with Energy Monitor, Matter)
67
+
68
+
Should work with other Meross plugs that support local HTTP API.
69
+
70
+
## Related Work
71
+
72
+
- [meross-iot](https://github.com/albertogeniola/MerossIot) - Python library (cloud-based)
73
+
- [meross-cloud](https://www.home-assistant.io/integrations/meross/) - Home Assistant integration
74
+
75
+
This library focuses on local control without cloud dependencies.
76
+
77
+
## License
78
+
79
+
MIT License. See [LICENSE.md](LICENSE.md) for details.
+5
bin/dune
+5
bin/dune
+714
bin/main.ml
+714
bin/main.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Meross CLI - control Meross smart plugs over local HTTP API. *)
7
+
8
+
open Cmdliner
9
+
10
+
(* Target types for device selection *)
11
+
12
+
type target =
13
+
| All (** Discover all devices on local subnets *)
14
+
| Ips of Ipaddr.V4.t list (** One or more IP addresses *)
15
+
| Subnet of Ipaddr.V4.Prefix.t (** CIDR notation subnet *)
16
+
17
+
(* Parse a target specification: "all", comma-separated IPs, or CIDR *)
18
+
let parse_target s =
19
+
let s = String.trim s in
20
+
match String.lowercase_ascii s with
21
+
| "" | "all" -> Ok All
22
+
| _ -> (
23
+
(* Split by comma and parse each part *)
24
+
let parts = String.split_on_char ',' s |> List.map String.trim in
25
+
(* Check if first part is CIDR (only valid if single part) *)
26
+
if List.length parts = 1 && String.contains s '/' then
27
+
match Ipaddr.V4.Prefix.of_string s with
28
+
| Ok prefix -> Ok (Subnet prefix)
29
+
| Error (`Msg e) -> Error (Fmt.str "invalid CIDR '%s': %s" s e)
30
+
else
31
+
(* Parse as IP addresses *)
32
+
let parse_ip ip_str =
33
+
match Ipaddr.V4.of_string ip_str with
34
+
| Ok ip -> Either.Left ip
35
+
| Error (`Msg _) ->
36
+
Either.Right (Fmt.str "invalid IP address '%s'" ip_str)
37
+
in
38
+
match List.partition_map parse_ip parts with
39
+
| ips, [] -> Ok (Ips ips)
40
+
| _, err :: _ -> Error err)
41
+
42
+
(* Get local subnets from MEROSS_SUBNET env var or by detecting network interfaces *)
43
+
let get_local_subnets ~proc_mgr =
44
+
(* Check environment variable first *)
45
+
match Sys.getenv_opt "MEROSS_SUBNET" with
46
+
| Some s when String.length (String.trim s) > 0 ->
47
+
String.split_on_char ',' s |> List.map String.trim
48
+
| _ ->
49
+
(* Auto-detect from network interfaces *)
50
+
let run_cmd args =
51
+
Eio.Process.parse_out proc_mgr Eio.Buf_read.take_all args
52
+
in
53
+
(* Try to detect OS and parse accordingly *)
54
+
let lines =
55
+
try
56
+
(* macOS: ifconfig *)
57
+
let output = run_cmd [ "ifconfig" ] in
58
+
String.split_on_char '\n' output
59
+
with _ -> (
60
+
try
61
+
(* Linux: ip addr *)
62
+
let output = run_cmd [ "ip"; "addr" ] in
63
+
String.split_on_char '\n' output
64
+
with _ -> [])
65
+
in
66
+
(* Extract IPv4 addresses that look like private network addresses *)
67
+
let extract_subnet line =
68
+
(* Look for "inet X.X.X.X" patterns *)
69
+
let octet = Re.(rep1 digit) in
70
+
let ip_re =
71
+
Re.(seq [ octet; char '.'; octet; char '.'; octet; char '.'; octet ])
72
+
in
73
+
let re = Re.(compile (seq [ str "inet "; group ip_re ])) in
74
+
match Re.exec_opt re line with
75
+
| None -> None
76
+
| Some g -> (
77
+
let ip_str = Re.Group.get g 1 in
78
+
match Ipaddr.V4.of_string ip_str with
79
+
| Error _ -> None
80
+
| Ok ip ->
81
+
(* Exclude loopback (127.x.x.x) *)
82
+
let loopback = Ipaddr.V4.Prefix.of_string_exn "127.0.0.0/8" in
83
+
let is_loopback = Ipaddr.V4.Prefix.mem ip loopback in
84
+
(* Only include private network ranges, exclude loopback *)
85
+
if Ipaddr.V4.is_private ip && not is_loopback then
86
+
(* Convert to /24 subnet *)
87
+
let prefix = Ipaddr.V4.Prefix.make 24 ip in
88
+
let network = Ipaddr.V4.Prefix.network prefix in
89
+
Some (Fmt.str "%a/24" Ipaddr.V4.pp network)
90
+
else None)
91
+
in
92
+
List.filter_map extract_subnet lines |> List.sort_uniq String.compare
93
+
94
+
(* Common arguments *)
95
+
96
+
let target_arg =
97
+
let doc =
98
+
"Target device(s). Can be: a single IP, comma-separated IPs, CIDR subnet \
99
+
(e.g., 192.168.1.0/24), or 'all' to discover on local network. If \
100
+
omitted, defaults to 'all'."
101
+
in
102
+
Arg.(value & pos 0 (some string) None & info [] ~docv:"TARGET" ~doc)
103
+
104
+
let ips_arg =
105
+
let doc = "IP addresses to scan for Meross devices." in
106
+
Arg.(non_empty & pos_all string [] & info [] ~docv:"IP" ~doc)
107
+
108
+
(* Helpers *)
109
+
110
+
let run_with_eio f =
111
+
Eio_main.run @@ fun env ->
112
+
Eio.Switch.run @@ fun sw ->
113
+
let net = Eio.Stdenv.net env in
114
+
let clock = Eio.Stdenv.clock env in
115
+
let http = Meross.Protocol.create_http ~clock ~net in
116
+
let proc_mgr = Eio.Stdenv.process_mgr env in
117
+
f ~http ~sw ~proc_mgr
118
+
119
+
(* IP range helpers using ipaddr library *)
120
+
121
+
let expand_prefix prefix =
122
+
let network = Ipaddr.V4.Prefix.network prefix in
123
+
let broadcast = Ipaddr.V4.Prefix.broadcast prefix in
124
+
let network_int = Ipaddr.V4.to_int32 network in
125
+
let broadcast_int = Ipaddr.V4.to_int32 broadcast in
126
+
(* Skip network and broadcast addresses *)
127
+
let first = Int32.succ network_int in
128
+
let last = Int32.pred broadcast_int in
129
+
let rec collect acc n =
130
+
if n < first then acc
131
+
else
132
+
let ip = Ipaddr.V4.of_int32 n |> Ipaddr.V4.to_string in
133
+
collect (ip :: acc) (Int32.pred n)
134
+
in
135
+
collect [] last
136
+
137
+
(* Resolve a target to a list of IPs, discovering if needed *)
138
+
let resolve_target ~http ~sw ~proc_mgr target =
139
+
match target with
140
+
| Ips ips ->
141
+
let ip_strs = List.map Ipaddr.V4.to_string ips in
142
+
`Ips ip_strs
143
+
| Subnet prefix ->
144
+
let ips = expand_prefix prefix in
145
+
Fmt.pr "Scanning %d addresses in %a...@." (List.length ips)
146
+
Ipaddr.V4.Prefix.pp prefix;
147
+
let devices = Meross.scan ~http ~sw ips in
148
+
if devices = [] then (
149
+
Fmt.pr "No Meross devices found.@.";
150
+
`Ips [])
151
+
else (
152
+
Fmt.pr "Found %d device(s).@." (List.length devices);
153
+
`Devices devices)
154
+
| All ->
155
+
(* Use ARP table to find active hosts on the network *)
156
+
let arp_entries = Arp.get_table () in
157
+
(* Filter to private IPs only *)
158
+
let private_ips =
159
+
List.filter_map
160
+
(fun (entry : Arp.entry) ->
161
+
match Ipaddr.V4.of_string entry.ip with
162
+
| Ok ip when Ipaddr.V4.is_private ip -> Some entry.ip
163
+
| _ -> None)
164
+
arp_entries
165
+
in
166
+
if private_ips = [] then
167
+
`Error "No devices in ARP table. Try pinging your network first."
168
+
else (
169
+
Fmt.pr "Scanning %d hosts from ARP table...@." (List.length private_ips);
170
+
let devices = Meross.scan ~http ~sw private_ips in
171
+
if devices = [] then (
172
+
Fmt.pr "No Meross devices found.@.";
173
+
`Ips [])
174
+
else (
175
+
Fmt.pr "Found %d device(s).@." (List.length devices);
176
+
`Devices devices))
177
+
178
+
(* Apply a command to resolved targets *)
179
+
let with_targets ~http ~sw ~proc_mgr target_opt f =
180
+
match parse_target (Option.value ~default:"all" target_opt) with
181
+
| Error msg ->
182
+
Fmt.epr "Error: %s@." msg;
183
+
`Error (false, msg)
184
+
| Ok target -> (
185
+
match resolve_target ~http ~sw ~proc_mgr target with
186
+
| `Error msg ->
187
+
Fmt.epr "Error: %s@." msg;
188
+
`Error (false, msg)
189
+
| `Ips [] -> `Ok ()
190
+
| `Ips ips ->
191
+
let results = List.map (fun ip -> (ip, f ip)) ips in
192
+
let errors =
193
+
List.filter_map
194
+
(function ip, Error (`Msg e) -> Some (ip, e) | _, Ok () -> None)
195
+
results
196
+
in
197
+
if errors = [] then `Ok ()
198
+
else (
199
+
List.iter (fun (ip, e) -> Fmt.epr "%s: %s@." ip e) errors;
200
+
`Error (false, "some commands failed"))
201
+
| `Devices devices ->
202
+
let results =
203
+
List.map (fun d -> (d.Meross.ip, f d.Meross.ip)) devices
204
+
in
205
+
let errors =
206
+
List.filter_map
207
+
(function ip, Error (`Msg e) -> Some (ip, e) | _, Ok () -> None)
208
+
results
209
+
in
210
+
if errors = [] then `Ok ()
211
+
else (
212
+
List.iter (fun (ip, e) -> Fmt.epr "%s: %s@." ip e) errors;
213
+
`Error (false, "some commands failed")))
214
+
215
+
(* Apply a command that returns a value to resolved targets *)
216
+
let with_targets_pp ~http ~sw ~proc_mgr target_opt pp f =
217
+
match parse_target (Option.value ~default:"all" target_opt) with
218
+
| Error msg ->
219
+
Fmt.epr "Error: %s@." msg;
220
+
`Error (false, msg)
221
+
| Ok target -> (
222
+
match resolve_target ~http ~sw ~proc_mgr target with
223
+
| `Error msg ->
224
+
Fmt.epr "Error: %s@." msg;
225
+
`Error (false, msg)
226
+
| `Ips [] -> `Ok ()
227
+
| `Ips ips ->
228
+
let results = List.map (fun ip -> (ip, f ip)) ips in
229
+
List.iter
230
+
(function
231
+
| _, Ok v -> Fmt.pr "%a@.@." pp v
232
+
| ip, Error (`Msg e) -> Fmt.epr "%s: %s@." ip e)
233
+
results;
234
+
let has_errors =
235
+
List.exists (function _, Error _ -> true | _ -> false) results
236
+
in
237
+
if has_errors then `Error (false, "some commands failed") else `Ok ()
238
+
| `Devices devices ->
239
+
(* Call f on each discovered device's IP *)
240
+
let results =
241
+
List.map (fun d -> (d.Meross.ip, f d.Meross.ip)) devices
242
+
in
243
+
List.iter
244
+
(function
245
+
| _, Ok v -> Fmt.pr "%a@.@." pp v
246
+
| ip, Error (`Msg e) -> Fmt.epr "%s: %s@." ip e)
247
+
results;
248
+
let has_errors =
249
+
List.exists (function _, Error _ -> true | _ -> false) results
250
+
in
251
+
if has_errors then `Error (false, "some commands failed") else `Ok ())
252
+
253
+
(* Special version for info command that uses already-scanned device info *)
254
+
let with_targets_info ~http ~sw ~proc_mgr target_opt =
255
+
match parse_target (Option.value ~default:"all" target_opt) with
256
+
| Error msg ->
257
+
Fmt.epr "Error: %s@." msg;
258
+
`Error (false, msg)
259
+
| Ok target -> (
260
+
match resolve_target ~http ~sw ~proc_mgr target with
261
+
| `Error msg ->
262
+
Fmt.epr "Error: %s@." msg;
263
+
`Error (false, msg)
264
+
| `Ips [] -> `Ok ()
265
+
| `Ips ips ->
266
+
let results =
267
+
List.map (fun ip -> (ip, Meross.get_info ~http ~sw ip)) ips
268
+
in
269
+
List.iter
270
+
(function
271
+
| _, Ok v -> Fmt.pr "%a@.@." Meross.pp_info v
272
+
| ip, Error (`Msg e) -> Fmt.epr "%s: %s@." ip e)
273
+
results;
274
+
let has_errors =
275
+
List.exists (function _, Error _ -> true | _ -> false) results
276
+
in
277
+
if has_errors then `Error (false, "some commands failed") else `Ok ()
278
+
| `Devices devices ->
279
+
(* Use already-scanned device info directly *)
280
+
List.iter (fun d -> Fmt.pr "%a@.@." Meross.pp_info d) devices;
281
+
`Ok ())
282
+
283
+
let handle_result = function
284
+
| Ok () -> `Ok ()
285
+
| Error (`Msg e) ->
286
+
Fmt.epr "Error: %s@." e;
287
+
`Error (false, e)
288
+
289
+
let handle_result_pp pp = function
290
+
| Ok v ->
291
+
Fmt.pr "%a@." pp v;
292
+
`Ok ()
293
+
| Error (`Msg e) ->
294
+
Fmt.epr "Error: %s@." e;
295
+
`Error (false, e)
296
+
297
+
(* Commands *)
298
+
299
+
let info_cmd =
300
+
let doc = "Show device information." in
301
+
let man =
302
+
[
303
+
`S Manpage.s_description;
304
+
`P
305
+
"Retrieve and display device information including type, MAC, UUID, \
306
+
firmware version, and current power state.";
307
+
`S Manpage.s_examples;
308
+
`P "$(b,meross info 192.168.1.100)";
309
+
`P "$(b,meross info all) # Show info for all devices";
310
+
`P "$(b,meross info) # Same as 'all'";
311
+
`P "$(b,meross info 192.168.1.100,101,102) # Multiple devices";
312
+
]
313
+
in
314
+
let info = Cmd.info "info" ~doc ~man in
315
+
let term =
316
+
Term.(
317
+
const (fun target ->
318
+
run_with_eio (fun ~http ~sw ~proc_mgr ->
319
+
with_targets_info ~http ~sw ~proc_mgr target))
320
+
$ target_arg)
321
+
in
322
+
Cmd.v info (Term.ret term)
323
+
324
+
let on_cmd =
325
+
let doc = "Turn device(s) on." in
326
+
let man =
327
+
[
328
+
`S Manpage.s_description;
329
+
`P "Send a command to turn the smart plug(s) on.";
330
+
`S Manpage.s_examples;
331
+
`P "$(b,meross on 192.168.1.100)";
332
+
`P "$(b,meross on all) # Turn on all devices";
333
+
`P "$(b,meross on) # Same as 'all'";
334
+
`P "$(b,meross on 192.168.1.100,101) # Multiple devices";
335
+
]
336
+
in
337
+
let info = Cmd.info "on" ~doc ~man in
338
+
let term =
339
+
Term.(
340
+
const (fun target ->
341
+
run_with_eio (fun ~http ~sw ~proc_mgr ->
342
+
with_targets ~http ~sw ~proc_mgr target (fun ip ->
343
+
Meross.turn_on ~http ~sw ip)))
344
+
$ target_arg)
345
+
in
346
+
Cmd.v info (Term.ret term)
347
+
348
+
let off_cmd =
349
+
let doc = "Turn device(s) off." in
350
+
let man =
351
+
[
352
+
`S Manpage.s_description;
353
+
`P "Send a command to turn the smart plug(s) off.";
354
+
`S Manpage.s_examples;
355
+
`P "$(b,meross off 192.168.1.100)";
356
+
`P "$(b,meross off all) # Turn off all devices";
357
+
`P "$(b,meross off) # Same as 'all'";
358
+
]
359
+
in
360
+
let info = Cmd.info "off" ~doc ~man in
361
+
let term =
362
+
Term.(
363
+
const (fun target ->
364
+
run_with_eio (fun ~http ~sw ~proc_mgr ->
365
+
with_targets ~http ~sw ~proc_mgr target (fun ip ->
366
+
Meross.turn_off ~http ~sw ip)))
367
+
$ target_arg)
368
+
in
369
+
Cmd.v info (Term.ret term)
370
+
371
+
let toggle_cmd =
372
+
let doc = "Toggle device(s) power state." in
373
+
let man =
374
+
[
375
+
`S Manpage.s_description;
376
+
`P "Toggle the smart plug(s) between on and off states.";
377
+
`S Manpage.s_examples;
378
+
`P "$(b,meross toggle 192.168.1.100)";
379
+
`P "$(b,meross toggle all)";
380
+
]
381
+
in
382
+
let info = Cmd.info "toggle" ~doc ~man in
383
+
let term =
384
+
Term.(
385
+
const (fun target ->
386
+
run_with_eio (fun ~http ~sw ~proc_mgr ->
387
+
with_targets ~http ~sw ~proc_mgr target (fun ip ->
388
+
Meross.toggle ~http ~sw ip)))
389
+
$ target_arg)
390
+
in
391
+
Cmd.v info (Term.ret term)
392
+
393
+
let reboot_cmd =
394
+
let doc = "Reboot device(s)." in
395
+
let man =
396
+
[
397
+
`S Manpage.s_description;
398
+
`P "Send a reboot command to the smart plug(s).";
399
+
`S Manpage.s_examples;
400
+
`P "$(b,meross reboot 192.168.1.100)";
401
+
`P "$(b,meross reboot all)";
402
+
]
403
+
in
404
+
let info = Cmd.info "reboot" ~doc ~man in
405
+
let term =
406
+
Term.(
407
+
const (fun target ->
408
+
run_with_eio (fun ~http ~sw ~proc_mgr ->
409
+
with_targets ~http ~sw ~proc_mgr target (fun ip ->
410
+
Meross.reboot ~http ~sw ip)))
411
+
$ target_arg)
412
+
in
413
+
Cmd.v info (Term.ret term)
414
+
415
+
let electricity_cmd =
416
+
let doc = "Show real-time power readings." in
417
+
let man =
418
+
[
419
+
`S Manpage.s_description;
420
+
`P
421
+
"Display current power consumption including voltage (V), current (A), \
422
+
and power (W).";
423
+
`S Manpage.s_examples;
424
+
`P "$(b,meross electricity 192.168.1.100)";
425
+
`P "$(b,meross electricity all)";
426
+
]
427
+
in
428
+
let info = Cmd.info "electricity" ~doc ~man in
429
+
let term =
430
+
Term.(
431
+
const (fun target ->
432
+
run_with_eio (fun ~http ~sw ~proc_mgr ->
433
+
with_targets_pp ~http ~sw ~proc_mgr target Meross.pp_electricity
434
+
(fun ip -> Meross.get_electricity ~http ~sw ip)))
435
+
$ target_arg)
436
+
in
437
+
Cmd.v info (Term.ret term)
438
+
439
+
let consumption_cmd =
440
+
let doc = "Show energy consumption history." in
441
+
let man =
442
+
[
443
+
`S Manpage.s_description;
444
+
`P "Display historical energy consumption data.";
445
+
`S Manpage.s_examples;
446
+
`P "$(b,meross consumption 192.168.1.100)";
447
+
`P "$(b,meross consumption all)";
448
+
]
449
+
in
450
+
let info = Cmd.info "consumption" ~doc ~man in
451
+
let term =
452
+
Term.(
453
+
const (fun target ->
454
+
run_with_eio (fun ~http ~sw ~proc_mgr ->
455
+
with_targets_pp ~http ~sw ~proc_mgr target Meross.pp_consumption
456
+
(fun ip -> Meross.get_consumption ~http ~sw ip)))
457
+
$ target_arg)
458
+
in
459
+
Cmd.v info (Term.ret term)
460
+
461
+
let abilities_cmd =
462
+
let doc = "List device capabilities." in
463
+
let man =
464
+
[
465
+
`S Manpage.s_description;
466
+
`P "Show the list of supported features and namespaces.";
467
+
`S Manpage.s_examples;
468
+
`P "$(b,meross abilities 192.168.1.100)";
469
+
]
470
+
in
471
+
let info = Cmd.info "abilities" ~doc ~man in
472
+
let pp_abilities ppf abilities =
473
+
List.iter (fun a -> Fmt.pf ppf "%s@." a) abilities
474
+
in
475
+
let term =
476
+
Term.(
477
+
const (fun target ->
478
+
run_with_eio (fun ~http ~sw ~proc_mgr ->
479
+
with_targets_pp ~http ~sw ~proc_mgr target pp_abilities (fun ip ->
480
+
Meross.get_abilities ~http ~sw ip)))
481
+
$ target_arg)
482
+
in
483
+
Cmd.v info (Term.ret term)
484
+
485
+
let dnd_cmd =
486
+
let doc = "Control LED (Do Not Disturb mode)." in
487
+
let man =
488
+
[
489
+
`S Manpage.s_description;
490
+
`P
491
+
"Enable or disable the LED on the device. When DND is enabled, the LED \
492
+
is turned off.";
493
+
`S Manpage.s_examples;
494
+
`P "$(b,meross dnd on 192.168.1.100) # Turn LED off";
495
+
`P "$(b,meross dnd off 192.168.1.100) # Turn LED on";
496
+
`P "$(b,meross dnd on all) # Turn LED off on all devices";
497
+
`P "$(b,meross dnd on) # Same as 'all'";
498
+
]
499
+
in
500
+
let info = Cmd.info "dnd" ~doc ~man in
501
+
let action_arg =
502
+
let doc = "Action: $(b,on) to enable DND (LED off), $(b,off) to disable." in
503
+
Arg.(required & pos 0 (some string) None & info [] ~docv:"ACTION" ~doc)
504
+
in
505
+
let dnd_target_arg =
506
+
let doc = "Target device(s). See main help for target syntax." in
507
+
Arg.(value & pos 1 (some string) None & info [] ~docv:"TARGET" ~doc)
508
+
in
509
+
let term =
510
+
Term.(
511
+
const (fun action target ->
512
+
let enabled =
513
+
match String.lowercase_ascii action with
514
+
| "on" | "enable" | "1" | "true" -> Some true
515
+
| "off" | "disable" | "0" | "false" -> Some false
516
+
| _ -> None
517
+
in
518
+
match enabled with
519
+
| None ->
520
+
Fmt.epr "Error: action must be 'on' or 'off'@.";
521
+
`Error (true, "invalid action")
522
+
| Some enabled ->
523
+
run_with_eio (fun ~http ~sw ~proc_mgr ->
524
+
with_targets ~http ~sw ~proc_mgr target (fun ip ->
525
+
Meross.set_dnd_mode ~http ~sw ip ~enabled)))
526
+
$ action_arg $ dnd_target_arg)
527
+
in
528
+
Cmd.v info (Term.ret term)
529
+
530
+
let scan_cmd =
531
+
let doc = "Scan for Meross devices." in
532
+
let man =
533
+
[
534
+
`S Manpage.s_description;
535
+
`P
536
+
"Probe the given IP addresses in parallel and list any Meross devices \
537
+
found.";
538
+
`S Manpage.s_examples;
539
+
`P "$(b,meross scan 192.168.1.100 192.168.1.101 192.168.1.102)";
540
+
]
541
+
in
542
+
let info = Cmd.info "scan" ~doc ~man in
543
+
let term =
544
+
Term.(
545
+
const (fun ips ->
546
+
run_with_eio (fun ~http ~sw ~proc_mgr:_ ->
547
+
let devices = Meross.scan ~http ~sw ips in
548
+
if devices = [] then Fmt.pr "No Meross devices found.@."
549
+
else List.iter (fun d -> Fmt.pr "%a@.@." Meross.pp_info d) devices;
550
+
`Ok ()))
551
+
$ ips_arg)
552
+
in
553
+
Cmd.v info (Term.ret term)
554
+
555
+
let discover_cmd =
556
+
let doc = "Discover Meross devices on a subnet." in
557
+
let man =
558
+
[
559
+
`S Manpage.s_description;
560
+
`P
561
+
"Scan an entire subnet in parallel to find Meross devices. Provide a \
562
+
CIDR notation subnet (e.g., 192.168.1.0/24), or omit to auto-detect \
563
+
local subnets.";
564
+
`S Manpage.s_examples;
565
+
`P "$(b,meross discover 192.168.1.0/24)";
566
+
`P "$(b,meross discover) # Auto-detect local subnets";
567
+
]
568
+
in
569
+
let info = Cmd.info "discover" ~doc ~man in
570
+
let subnet_arg =
571
+
let doc =
572
+
"Subnet in CIDR notation (e.g., 192.168.1.0/24). If omitted, \
573
+
auto-detects local subnets."
574
+
in
575
+
Arg.(value & pos 0 (some string) None & info [] ~docv:"SUBNET" ~doc)
576
+
in
577
+
let term =
578
+
Term.(
579
+
const (fun subnet_opt ->
580
+
run_with_eio (fun ~http ~sw ~proc_mgr ->
581
+
let subnets =
582
+
match subnet_opt with
583
+
| Some s -> [ s ]
584
+
| None -> get_local_subnets ~proc_mgr
585
+
in
586
+
match subnets with
587
+
| [] ->
588
+
Fmt.epr "Error: Could not detect local subnets.@.";
589
+
`Error (false, "no subnets")
590
+
| _ ->
591
+
let all_ips =
592
+
List.concat_map
593
+
(fun cidr ->
594
+
match Ipaddr.V4.Prefix.of_string cidr with
595
+
| Error _ ->
596
+
Fmt.epr "Warning: invalid CIDR '%s', skipping@."
597
+
cidr;
598
+
[]
599
+
| Ok prefix ->
600
+
let ips = expand_prefix prefix in
601
+
Fmt.pr "Scanning %d addresses in %s...@."
602
+
(List.length ips) cidr;
603
+
ips)
604
+
subnets
605
+
in
606
+
let devices = Meross.scan ~http ~sw all_ips in
607
+
if devices = [] then Fmt.pr "No Meross devices found.@."
608
+
else (
609
+
Fmt.pr "Found %d device(s):@.@." (List.length devices);
610
+
List.iter
611
+
(fun d -> Fmt.pr "%a@.@." Meross.pp_info d)
612
+
devices);
613
+
`Ok ()))
614
+
$ subnet_arg)
615
+
in
616
+
Cmd.v info (Term.ret term)
617
+
618
+
let matter_cmd =
619
+
let doc = "Matter commissioning operations." in
620
+
let man =
621
+
[
622
+
`S Manpage.s_description;
623
+
`P "Perform Matter-related operations on the device.";
624
+
`S Manpage.s_examples;
625
+
`P "$(b,meross matter unbind 192.168.1.100) # Remove Matter binding";
626
+
`P "$(b,meross matter commission 192.168.1.100) # Start commissioning";
627
+
`P "$(b,meross matter unbind all) # Unbind all devices";
628
+
]
629
+
in
630
+
let info = Cmd.info "matter" ~doc ~man in
631
+
let action_arg =
632
+
let doc = "Action: $(b,unbind) or $(b,commission)." in
633
+
Arg.(required & pos 0 (some string) None & info [] ~docv:"ACTION" ~doc)
634
+
in
635
+
let matter_target_arg =
636
+
let doc = "Target device(s). See main help for target syntax." in
637
+
Arg.(value & pos 1 (some string) None & info [] ~docv:"TARGET" ~doc)
638
+
in
639
+
let term =
640
+
Term.(
641
+
const (fun action target ->
642
+
match String.lowercase_ascii action with
643
+
| "unbind" ->
644
+
run_with_eio (fun ~http ~sw ~proc_mgr ->
645
+
with_targets ~http ~sw ~proc_mgr target (fun ip ->
646
+
Meross.unbind_matter ~http ~sw ip))
647
+
| "commission" ->
648
+
run_with_eio (fun ~http ~sw ~proc_mgr ->
649
+
with_targets ~http ~sw ~proc_mgr target (fun ip ->
650
+
Meross.trigger_commissioning ~http ~sw ip))
651
+
| _ ->
652
+
Fmt.epr "Error: action must be 'unbind' or 'commission'@.";
653
+
`Error (true, "invalid action"))
654
+
$ action_arg $ matter_target_arg)
655
+
in
656
+
Cmd.v info (Term.ret term)
657
+
658
+
(* Main command *)
659
+
660
+
let main_cmd =
661
+
let doc = "Control Meross smart plugs over local HTTP API." in
662
+
let man =
663
+
[
664
+
`S Manpage.s_description;
665
+
`P
666
+
"$(tname) communicates with Meross smart plugs directly over the local \
667
+
network, without requiring cloud access.";
668
+
`S "TARGET SYNTAX";
669
+
`P
670
+
"Most commands accept a TARGET argument that specifies which device(s) \
671
+
to control:";
672
+
`I ("$(b,IP)", "Single device: $(b,192.168.1.100)");
673
+
`I ("$(b,IP,IP,...)", "Multiple devices: $(b,192.168.1.100,101,102)");
674
+
`I ("$(b,CIDR)", "Subnet scan: $(b,192.168.1.0/24)");
675
+
`I ("$(b,all)", "Discover and target all devices on local network");
676
+
`I ("$(i,omitted)", "Same as $(b,all)");
677
+
`S Manpage.s_examples;
678
+
`P "$(b,meross on) # Turn on all devices";
679
+
`P "$(b,meross off all) # Turn off all devices";
680
+
`P "$(b,meross info 192.168.1.100) # Info for one device";
681
+
`P "$(b,meross toggle 192.168.1.100,101) # Toggle multiple";
682
+
`P "$(b,meross discover) # Find all devices";
683
+
`P "$(b,meross electricity 192.168.1.0/24) # Scan subnet";
684
+
`S "ENVIRONMENT";
685
+
`P
686
+
"$(b,MEROSS_SUBNET) can be set to override auto-detected subnets when \
687
+
using 'all'.";
688
+
`S Manpage.s_bugs;
689
+
`P
690
+
"Report issues at \
691
+
https://tangled.org/gazagnaire.org/ocaml-meross/issues";
692
+
]
693
+
in
694
+
let info = Cmd.info "meross" ~version:"%%VERSION%%" ~doc ~man in
695
+
let default = Term.(ret (const (`Help (`Pager, None)))) in
696
+
Cmd.group info ~default
697
+
[
698
+
info_cmd;
699
+
on_cmd;
700
+
off_cmd;
701
+
toggle_cmd;
702
+
reboot_cmd;
703
+
electricity_cmd;
704
+
consumption_cmd;
705
+
abilities_cmd;
706
+
dnd_cmd;
707
+
scan_cmd;
708
+
discover_cmd;
709
+
matter_cmd;
710
+
]
711
+
712
+
let () =
713
+
Crypto_rng_unix.use_default ();
714
+
exit (Cmd.eval main_cmd)
+33
dune-project
+33
dune-project
···
1
+
(lang dune 3.21)
2
+
(name meross)
3
+
4
+
(generate_opam_files true)
5
+
6
+
(source (tangled gazagnaire.org/ocaml-meross))
7
+
(license MIT)
8
+
(authors "Thomas Gazagnaire <thomas@gazagnaire.org>")
9
+
(maintainers "Thomas Gazagnaire <thomas@gazagnaire.org>")
10
+
11
+
(package
12
+
(name meross)
13
+
(synopsis "Meross smart plug local control over HTTP")
14
+
(description "Control Meross smart plugs over local HTTP API without cloud. Supports power control, energy monitoring, timers, triggers, LED control, and Matter pairing.")
15
+
(depends
16
+
(ocaml (>= 5.1))
17
+
(dune (>= 3.21))
18
+
(cmdliner (>= 1.2))
19
+
requests
20
+
(digestif (>= 1.0))
21
+
(eio (>= 1.0))
22
+
(eio_main (>= 1.0))
23
+
(fmt (>= 0.9))
24
+
(ipaddr (>= 5.0))
25
+
(jsont (>= 0.1.0))
26
+
(bytesrw (>= 0.1.0))
27
+
(logs (>= 0.7))
28
+
(crypto-rng (>= 1.0))
29
+
(ptime (>= 1.0))
30
+
(uri (>= 4.0))
31
+
(alcotest :with-test)
32
+
(crowbar :with-test)
33
+
(odoc :with-doc)))
+15
fuzz/dune
+15
fuzz/dune
···
1
+
; Crowbar fuzz testing for meross
2
+
;
3
+
; To run: dune exec fuzz/fuzz_meross.exe
4
+
; With AFL: afl-fuzz -i fuzz/corpus -o fuzz/findings -- ./_build/default/fuzz/fuzz_meross.exe @@
5
+
6
+
(executable
7
+
(name fuzz_meross)
8
+
(modules fuzz_meross)
9
+
(libraries meross crowbar crypto-rng.unix))
10
+
11
+
(rule
12
+
(alias fuzz)
13
+
(deps fuzz_meross.exe)
14
+
(action
15
+
(run %{exe:fuzz_meross.exe})))
+310
fuzz/fuzz_meross.ml
+310
fuzz/fuzz_meross.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
open Crowbar
7
+
8
+
let () = Crypto_rng_unix.use_default ()
9
+
10
+
(* {1 Generators} *)
11
+
12
+
let printable_string =
13
+
map [ bytes ] (fun s ->
14
+
(* Filter to printable ASCII to avoid JSON encoding issues *)
15
+
String.map
16
+
(fun c ->
17
+
let code = Char.code c in
18
+
if code >= 32 && code < 127 && c <> '"' && c <> '\\' then c else 'a')
19
+
s)
20
+
21
+
let positive_int = map [ int ] (fun i -> abs i)
22
+
23
+
(* {1 Protocol Tests} *)
24
+
25
+
(* Test that make_header always produces valid headers *)
26
+
let test_make_header_valid method_ namespace =
27
+
let header = Meross.Protocol.make_header ~method_ ~namespace in
28
+
check (String.length header.message_id = 32);
29
+
check (String.length header.sign = 32);
30
+
check (header.payload_version = 1);
31
+
check (header.method_ = method_);
32
+
check (header.namespace = namespace)
33
+
34
+
(* Test that make_request_empty produces valid JSON *)
35
+
let test_make_request_empty_valid method_ namespace =
36
+
let json = Meross.Protocol.make_request_empty ~method_ ~namespace in
37
+
check (String.length json > 2);
38
+
check (json.[0] = '{')
39
+
40
+
(* Test that make_request_enable produces valid JSON *)
41
+
let test_make_request_enable_valid namespace =
42
+
let json = Meross.Protocol.make_request_enable ~namespace in
43
+
check (String.length json > 2);
44
+
check (json.[0] = '{')
45
+
46
+
(* Test that decode handles arbitrary input without crashing *)
47
+
let test_decode_no_crash input =
48
+
let _ = Meross.Protocol.decode Meross.Protocol.header_codec input in
49
+
check true
50
+
51
+
(* Test header encode/decode roundtrip *)
52
+
let test_header_roundtrip from_ msg_id method_ namespace sign timestamp =
53
+
let header : Meross.Protocol.header =
54
+
{
55
+
from_;
56
+
message_id = msg_id;
57
+
method_;
58
+
namespace;
59
+
payload_version = 1;
60
+
sign;
61
+
timestamp;
62
+
}
63
+
in
64
+
let encoded = Meross.Protocol.encode Meross.Protocol.header_codec header in
65
+
match Meross.Protocol.decode Meross.Protocol.header_codec encoded with
66
+
| Ok h ->
67
+
check (h.from_ = from_);
68
+
check (h.message_id = msg_id);
69
+
check (h.method_ = method_);
70
+
check (h.namespace = namespace);
71
+
check (h.sign = sign);
72
+
check (h.timestamp = timestamp)
73
+
| Error _ -> check true (* some inputs may produce invalid JSON *)
74
+
75
+
(* {1 Timers Codec Tests} *)
76
+
77
+
(* Test countdown codec roundtrip *)
78
+
let test_timers_countdown_roundtrip onoff end_time duration =
79
+
let c : Meross.Timers.countdown = { onoff; end_time; duration } in
80
+
let encoded = Meross.Protocol.encode Meross.Timers.countdown_codec c in
81
+
match Meross.Protocol.decode Meross.Timers.countdown_codec encoded with
82
+
| Ok decoded ->
83
+
check (decoded.onoff = onoff);
84
+
check (decoded.end_time = end_time);
85
+
check (decoded.duration = duration)
86
+
| Error _ -> check true
87
+
88
+
(* Test timer codec roundtrip *)
89
+
let test_timers_timer_roundtrip channel timer_type onoff end_time duration =
90
+
let down : Meross.Timers.countdown option =
91
+
if timer_type mod 2 = 0 then None else Some { onoff; end_time; duration }
92
+
in
93
+
let t : Meross.Timers.t = { channel; timer_type; down } in
94
+
let encoded = Meross.Protocol.encode Meross.Timers.timer_codec t in
95
+
match Meross.Protocol.decode Meross.Timers.timer_codec encoded with
96
+
| Ok decoded ->
97
+
check (decoded.channel = channel);
98
+
check (decoded.timer_type = timer_type)
99
+
| Error _ -> check true
100
+
101
+
(* Test timer decode no crash *)
102
+
let test_timers_decode_no_crash input =
103
+
let _ = Meross.Protocol.decode Meross.Timers.countdown_codec input in
104
+
let _ = Meross.Protocol.decode Meross.Timers.timer_codec input in
105
+
let _ = Meross.Protocol.decode Meross.Timers.payload_codec input in
106
+
check true
107
+
108
+
(* {1 Triggers Codec Tests} *)
109
+
110
+
(* Test rule codec roundtrip *)
111
+
let test_triggers_rule_roundtrip week duration =
112
+
let r : Meross.Triggers.rule = { week; duration } in
113
+
let encoded = Meross.Protocol.encode Meross.Triggers.rule_codec r in
114
+
match Meross.Protocol.decode Meross.Triggers.rule_codec encoded with
115
+
| Ok decoded ->
116
+
check (decoded.week = week);
117
+
check (decoded.duration = duration)
118
+
| Error _ -> check true
119
+
120
+
(* Test trigger codec roundtrip *)
121
+
let test_triggers_codec_roundtrip id trigger_type enabled channel alias
122
+
create_time week duration =
123
+
let t : Meross.Triggers.t =
124
+
{
125
+
id;
126
+
trigger_type;
127
+
enabled = enabled mod 2 = 1;
128
+
channel;
129
+
alias;
130
+
create_time;
131
+
rule = { week; duration };
132
+
}
133
+
in
134
+
let encoded = Meross.Protocol.encode Meross.Triggers.codec t in
135
+
match Meross.Protocol.decode Meross.Triggers.codec encoded with
136
+
| Ok decoded ->
137
+
check (decoded.id = id);
138
+
check (decoded.trigger_type = trigger_type);
139
+
check (decoded.channel = channel);
140
+
check (decoded.rule.week = week);
141
+
check (decoded.rule.duration = duration)
142
+
| Error _ -> check true
143
+
144
+
(* Test make_id produces valid IDs *)
145
+
let test_triggers_make_id =
146
+
let id = Meross.Triggers.make_id () in
147
+
check (String.length id = 6);
148
+
(* Should be hex characters *)
149
+
String.iter
150
+
(fun c ->
151
+
check
152
+
((c >= '0' && c <= '9')
153
+
|| (c >= 'a' && c <= 'f')
154
+
|| (c >= 'A' && c <= 'F')))
155
+
id
156
+
157
+
(* Test trigger decode no crash *)
158
+
let test_triggers_decode_no_crash input =
159
+
let _ = Meross.Protocol.decode Meross.Triggers.rule_codec input in
160
+
let _ = Meross.Protocol.decode Meross.Triggers.codec input in
161
+
let _ = Meross.Protocol.decode Meross.Triggers.payload_codec input in
162
+
let _ = Meross.Protocol.decode Meross.Triggers.digest_payload_codec input in
163
+
check true
164
+
165
+
(* {1 Runtime Codec Tests} *)
166
+
167
+
(* Test runtime codec roundtrip *)
168
+
let test_runtime_codec_roundtrip signal =
169
+
let r : Meross.Runtime.t = { signal } in
170
+
let encoded = Meross.Protocol.encode Meross.Runtime.codec r in
171
+
match Meross.Protocol.decode Meross.Runtime.codec encoded with
172
+
| Ok decoded -> check (decoded.signal = signal)
173
+
| Error _ -> check true
174
+
175
+
(* Test runtime payload codec roundtrip *)
176
+
let test_runtime_payload_roundtrip signal =
177
+
let p : Meross.Runtime.payload = { runtime = { signal } } in
178
+
let encoded = Meross.Protocol.encode Meross.Runtime.payload_codec p in
179
+
match Meross.Protocol.decode Meross.Runtime.payload_codec encoded with
180
+
| Ok decoded -> check (decoded.runtime.signal = signal)
181
+
| Error _ -> check true
182
+
183
+
(* Test runtime decode no crash *)
184
+
let test_runtime_decode_no_crash input =
185
+
let _ = Meross.Protocol.decode Meross.Runtime.codec input in
186
+
let _ = Meross.Protocol.decode Meross.Runtime.payload_codec input in
187
+
check true
188
+
189
+
(* {1 DND Codec Tests} *)
190
+
191
+
(* Test DND codec roundtrip *)
192
+
let test_dnd_codec_roundtrip enabled =
193
+
let d : Meross.Dnd.t = { enabled = enabled mod 2 = 1 } in
194
+
let encoded = Meross.Protocol.encode Meross.Dnd.codec d in
195
+
match Meross.Protocol.decode Meross.Dnd.codec encoded with
196
+
| Ok decoded -> check (decoded.enabled = d.enabled)
197
+
| Error _ -> check true
198
+
199
+
(* Test DND payload codec roundtrip *)
200
+
let test_dnd_payload_roundtrip enabled =
201
+
let p : Meross.Dnd.payload = { dnd_mode = { enabled = enabled mod 2 = 1 } } in
202
+
let encoded = Meross.Protocol.encode Meross.Dnd.payload_codec p in
203
+
match Meross.Protocol.decode Meross.Dnd.payload_codec encoded with
204
+
| Ok decoded -> check (decoded.dnd_mode.enabled = p.dnd_mode.enabled)
205
+
| Error _ -> check true
206
+
207
+
(* Test DND decode no crash *)
208
+
let test_dnd_decode_no_crash input =
209
+
let _ = Meross.Protocol.decode Meross.Dnd.codec input in
210
+
let _ = Meross.Protocol.decode Meross.Dnd.payload_codec input in
211
+
check true
212
+
213
+
(* {1 Format Duration Tests} *)
214
+
215
+
(* Test format_duration doesn't crash on any input *)
216
+
let test_timers_format_duration_no_crash secs =
217
+
let _ = Meross.Timers.format_duration (abs secs) in
218
+
check true
219
+
220
+
let test_triggers_format_duration_no_crash secs =
221
+
let _ = Meross.Triggers.format_duration (abs secs) in
222
+
check true
223
+
224
+
(* {1 Abilities Tests} *)
225
+
226
+
(* Test has_* functions don't crash *)
227
+
let test_abilities_no_crash ns1 ns2 ns3 =
228
+
let abilities = [ ns1; ns2; ns3 ] in
229
+
let _ = Meross.Abilities.has_electricity abilities in
230
+
let _ = Meross.Abilities.has_consumption abilities in
231
+
let _ = Meross.Abilities.has_timers abilities in
232
+
let _ = Meross.Abilities.has_dnd abilities in
233
+
let _ = Meross.Abilities.has_runtime abilities in
234
+
let _ = Meross.Abilities.has_matter abilities in
235
+
check true
236
+
237
+
(* {1 Register Tests} *)
238
+
239
+
let () =
240
+
(* Protocol tests *)
241
+
add_test ~name:"protocol: make_header valid"
242
+
[ printable_string; printable_string ]
243
+
test_make_header_valid;
244
+
add_test ~name:"protocol: make_request_empty valid"
245
+
[ printable_string; printable_string ]
246
+
test_make_request_empty_valid;
247
+
add_test ~name:"protocol: make_request_enable valid" [ printable_string ]
248
+
test_make_request_enable_valid;
249
+
add_test ~name:"protocol: decode no crash" [ bytes ] test_decode_no_crash;
250
+
add_test ~name:"protocol: header roundtrip"
251
+
[
252
+
printable_string;
253
+
printable_string;
254
+
printable_string;
255
+
printable_string;
256
+
printable_string;
257
+
positive_int;
258
+
]
259
+
test_header_roundtrip;
260
+
261
+
(* Timers tests *)
262
+
add_test ~name:"timers: countdown roundtrip"
263
+
[ positive_int; positive_int; positive_int ]
264
+
test_timers_countdown_roundtrip;
265
+
add_test ~name:"timers: timer roundtrip"
266
+
[ positive_int; positive_int; positive_int; positive_int; positive_int ]
267
+
test_timers_timer_roundtrip;
268
+
add_test ~name:"timers: decode no crash" [ bytes ] test_timers_decode_no_crash;
269
+
add_test ~name:"timers: format_duration no crash" [ int ]
270
+
test_timers_format_duration_no_crash;
271
+
272
+
(* Triggers tests *)
273
+
add_test ~name:"triggers: rule roundtrip"
274
+
[ positive_int; positive_int ]
275
+
test_triggers_rule_roundtrip;
276
+
add_test ~name:"triggers: codec roundtrip"
277
+
[
278
+
printable_string;
279
+
positive_int;
280
+
int;
281
+
positive_int;
282
+
printable_string;
283
+
positive_int;
284
+
positive_int;
285
+
positive_int;
286
+
]
287
+
test_triggers_codec_roundtrip;
288
+
add_test ~name:"triggers: make_id" [] test_triggers_make_id;
289
+
add_test ~name:"triggers: decode no crash" [ bytes ]
290
+
test_triggers_decode_no_crash;
291
+
add_test ~name:"triggers: format_duration no crash" [ int ]
292
+
test_triggers_format_duration_no_crash;
293
+
294
+
(* Runtime tests *)
295
+
add_test ~name:"runtime: codec roundtrip" [ positive_int ]
296
+
test_runtime_codec_roundtrip;
297
+
add_test ~name:"runtime: payload roundtrip" [ positive_int ]
298
+
test_runtime_payload_roundtrip;
299
+
add_test ~name:"runtime: decode no crash" [ bytes ]
300
+
test_runtime_decode_no_crash;
301
+
302
+
(* DND tests *)
303
+
add_test ~name:"dnd: codec roundtrip" [ int ] test_dnd_codec_roundtrip;
304
+
add_test ~name:"dnd: payload roundtrip" [ int ] test_dnd_payload_roundtrip;
305
+
add_test ~name:"dnd: decode no crash" [ bytes ] test_dnd_decode_no_crash;
306
+
307
+
(* Abilities tests *)
308
+
add_test ~name:"abilities: no crash"
309
+
[ printable_string; printable_string; printable_string ]
310
+
test_abilities_no_crash
+70
lib/abilities.ml
+70
lib/abilities.ml
···
1
+
(** Meross device abilities.
2
+
3
+
Query what namespaces/features a device supports. *)
4
+
5
+
module P = Protocol
6
+
module String_map = Map.Make (String)
7
+
8
+
let ( let* ) = Result.bind
9
+
10
+
(** {1 Codecs} *)
11
+
12
+
let ability_map_codec = Jsont.Object.as_string_map Jsont.json
13
+
14
+
type payload = { ability : string list }
15
+
16
+
let payload_codec =
17
+
Jsont.Object.map ~kind:"ability_payload" (fun ability_map ->
18
+
{ ability = String_map.fold (fun k _ acc -> k :: acc) ability_map [] })
19
+
|> Jsont.Object.mem "ability" ability_map_codec ~enc:(fun _ ->
20
+
String_map.empty)
21
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
22
+
23
+
(** {1 Operations} *)
24
+
25
+
(** Get all supported namespaces *)
26
+
let get ~http ~sw ip =
27
+
let json =
28
+
P.make_request_empty ~method_:"GET" ~namespace:"Appliance.System.Ability"
29
+
in
30
+
let* resp = P.http_post ~http ~sw ip json in
31
+
match P.decode (P.response_codec payload_codec) resp with
32
+
| Error _ -> Error (`Msg "Could not query abilities")
33
+
| Ok r -> Ok r.resp_payload.ability
34
+
35
+
(** {1 Feature Checks} *)
36
+
37
+
(** Check if device supports electricity monitoring *)
38
+
let has_electricity abilities =
39
+
List.mem "Appliance.Control.Electricity" abilities
40
+
41
+
(** Check if device supports consumption history *)
42
+
let has_consumption abilities =
43
+
List.mem "Appliance.Control.ConsumptionX" abilities
44
+
45
+
(** Check if device supports timers *)
46
+
let has_timers abilities = List.mem "Appliance.Control.TimerX" abilities
47
+
48
+
(** Check if device supports DND mode *)
49
+
let has_dnd abilities = List.mem "Appliance.System.DNDMode" abilities
50
+
51
+
(** Check if device supports runtime stats *)
52
+
let has_runtime abilities = List.mem "Appliance.System.Runtime" abilities
53
+
54
+
(** Check if device has Matter-related abilities *)
55
+
let has_matter abilities =
56
+
List.exists
57
+
(fun ns ->
58
+
String.length ns >= 6
59
+
&& (String.sub ns (String.length ns - min 6 (String.length ns)) 6
60
+
= "Matter"
61
+
|| String.sub ns (String.length ns - min 4 (String.length ns)) 4
62
+
= "Bind"))
63
+
abilities
64
+
65
+
(** {1 Pretty Printing} *)
66
+
67
+
let pp ppf abilities =
68
+
List.iter
69
+
(fun ns -> Fmt.pf ppf " %s@." ns)
70
+
(List.sort String.compare abilities)
+37
lib/abilities.mli
+37
lib/abilities.mli
···
1
+
(** Meross device abilities.
2
+
3
+
Query supported namespaces via [Appliance.System.Ability] to discover what
4
+
features a device supports. *)
5
+
6
+
(** {1:operations Operations} *)
7
+
8
+
val get :
9
+
http:Protocol.http ->
10
+
sw:Eio.Switch.t ->
11
+
string ->
12
+
(string list, [> `Msg of string ]) result
13
+
(** [get ~net ~sw ip] retrieves list of supported namespaces. *)
14
+
15
+
(** {1:feature Feature checks} *)
16
+
17
+
val has_electricity : string list -> bool
18
+
(** [has_electricity abilities] checks for power monitoring. *)
19
+
20
+
val has_consumption : string list -> bool
21
+
(** [has_consumption abilities] checks for consumption history. *)
22
+
23
+
val has_timers : string list -> bool
24
+
(** [has_timers abilities] checks for timer support. *)
25
+
26
+
val has_dnd : string list -> bool
27
+
(** [has_dnd abilities] checks for DND mode support. *)
28
+
29
+
val has_runtime : string list -> bool
30
+
(** [has_runtime abilities] checks for runtime stats. *)
31
+
32
+
val has_matter : string list -> bool
33
+
(** [has_matter abilities] checks for Matter support. *)
34
+
35
+
(** {1:pp Pretty printing} *)
36
+
37
+
val pp : string list Fmt.t
+41
lib/commissioning.ml
+41
lib/commissioning.ml
···
1
+
(** Meross Matter commissioning.
2
+
3
+
Attempt to trigger Matter commissioning mode via Meross API. *)
4
+
5
+
module P = Protocol
6
+
7
+
let ( let* ) = Result.bind
8
+
9
+
(** {1 Operations} *)
10
+
11
+
(** Unbind device from current Matter fabric. Uses Meross-specific namespace if
12
+
available. *)
13
+
let unbind ~http ~sw ip =
14
+
let json =
15
+
P.make_request_empty ~method_:"SET" ~namespace:"Appliance.Control.Unbind"
16
+
in
17
+
let* resp = P.http_post ~http ~sw ip json in
18
+
P.parse_ack resp
19
+
20
+
(** Trigger Matter commissioning mode. Tries various namespaces that might
21
+
enable pairing. *)
22
+
let trigger ~http ~sw ip =
23
+
let namespaces =
24
+
[
25
+
"Appliance.Config.Matter";
26
+
"Appliance.Control.Matter.Commission";
27
+
"Appliance.System.Position";
28
+
(* Sometimes triggers re-pairing *)
29
+
]
30
+
in
31
+
let try_namespace ns =
32
+
let json = P.make_request_enable ~namespace:ns in
33
+
match P.http_post ~http ~sw ip json with
34
+
| Ok resp -> (
35
+
match P.decode (P.response_codec P.empty_payload_codec) resp with
36
+
| Ok r -> P.is_ack r.resp_header
37
+
| Error _ -> false)
38
+
| Error _ -> false
39
+
in
40
+
if List.exists try_namespace namespaces then Ok ()
41
+
else Error (`Msg "No commissioning trigger found")
+25
lib/commissioning.mli
+25
lib/commissioning.mli
···
1
+
(** Meross Matter commissioning.
2
+
3
+
Helpers for triggering Matter commissioning mode on Meross devices. These
4
+
APIs attempt to put the device into pairing mode for Matter fabric
5
+
enrollment. *)
6
+
7
+
(** {1:operations Operations} *)
8
+
9
+
val unbind :
10
+
http:Protocol.http ->
11
+
sw:Eio.Switch.t ->
12
+
string ->
13
+
(unit, [> `Msg of string ]) result
14
+
(** [unbind ~net ~sw ip] attempts to unbind from current Matter fabric.
15
+
16
+
Uses Meross-specific [Appliance.Control.Unbind] namespace. *)
17
+
18
+
val trigger :
19
+
http:Protocol.http ->
20
+
sw:Eio.Switch.t ->
21
+
string ->
22
+
(unit, [> `Msg of string ]) result
23
+
(** [trigger ~net ~sw ip] attempts to open Matter commissioning window.
24
+
25
+
Tries various Meross namespaces that might enable pairing mode. *)
+49
lib/consumption.ml
+49
lib/consumption.ml
···
1
+
(** Meross historical consumption.
2
+
3
+
Daily energy consumption history in Wh. *)
4
+
5
+
module P = Protocol
6
+
7
+
let ( let* ) = Result.bind
8
+
9
+
(** {1 Types} *)
10
+
11
+
type entry = {
12
+
date : string; (** Date in YYYY-MM-DD format *)
13
+
value : float; (** Energy in Wh *)
14
+
}
15
+
16
+
(** {1 Codecs} *)
17
+
18
+
let entry_codec =
19
+
Jsont.Object.map ~kind:"consumption_entry" (fun date value ->
20
+
{ date; value = value /. 1000.0 }) (* Convert mWh to Wh *)
21
+
|> Jsont.Object.mem "date" Jsont.string ~enc:(fun e -> e.date)
22
+
|> Jsont.Object.mem "value" Jsont.number ~enc:(fun e -> e.value *. 1000.0)
23
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
24
+
25
+
type payload = { consumptionx : entry list }
26
+
27
+
let payload_codec =
28
+
Jsont.Object.map ~kind:"consumptionx_payload" (fun c -> { consumptionx = c })
29
+
|> Jsont.Object.mem "consumptionx" (Jsont.list entry_codec) ~enc:(fun p ->
30
+
p.consumptionx)
31
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
32
+
33
+
(** {1 Operations} *)
34
+
35
+
(** Get historical consumption data *)
36
+
let get ~http ~sw ip =
37
+
let json =
38
+
P.make_request_empty ~method_:"GET"
39
+
~namespace:"Appliance.Control.ConsumptionX"
40
+
in
41
+
let* resp = P.http_post ~http ~sw ip json in
42
+
match P.decode (P.response_codec payload_codec) resp with
43
+
| Error _ -> Error (`Msg "Device does not support consumption history")
44
+
| Ok r -> Ok r.resp_payload.consumptionx
45
+
46
+
(** {1 Pretty Printing} *)
47
+
48
+
let pp_entry ppf e = Fmt.pf ppf "%s: %.1f Wh" e.date e.value
49
+
let pp ppf entries = List.iter (fun e -> Fmt.pf ppf " %a@." pp_entry e) entries
+28
lib/consumption.mli
+28
lib/consumption.mli
···
1
+
(** Meross historical consumption.
2
+
3
+
Daily energy consumption history via [Appliance.Control.ConsumptionX].
4
+
Reports historical energy usage in Wh per day. *)
5
+
6
+
(** {1:types Types} *)
7
+
8
+
type entry = {
9
+
date : string; (** Date in YYYY-MM-DD format *)
10
+
value : float; (** Energy consumed in Wh *)
11
+
}
12
+
(** Daily consumption entry. *)
13
+
14
+
(** {1:operations Operations} *)
15
+
16
+
val get :
17
+
http:Protocol.http ->
18
+
sw:Eio.Switch.t ->
19
+
string ->
20
+
(entry list, [> `Msg of string ]) result
21
+
(** [get ~net ~sw ip] retrieves consumption history.
22
+
23
+
Returns error if device doesn't support consumption tracking. *)
24
+
25
+
(** {1:pp Pretty printing} *)
26
+
27
+
val pp_entry : entry Fmt.t
28
+
val pp : entry list Fmt.t
+195
lib/device.ml
+195
lib/device.ml
···
1
+
(** Meross device info and basic control.
2
+
3
+
Core device operations: info, toggle, on/off, detect. *)
4
+
5
+
module P = Protocol
6
+
7
+
let ( let* ) = Result.bind
8
+
9
+
(** {1 Types} *)
10
+
11
+
type info = {
12
+
device_type : string;
13
+
mac : string;
14
+
uuid : string;
15
+
ip : string;
16
+
firmware : string;
17
+
is_on : bool;
18
+
}
19
+
20
+
(** {1 Internal Codecs} *)
21
+
22
+
type hw_info = { hw_type : string; mac_address : string; uuid : string }
23
+
24
+
let hw_info_codec =
25
+
Jsont.Object.map ~kind:"hardware" (fun hw_type mac_address uuid ->
26
+
{
27
+
hw_type = Option.value ~default:"unknown" hw_type;
28
+
mac_address = Option.value ~default:"" mac_address;
29
+
uuid = Option.value ~default:"" uuid;
30
+
})
31
+
|> Jsont.Object.opt_mem "type" Jsont.string ~enc:(fun h -> Some h.hw_type)
32
+
|> Jsont.Object.opt_mem "macAddress" Jsont.string ~enc:(fun h ->
33
+
Some h.mac_address)
34
+
|> Jsont.Object.opt_mem "uuid" Jsont.string ~enc:(fun h -> Some h.uuid)
35
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
36
+
37
+
type fw_info = { version : string }
38
+
39
+
let fw_info_codec =
40
+
Jsont.Object.map ~kind:"firmware" (fun version ->
41
+
{ version = Option.value ~default:"" version })
42
+
|> Jsont.Object.opt_mem "version" Jsont.string ~enc:(fun f -> Some f.version)
43
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
44
+
45
+
type toggle_info = { onoff : int }
46
+
47
+
let toggle_info_codec =
48
+
Jsont.Object.map ~kind:"toggle" (fun onoff -> { onoff })
49
+
|> Jsont.Object.mem "onoff" Jsont.int ~enc:(fun t -> t.onoff)
50
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
51
+
52
+
type system_info = { hardware : hw_info; firmware : fw_info }
53
+
54
+
let system_info_codec =
55
+
Jsont.Object.map ~kind:"system" (fun hardware firmware ->
56
+
{ hardware; firmware })
57
+
|> Jsont.Object.mem "hardware" hw_info_codec ~enc:(fun s -> s.hardware)
58
+
|> Jsont.Object.mem "firmware" fw_info_codec ~enc:(fun s -> s.firmware)
59
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
60
+
61
+
type digest_info = { togglex : toggle_info list }
62
+
63
+
let digest_info_codec =
64
+
Jsont.Object.map ~kind:"digest" (fun togglex ->
65
+
{ togglex = Option.value ~default:[] togglex })
66
+
|> Jsont.Object.opt_mem "togglex" (Jsont.list toggle_info_codec)
67
+
~enc:(fun d -> Some d.togglex)
68
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
69
+
70
+
type all_info = { system : system_info; digest : digest_info option }
71
+
72
+
let all_info_codec =
73
+
Jsont.Object.map ~kind:"all" (fun system digest -> { system; digest })
74
+
|> Jsont.Object.mem "system" system_info_codec ~enc:(fun a -> a.system)
75
+
|> Jsont.Object.opt_mem "digest" digest_info_codec ~enc:(fun a -> a.digest)
76
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
77
+
78
+
type system_all_payload = { all : all_info }
79
+
80
+
let system_all_payload_codec =
81
+
Jsont.Object.map ~kind:"system_all_payload" (fun all -> { all })
82
+
|> Jsont.Object.mem "all" all_info_codec ~enc:(fun p -> p.all)
83
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
84
+
85
+
(** {1 Toggle Payload} *)
86
+
87
+
type togglex_req = { channel : int; onoff : int; lm_time : int }
88
+
89
+
let togglex_req_codec =
90
+
Jsont.Object.map ~kind:"togglex" (fun channel onoff lm_time ->
91
+
{ channel; onoff; lm_time })
92
+
|> Jsont.Object.mem "channel" Jsont.int ~enc:(fun t -> t.channel)
93
+
|> Jsont.Object.mem "onoff" Jsont.int ~enc:(fun t -> t.onoff)
94
+
|> Jsont.Object.mem "lmTime" Jsont.int ~enc:(fun t -> t.lm_time)
95
+
|> Jsont.Object.finish
96
+
97
+
type togglex_payload = { togglex : togglex_req }
98
+
99
+
let togglex_payload_codec =
100
+
Jsont.Object.map ~kind:"togglex_payload" (fun togglex -> { togglex })
101
+
|> Jsont.Object.mem "togglex" togglex_req_codec ~enc:(fun p -> p.togglex)
102
+
|> Jsont.Object.finish
103
+
104
+
(** {1 Response Parsing} *)
105
+
106
+
let parse_info ip resp =
107
+
match P.decode (P.response_codec system_all_payload_codec) resp with
108
+
| Error _ -> Error (`Msg "Invalid JSON response")
109
+
| Ok r ->
110
+
let all = r.resp_payload.all in
111
+
let hw = all.system.hardware in
112
+
let fw = all.system.firmware in
113
+
let is_on =
114
+
match all.digest with
115
+
| Some d -> (
116
+
match d.togglex with t :: _ -> t.onoff = 1 | [] -> false)
117
+
| None -> false
118
+
in
119
+
Ok
120
+
{
121
+
device_type = hw.hw_type;
122
+
mac = hw.mac_address;
123
+
uuid = hw.uuid;
124
+
ip;
125
+
firmware = fw.version;
126
+
is_on;
127
+
}
128
+
129
+
(** {1 Device Operations} *)
130
+
131
+
(** Check if an IP hosts a Meross device *)
132
+
let is_meross ~http ~sw ip =
133
+
let json =
134
+
P.make_request_empty ~method_:"GET" ~namespace:"Appliance.System.All"
135
+
in
136
+
match P.http_post ~http ~sw ip json with
137
+
| Error _ -> false
138
+
| Ok resp -> (
139
+
match P.decode (P.response_codec P.empty_payload_codec) resp with
140
+
| Ok r -> r.resp_header.namespace = "Appliance.System.All"
141
+
| Error _ -> false)
142
+
143
+
(** Get device info *)
144
+
let get_info ~http ~sw ip =
145
+
let json =
146
+
P.make_request_empty ~method_:"GET" ~namespace:"Appliance.System.All"
147
+
in
148
+
let* resp = P.http_post ~http ~sw ip json in
149
+
parse_info ip resp
150
+
151
+
(** Set power state *)
152
+
let set_power ~http ~sw ip ~on =
153
+
let onoff = if on then 1 else 0 in
154
+
let timestamp = P.unix_epoch_seconds () in
155
+
let toggle : togglex_req = { channel = 0; onoff; lm_time = timestamp } in
156
+
let payload : togglex_payload = { togglex = toggle } in
157
+
let req =
158
+
{
159
+
P.header =
160
+
P.make_header ~method_:"SET" ~namespace:"Appliance.Control.ToggleX";
161
+
P.payload;
162
+
}
163
+
in
164
+
let json = P.encode (P.request_codec togglex_payload_codec) req in
165
+
let* resp = P.http_post ~http ~sw ip json in
166
+
P.parse_ack resp
167
+
168
+
let turn_on ~http ~sw ip = set_power ~http ~sw ip ~on:true
169
+
let turn_off ~http ~sw ip = set_power ~http ~sw ip ~on:false
170
+
171
+
let toggle ~http ~sw ip =
172
+
let* info = get_info ~http ~sw ip in
173
+
set_power ~http ~sw ip ~on:(not info.is_on)
174
+
175
+
(** Reboot the device *)
176
+
let reboot ~http ~sw ip =
177
+
let json =
178
+
P.make_request_empty ~method_:"SET" ~namespace:"Appliance.Control.Reboot"
179
+
in
180
+
let* resp = P.http_post ~http ~sw ip json in
181
+
P.parse_ack resp
182
+
183
+
(** {1 Pretty Printing} *)
184
+
185
+
let pp ppf info =
186
+
Fmt.pf ppf "Meross %s@." info.device_type;
187
+
Fmt.pf ppf " IP: %s@." info.ip;
188
+
Fmt.pf ppf " MAC: %s@." info.mac;
189
+
Fmt.pf ppf " UUID: %s@." info.uuid;
190
+
Fmt.pf ppf " Firmware: %s@." info.firmware;
191
+
Fmt.pf ppf " State: %s@." (if info.is_on then "ON" else "OFF")
192
+
193
+
let pp_short ppf info =
194
+
let state = if info.is_on then "ON" else "OFF" in
195
+
Fmt.pf ppf "%s (%s) %s" info.ip info.device_type state
+74
lib/device.mli
+74
lib/device.mli
···
1
+
(** Meross device info and basic control.
2
+
3
+
Core device operations: retrieve device information, control power state.
4
+
Uses the [Appliance.System.All] and [Appliance.Control.ToggleX] namespaces.
5
+
*)
6
+
7
+
(** {1:types Types} *)
8
+
9
+
type info = {
10
+
device_type : string; (** Model (e.g., "mss315") *)
11
+
mac : string; (** MAC address *)
12
+
uuid : string; (** Device UUID *)
13
+
ip : string; (** IP address *)
14
+
firmware : string; (** Firmware version *)
15
+
is_on : bool; (** Current power state *)
16
+
}
17
+
(** Device information. *)
18
+
19
+
(** {1:detection Detection} *)
20
+
21
+
val is_meross : http:Protocol.http -> sw:Eio.Switch.t -> string -> bool
22
+
(** [is_meross ~net ~sw ip] returns true if IP hosts a Meross device. *)
23
+
24
+
(** {1:info Device info} *)
25
+
26
+
val get_info :
27
+
http:Protocol.http ->
28
+
sw:Eio.Switch.t ->
29
+
string ->
30
+
(info, [> `Msg of string ]) result
31
+
(** [get_info ~net ~sw ip] retrieves device information. *)
32
+
33
+
(** {1:control Power control} *)
34
+
35
+
val set_power :
36
+
http:Protocol.http ->
37
+
sw:Eio.Switch.t ->
38
+
string ->
39
+
on:bool ->
40
+
(unit, [> `Msg of string ]) result
41
+
(** [set_power ~net ~sw ip ~on] sets power state. *)
42
+
43
+
val turn_on :
44
+
http:Protocol.http ->
45
+
sw:Eio.Switch.t ->
46
+
string ->
47
+
(unit, [> `Msg of string ]) result
48
+
(** [turn_on ~net ~sw ip] turns device on. *)
49
+
50
+
val turn_off :
51
+
http:Protocol.http ->
52
+
sw:Eio.Switch.t ->
53
+
string ->
54
+
(unit, [> `Msg of string ]) result
55
+
(** [turn_off ~net ~sw ip] turns device off. *)
56
+
57
+
val toggle :
58
+
http:Protocol.http ->
59
+
sw:Eio.Switch.t ->
60
+
string ->
61
+
(unit, [> `Msg of string ]) result
62
+
(** [toggle ~net ~sw ip] toggles current power state. *)
63
+
64
+
val reboot :
65
+
http:Protocol.http ->
66
+
sw:Eio.Switch.t ->
67
+
string ->
68
+
(unit, [> `Msg of string ]) result
69
+
(** [reboot ~net ~sw ip] reboots the device. *)
70
+
71
+
(** {1:pp Pretty printing} *)
72
+
73
+
val pp : info Fmt.t
74
+
val pp_short : info Fmt.t
+59
lib/dnd.ml
+59
lib/dnd.ml
···
1
+
(** Meross DND mode (LED control).
2
+
3
+
Do Not Disturb mode dims or turns off device LEDs. *)
4
+
5
+
module P = Protocol
6
+
7
+
let ( let* ) = Result.bind
8
+
9
+
(** {1 Types} *)
10
+
11
+
type t = { enabled : bool }
12
+
13
+
(** {1 Codecs} *)
14
+
15
+
let codec =
16
+
Jsont.Object.map ~kind:"dnd_mode" (fun mode -> { enabled = mode = 1 })
17
+
|> Jsont.Object.mem "mode" Jsont.int ~enc:(fun d ->
18
+
if d.enabled then 1 else 0)
19
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
20
+
21
+
type payload = { dnd_mode : t }
22
+
23
+
let payload_codec =
24
+
Jsont.Object.map ~kind:"dnd_mode_payload" (fun d -> { dnd_mode = d })
25
+
|> Jsont.Object.mem "DNDMode" codec ~enc:(fun p -> p.dnd_mode)
26
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
27
+
28
+
(** {1 Operations} *)
29
+
30
+
(** Get DND mode status (true = LEDs off) *)
31
+
let get ~http ~sw ip =
32
+
let json =
33
+
P.make_request_empty ~method_:"GET" ~namespace:"Appliance.System.DNDMode"
34
+
in
35
+
let* resp = P.http_post ~http ~sw ip json in
36
+
match P.decode (P.response_codec payload_codec) resp with
37
+
| Error _ -> Error (`Msg "Device does not support DND mode")
38
+
| Ok r -> Ok r.resp_payload.dnd_mode.enabled
39
+
40
+
(** Set DND mode *)
41
+
let set ~http ~sw ip ~enabled =
42
+
let mode = if enabled then 1 else 0 in
43
+
let header =
44
+
P.make_header ~method_:"SET" ~namespace:"Appliance.System.DNDMode"
45
+
in
46
+
let payload_str = Printf.sprintf {|{"DNDMode":{"mode":%d}}|} mode in
47
+
let req_str =
48
+
Printf.sprintf {|{"header":%s,"payload":%s}|}
49
+
(P.encode P.header_codec header)
50
+
payload_str
51
+
in
52
+
let* resp = P.http_post ~http ~sw ip req_str in
53
+
P.parse_ack resp
54
+
55
+
(** Enable DND mode (LEDs off) *)
56
+
let enable ~http ~sw ip = set ~http ~sw ip ~enabled:true
57
+
58
+
(** Disable DND mode (LEDs on) *)
59
+
let disable ~http ~sw ip = set ~http ~sw ip ~enabled:false
+50
lib/dnd.mli
+50
lib/dnd.mli
···
1
+
(** Meross DND mode (LED control).
2
+
3
+
Do Not Disturb mode via [Appliance.System.DNDMode] dims or turns off the
4
+
device's status LEDs. *)
5
+
6
+
(** {1:types Types} *)
7
+
8
+
type t = { enabled : bool }
9
+
(** DND mode state. *)
10
+
11
+
type payload = { dnd_mode : t }
12
+
(** Payload container. *)
13
+
14
+
(** {1:codecs Codecs} *)
15
+
16
+
val codec : t Jsont.t
17
+
val payload_codec : payload Jsont.t
18
+
19
+
(** {1:operations Operations} *)
20
+
21
+
val get :
22
+
http:Protocol.http ->
23
+
sw:Eio.Switch.t ->
24
+
string ->
25
+
(bool, [> `Msg of string ]) result
26
+
(** [get ~net ~sw ip] checks if DND mode is enabled.
27
+
28
+
Returns [true] if LEDs are off. *)
29
+
30
+
val set :
31
+
http:Protocol.http ->
32
+
sw:Eio.Switch.t ->
33
+
string ->
34
+
enabled:bool ->
35
+
(unit, [> `Msg of string ]) result
36
+
(** [set ~net ~sw ip ~enabled] sets DND mode. *)
37
+
38
+
val enable :
39
+
http:Protocol.http ->
40
+
sw:Eio.Switch.t ->
41
+
string ->
42
+
(unit, [> `Msg of string ]) result
43
+
(** [enable ~net ~sw ip] turns LEDs off. *)
44
+
45
+
val disable :
46
+
http:Protocol.http ->
47
+
sw:Eio.Switch.t ->
48
+
string ->
49
+
(unit, [> `Msg of string ]) result
50
+
(** [disable ~net ~sw ip] turns LEDs on. *)
+15
lib/dune
+15
lib/dune
+54
lib/electricity.ml
+54
lib/electricity.ml
···
1
+
(** Meross power monitoring.
2
+
3
+
Real-time power consumption: watts, voltage, current. *)
4
+
5
+
module P = Protocol
6
+
7
+
let ( let* ) = Result.bind
8
+
9
+
(** {1 Types} *)
10
+
11
+
type t = {
12
+
power : float; (** Current power in watts *)
13
+
voltage : float; (** Current voltage in volts *)
14
+
current : float; (** Current in amps *)
15
+
}
16
+
17
+
(** {1 Codecs} *)
18
+
19
+
let codec =
20
+
Jsont.Object.map ~kind:"electricity" (fun power voltage current ->
21
+
(* Meross reports in milliwatts/decivolts/milliamps *)
22
+
{
23
+
power = power /. 1000.0;
24
+
voltage = voltage /. 10.0;
25
+
current = current /. 1000.0;
26
+
})
27
+
|> Jsont.Object.mem "power" Jsont.number ~enc:(fun e -> e.power *. 1000.0)
28
+
|> Jsont.Object.mem "voltage" Jsont.number ~enc:(fun e -> e.voltage *. 10.0)
29
+
|> Jsont.Object.mem "current" Jsont.number ~enc:(fun e -> e.current *. 1000.0)
30
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
31
+
32
+
type payload = { electricity : t }
33
+
34
+
let payload_codec =
35
+
Jsont.Object.map ~kind:"electricity_payload" (fun e -> { electricity = e })
36
+
|> Jsont.Object.mem "electricity" codec ~enc:(fun p -> p.electricity)
37
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
38
+
39
+
(** {1 Operations} *)
40
+
41
+
(** Get current power consumption *)
42
+
let get ~http ~sw ip =
43
+
let json =
44
+
P.make_request_empty ~method_:"GET"
45
+
~namespace:"Appliance.Control.Electricity"
46
+
in
47
+
let* resp = P.http_post ~http ~sw ip json in
48
+
match P.decode (P.response_codec payload_codec) resp with
49
+
| Error _ -> Error (`Msg "Device does not support electricity monitoring")
50
+
| Ok r -> Ok r.resp_payload.electricity
51
+
52
+
(** {1 Pretty Printing} *)
53
+
54
+
let pp ppf e = Fmt.pf ppf "%.1fW @@ %.1fV (%.3fA)" e.power e.voltage e.current
+28
lib/electricity.mli
+28
lib/electricity.mli
···
1
+
(** Meross power monitoring.
2
+
3
+
Real-time power consumption readings via [Appliance.Control.Electricity].
4
+
Reports instantaneous power (watts), voltage (volts), and current (amps). *)
5
+
6
+
(** {1:types Types} *)
7
+
8
+
type t = {
9
+
power : float; (** Current power in watts *)
10
+
voltage : float; (** Current voltage in volts *)
11
+
current : float; (** Current in amps *)
12
+
}
13
+
(** Power consumption reading. *)
14
+
15
+
(** {1:operations Operations} *)
16
+
17
+
val get :
18
+
http:Protocol.http ->
19
+
sw:Eio.Switch.t ->
20
+
string ->
21
+
(t, [> `Msg of string ]) result
22
+
(** [get ~net ~sw ip] reads current power consumption.
23
+
24
+
Returns error if device doesn't support electricity monitoring. *)
25
+
26
+
(** {1:pp Pretty printing} *)
27
+
28
+
val pp : t Fmt.t
+187
lib/meross.ml
+187
lib/meross.ml
···
1
+
(** Meross smart plug local control.
2
+
3
+
Control Meross smart plugs over local HTTP API.
4
+
5
+
{2 Modules}
6
+
7
+
- {!Protocol}: Core HTTP protocol and authentication
8
+
- {!Device}: Device info and basic on/off control
9
+
- {!Electricity}: Real-time power monitoring
10
+
- {!Consumption}: Historical energy consumption
11
+
- {!Timers}: Scheduled on/off control
12
+
- {!Triggers}: Automation rules (countdown, auto-off)
13
+
- {!Dnd}: LED DND mode control
14
+
- {!Runtime}: WiFi signal and runtime stats
15
+
- {!Abilities}: Feature discovery
16
+
- {!Commissioning}: Matter commissioning helpers
17
+
18
+
{2 Example}
19
+
20
+
{[
21
+
Eio_main.run @@ fun env ->
22
+
Eio.Switch.run @@ fun sw ->
23
+
let http =
24
+
Protocol.create_http ~clock:(Eio.Stdenv.clock env)
25
+
~net:(Eio.Stdenv.net env)
26
+
in
27
+
match Meross.Device.get_info ~http ~sw "192.168.0.6" with
28
+
| Ok info ->
29
+
Fmt.pr "Device: %s, State: %s@." info.device_type
30
+
(if info.is_on then "ON" else "OFF")
31
+
| Error (`Msg msg) -> Fmt.epr "Error: %s@." msg
32
+
]}
33
+
34
+
@see <https://github.com/albertogeniola/MerossIot>
35
+
@see <https://github.com/arandall/meross/blob/main/doc/protocol.md> *)
36
+
37
+
module Protocol = Protocol
38
+
module Device = Device
39
+
module Electricity = Electricity
40
+
module Consumption = Consumption
41
+
module Timers = Timers
42
+
module Triggers = Triggers
43
+
module Dnd = Dnd
44
+
module Runtime = Runtime
45
+
module Abilities = Abilities
46
+
module Commissioning = Commissioning
47
+
48
+
let ( let* ) = Result.bind
49
+
50
+
(** {1 Convenience Re-exports} *)
51
+
52
+
type device_info = Device.info = {
53
+
device_type : string;
54
+
mac : string;
55
+
uuid : string;
56
+
ip : string;
57
+
firmware : string;
58
+
is_on : bool;
59
+
}
60
+
(** Device info type *)
61
+
62
+
type extended_info = {
63
+
device : device_info;
64
+
electricity : Electricity.t option;
65
+
wifi_signal : int option;
66
+
led_off : bool option;
67
+
}
68
+
(** Extended device info with power monitoring *)
69
+
70
+
(** {1 High-Level Operations} *)
71
+
72
+
let get_info = Device.get_info
73
+
let set_power = Device.set_power
74
+
let turn_on = Device.turn_on
75
+
let turn_off = Device.turn_off
76
+
let toggle = Device.toggle
77
+
let reboot = Device.reboot
78
+
let is_meross_device = Device.is_meross
79
+
let get_abilities = Abilities.get
80
+
let get_electricity = Electricity.get
81
+
let get_consumption = Consumption.get
82
+
let get_timers = Timers.get
83
+
let get_dnd_mode ~http ~sw ip = Dnd.get ~http ~sw ip
84
+
let set_dnd_mode = Dnd.set
85
+
let get_runtime = Runtime.get
86
+
let unbind_matter = Commissioning.unbind
87
+
let trigger_commissioning = Commissioning.trigger
88
+
89
+
(** Get full device status including power monitoring *)
90
+
let get_extended_info ~http ~sw ip =
91
+
let* device = Device.get_info ~http ~sw ip in
92
+
let electricity =
93
+
match Electricity.get ~http ~sw ip with Ok e -> Some e | Error _ -> None
94
+
in
95
+
let wifi_signal =
96
+
match Runtime.get_signal ~http ~sw ip with
97
+
| Ok s -> Some s
98
+
| Error _ -> None
99
+
in
100
+
let led_off =
101
+
match Dnd.get ~http ~sw ip with Ok mode -> Some mode | Error _ -> None
102
+
in
103
+
Ok { device; electricity; wifi_signal; led_off }
104
+
105
+
(** {1 Scanning} *)
106
+
107
+
let scan ?(batch_size = 64) ~http ~sw ips =
108
+
(* Process IPs in batches to avoid exhausting file descriptors *)
109
+
let rec process_batches acc remaining =
110
+
match remaining with
111
+
| [] -> List.rev acc
112
+
| _ ->
113
+
let batch, rest =
114
+
let rec take n xs acc =
115
+
if n = 0 then (List.rev acc, xs)
116
+
else
117
+
match xs with
118
+
| [] -> (List.rev acc, [])
119
+
| x :: xs' -> take (n - 1) xs' (x :: acc)
120
+
in
121
+
take batch_size remaining []
122
+
in
123
+
let results =
124
+
Eio.Fiber.List.filter_map
125
+
(fun ip ->
126
+
match Device.get_info ~http ~sw ip with
127
+
| Ok info -> Some info
128
+
| Error _ -> None)
129
+
batch
130
+
in
131
+
process_batches (List.rev_append results acc) rest
132
+
in
133
+
process_batches [] ips
134
+
135
+
(** {1 Device Detection} *)
136
+
137
+
type detected = { name : string; version : string option; info : string option }
138
+
139
+
let detect ~http ~sw ip =
140
+
match Device.get_info ~http ~sw ip with
141
+
| Error _ -> None
142
+
| Ok dev_info ->
143
+
let name =
144
+
match dev_info.device_type with
145
+
| "mss315" -> "Meross Smart Plug (MSS315)"
146
+
| "mss310" -> "Meross Smart Plug (MSS310)"
147
+
| "mss210" -> "Meross Smart Plug (MSS210)"
148
+
| "mss110" -> "Meross Smart Plug (MSS110)"
149
+
| "mss620" -> "Meross Smart Power Strip (MSS620)"
150
+
| "mss425" -> "Meross Smart Power Strip (MSS425)"
151
+
| t -> Fmt.str "Meross Device (%s)" t
152
+
in
153
+
Some
154
+
{
155
+
name;
156
+
version = Some dev_info.firmware;
157
+
info =
158
+
Some
159
+
(Fmt.str "MAC: %s, State: %s" dev_info.mac
160
+
(if dev_info.is_on then "ON" else "OFF"));
161
+
}
162
+
163
+
(** Check if device has Matter abilities *)
164
+
let has_matter_ability ~http ~sw ip =
165
+
match Abilities.get ~http ~sw ip with
166
+
| Error _ -> false
167
+
| Ok abilities -> Abilities.has_matter abilities
168
+
169
+
(** {1 Pretty Printing} *)
170
+
171
+
let pp_info = Device.pp
172
+
let pp_electricity = Electricity.pp
173
+
let pp_consumption = Consumption.pp
174
+
let pp_timer = Timers.pp
175
+
176
+
let pp_extended_info ppf info =
177
+
Device.pp ppf info.device;
178
+
(match info.electricity with
179
+
| Some e -> Fmt.pf ppf " Power: %a@." Electricity.pp e
180
+
| None -> ());
181
+
(match info.wifi_signal with
182
+
| Some s -> Fmt.pf ppf " WiFi: %d%%@." s
183
+
| None -> ());
184
+
match info.led_off with
185
+
| Some true -> Fmt.pf ppf " LED: off (DND mode)@."
186
+
| Some false -> Fmt.pf ppf " LED: on@."
187
+
| None -> ()
+201
lib/meross.mli
+201
lib/meross.mli
···
1
+
(** Meross smart plug local control.
2
+
3
+
Control Meross smart plugs over local HTTP API. No cloud required.
4
+
5
+
{2 Submodules}
6
+
7
+
- {!Protocol}: HTTP protocol and authentication
8
+
- {!Device}: Device info and power control
9
+
- {!Electricity}: Real-time power monitoring
10
+
- {!Consumption}: Historical energy usage
11
+
- {!Timers}: Countdown timers (TimerX)
12
+
- {!Triggers}: Automation rules (TriggerX)
13
+
- {!Dnd}: LED control (Do Not Disturb)
14
+
- {!Runtime}: WiFi signal and stats
15
+
- {!Abilities}: Feature discovery
16
+
- {!Commissioning}: Matter pairing helpers
17
+
18
+
{2 Example}
19
+
20
+
{[
21
+
Eio_main.run @@ fun env ->
22
+
Eio.Switch.run @@ fun sw ->
23
+
let http =
24
+
Protocol.create_http ~clock:(Eio.Stdenv.clock env)
25
+
~net:(Eio.Stdenv.net env)
26
+
in
27
+
match Meross.get_info ~http ~sw "192.168.0.6" with
28
+
| Ok info -> Fmt.pr "%a" Meross.pp_info info
29
+
| Error (`Msg e) -> Fmt.epr "Error: %s@." e
30
+
]} *)
31
+
32
+
(** {1:modules Submodules} *)
33
+
34
+
module Protocol = Protocol
35
+
module Device = Device
36
+
module Electricity = Electricity
37
+
module Consumption = Consumption
38
+
module Timers = Timers
39
+
module Triggers = Triggers
40
+
module Dnd = Dnd
41
+
module Runtime = Runtime
42
+
module Abilities = Abilities
43
+
module Commissioning = Commissioning
44
+
45
+
(** {1:types Types} *)
46
+
47
+
type device_info = Device.info = {
48
+
device_type : string;
49
+
mac : string;
50
+
uuid : string;
51
+
ip : string;
52
+
firmware : string;
53
+
is_on : bool;
54
+
}
55
+
(** Device information. *)
56
+
57
+
type extended_info = {
58
+
device : device_info;
59
+
electricity : Electricity.t option;
60
+
wifi_signal : int option;
61
+
led_off : bool option;
62
+
}
63
+
(** Extended info with power monitoring. *)
64
+
65
+
type detected = { name : string; version : string option; info : string option }
66
+
(** Detection result for {!Identify} integration. *)
67
+
68
+
(** {1:info Device info} *)
69
+
70
+
val get_info :
71
+
http:Protocol.http ->
72
+
sw:Eio.Switch.t ->
73
+
string ->
74
+
(device_info, [> `Msg of string ]) result
75
+
(** [get_info ~net ~sw ip] retrieves device information. *)
76
+
77
+
val get_extended_info :
78
+
http:Protocol.http ->
79
+
sw:Eio.Switch.t ->
80
+
string ->
81
+
(extended_info, [> `Msg of string ]) result
82
+
(** [get_extended_info ~net ~sw ip] retrieves full status. *)
83
+
84
+
(** {1:control Power control} *)
85
+
86
+
val set_power :
87
+
http:Protocol.http ->
88
+
sw:Eio.Switch.t ->
89
+
string ->
90
+
on:bool ->
91
+
(unit, [> `Msg of string ]) result
92
+
(** [set_power ~net ~sw ip ~on] sets power state. *)
93
+
94
+
val turn_on :
95
+
http:Protocol.http ->
96
+
sw:Eio.Switch.t ->
97
+
string ->
98
+
(unit, [> `Msg of string ]) result
99
+
100
+
val turn_off :
101
+
http:Protocol.http ->
102
+
sw:Eio.Switch.t ->
103
+
string ->
104
+
(unit, [> `Msg of string ]) result
105
+
106
+
val toggle :
107
+
http:Protocol.http ->
108
+
sw:Eio.Switch.t ->
109
+
string ->
110
+
(unit, [> `Msg of string ]) result
111
+
112
+
val reboot :
113
+
http:Protocol.http ->
114
+
sw:Eio.Switch.t ->
115
+
string ->
116
+
(unit, [> `Msg of string ]) result
117
+
118
+
(** {1:monitoring Monitoring} *)
119
+
120
+
val get_abilities :
121
+
http:Protocol.http ->
122
+
sw:Eio.Switch.t ->
123
+
string ->
124
+
(string list, [> `Msg of string ]) result
125
+
126
+
val get_electricity :
127
+
http:Protocol.http ->
128
+
sw:Eio.Switch.t ->
129
+
string ->
130
+
(Electricity.t, [> `Msg of string ]) result
131
+
132
+
val get_consumption :
133
+
http:Protocol.http ->
134
+
sw:Eio.Switch.t ->
135
+
string ->
136
+
(Consumption.entry list, [> `Msg of string ]) result
137
+
138
+
val get_timers :
139
+
http:Protocol.http ->
140
+
sw:Eio.Switch.t ->
141
+
string ->
142
+
(Timers.t list, [> `Msg of string ]) result
143
+
144
+
val get_dnd_mode :
145
+
http:Protocol.http ->
146
+
sw:Eio.Switch.t ->
147
+
string ->
148
+
(bool, [> `Msg of string ]) result
149
+
150
+
val set_dnd_mode :
151
+
http:Protocol.http ->
152
+
sw:Eio.Switch.t ->
153
+
string ->
154
+
enabled:bool ->
155
+
(unit, [> `Msg of string ]) result
156
+
157
+
val get_runtime :
158
+
http:Protocol.http ->
159
+
sw:Eio.Switch.t ->
160
+
string ->
161
+
(Runtime.t, [> `Msg of string ]) result
162
+
163
+
(** {1:matter Matter} *)
164
+
165
+
val unbind_matter :
166
+
http:Protocol.http ->
167
+
sw:Eio.Switch.t ->
168
+
string ->
169
+
(unit, [> `Msg of string ]) result
170
+
171
+
val trigger_commissioning :
172
+
http:Protocol.http ->
173
+
sw:Eio.Switch.t ->
174
+
string ->
175
+
(unit, [> `Msg of string ]) result
176
+
177
+
val has_matter_ability : http:Protocol.http -> sw:Eio.Switch.t -> string -> bool
178
+
179
+
(** {1:detection Detection} *)
180
+
181
+
val is_meross_device : http:Protocol.http -> sw:Eio.Switch.t -> string -> bool
182
+
val detect : http:Protocol.http -> sw:Eio.Switch.t -> string -> detected option
183
+
184
+
(** {1:scanning Scanning} *)
185
+
186
+
val scan :
187
+
?batch_size:int ->
188
+
http:Protocol.http ->
189
+
sw:Eio.Switch.t ->
190
+
string list ->
191
+
device_info list
192
+
(** [scan ?batch_size ~net ~sw ips] probes IPs in batches (default 64 per batch)
193
+
to avoid exhausting file descriptors, returning Meross devices found. *)
194
+
195
+
(** {1:pp Pretty printing} *)
196
+
197
+
val pp_info : device_info Fmt.t
198
+
val pp_extended_info : extended_info Fmt.t
199
+
val pp_electricity : Electricity.t Fmt.t
200
+
val pp_consumption : Consumption.entry list Fmt.t
201
+
val pp_timer : Timers.t Fmt.t
+168
lib/protocol.ml
+168
lib/protocol.ml
···
1
+
(** Meross HTTP protocol primitives.
2
+
3
+
Core protocol implementation: authentication, headers, and HTTP transport.
4
+
*)
5
+
6
+
let log_src = Logs.Src.create "meross.protocol"
7
+
8
+
module Log = (val Logs.src_log log_src : Logs.LOG)
9
+
10
+
(** {1 Authentication} *)
11
+
12
+
(** MD5 hash using digestif *)
13
+
let md5 s = Digestif.MD5.(digest_string s |> to_hex)
14
+
15
+
(** Get Unix epoch timestamp using ptime *)
16
+
let unix_epoch_seconds () =
17
+
let ptime = Ptime_clock.now () in
18
+
Ptime.to_float_s ptime |> int_of_float
19
+
20
+
(** Generate message ID and signature. The signature is: md5(messageId + key +
21
+
timestamp). For local access without cloud pairing, an empty key works. *)
22
+
let make_auth () =
23
+
let timestamp = unix_epoch_seconds () in
24
+
(* Use secure random for message ID generation *)
25
+
let rand_bytes = Crypto_rng.generate 4 in
26
+
let rand =
27
+
(Char.code rand_bytes.[0] lsl 24)
28
+
lor (Char.code rand_bytes.[1] lsl 16)
29
+
lor (Char.code rand_bytes.[2] lsl 8)
30
+
lor Char.code rand_bytes.[3]
31
+
in
32
+
let message_id = md5 (Fmt.str "%d%d" rand timestamp) in
33
+
let sign = md5 (Fmt.str "%s%d" message_id timestamp) in
34
+
(message_id, timestamp, sign)
35
+
36
+
(** {1 Header Type and Codec} *)
37
+
38
+
type header = {
39
+
from_ : string;
40
+
message_id : string;
41
+
method_ : string;
42
+
namespace : string;
43
+
payload_version : int;
44
+
sign : string;
45
+
timestamp : int;
46
+
}
47
+
48
+
let header_codec =
49
+
Jsont.Object.map ~kind:"header"
50
+
(fun from_ message_id method_ namespace payload_version sign timestamp ->
51
+
{
52
+
from_;
53
+
message_id;
54
+
method_;
55
+
namespace;
56
+
payload_version;
57
+
sign;
58
+
timestamp;
59
+
})
60
+
|> Jsont.Object.mem "from" Jsont.string ~enc:(fun h -> h.from_)
61
+
|> Jsont.Object.mem "messageId" Jsont.string ~enc:(fun h -> h.message_id)
62
+
|> Jsont.Object.mem "method" Jsont.string ~enc:(fun h -> h.method_)
63
+
|> Jsont.Object.mem "namespace" Jsont.string ~enc:(fun h -> h.namespace)
64
+
|> Jsont.Object.mem "payloadVersion" Jsont.int ~enc:(fun h ->
65
+
h.payload_version)
66
+
|> Jsont.Object.mem "sign" Jsont.string ~enc:(fun h -> h.sign)
67
+
|> Jsont.Object.mem "timestamp" Jsont.int ~enc:(fun h -> h.timestamp)
68
+
|> Jsont.Object.finish
69
+
70
+
(** Build a request header *)
71
+
let make_header ~method_ ~namespace =
72
+
let message_id, timestamp, sign = make_auth () in
73
+
{
74
+
from_ = "";
75
+
message_id;
76
+
method_;
77
+
namespace;
78
+
payload_version = 1;
79
+
sign;
80
+
timestamp;
81
+
}
82
+
83
+
(** {1 Request/Response Types} *)
84
+
85
+
type 'a request = { header : header; payload : 'a }
86
+
87
+
let request_codec payload_codec =
88
+
Jsont.Object.map ~kind:"request" (fun header payload -> { header; payload })
89
+
|> Jsont.Object.mem "header" header_codec ~enc:(fun r -> r.header)
90
+
|> Jsont.Object.mem "payload" payload_codec ~enc:(fun r -> r.payload)
91
+
|> Jsont.Object.finish
92
+
93
+
type 'a response = { resp_header : header; resp_payload : 'a }
94
+
95
+
let response_codec payload_codec =
96
+
Jsont.Object.map ~kind:"response" (fun resp_header resp_payload ->
97
+
{ resp_header; resp_payload })
98
+
|> Jsont.Object.mem "header" header_codec ~enc:(fun r -> r.resp_header)
99
+
|> Jsont.Object.mem "payload" payload_codec ~enc:(fun r -> r.resp_payload)
100
+
|> Jsont.Object.finish
101
+
102
+
(** {1 Common Payload Codecs} *)
103
+
104
+
(** Empty payload for commands that don't need data *)
105
+
let empty_payload_codec : unit Jsont.t =
106
+
Jsont.Object.map ~kind:"empty" ()
107
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
108
+
109
+
type enable_payload = { enable : int }
110
+
(** Enable payload for SET commands *)
111
+
112
+
let enable_payload_codec =
113
+
Jsont.Object.map ~kind:"enable_payload" (fun enable -> { enable })
114
+
|> Jsont.Object.mem "enable" Jsont.int ~enc:(fun p -> p.enable)
115
+
|> Jsont.Object.finish
116
+
117
+
(** {1 JSON Helpers} *)
118
+
119
+
let decode codec s = Jsont_bytesrw.decode_string codec s
120
+
121
+
let encode codec v =
122
+
Jsont_bytesrw.encode_string codec v |> Result.value ~default:""
123
+
124
+
(** {1 Request Builders} *)
125
+
126
+
(** Build a request with empty payload *)
127
+
let make_request_empty ~method_ ~namespace =
128
+
let req = { header = make_header ~method_ ~namespace; payload = () } in
129
+
encode (request_codec empty_payload_codec) req
130
+
131
+
(** Build a request with enable payload *)
132
+
let make_request_enable ~namespace =
133
+
let req =
134
+
{ header = make_header ~method_:"SET" ~namespace; payload = { enable = 1 } }
135
+
in
136
+
encode (request_codec enable_payload_codec) req
137
+
138
+
(** {1 HTTP Transport} *)
139
+
140
+
type http = Http : { net : 'a Eio.Net.t; clock : 'b Eio.Time.clock } -> http
141
+
142
+
let create_http ~net ~clock = Http { net; clock }
143
+
144
+
let http_post ?(timeout = 2.0) ~http ~sw ip json_str =
145
+
let (Http { net; clock }) = http in
146
+
let url = Fmt.str "http://%s/config" ip in
147
+
let headers =
148
+
Requests.Headers.(empty |> set_string "Content-Type" "application/json")
149
+
in
150
+
let body = Requests.Body.of_string Requests.Mime.json json_str in
151
+
let timeout = Requests.Timeout.create ~connect:timeout ~read:timeout () in
152
+
let response =
153
+
Requests.One.post ~sw ~clock ~net ~headers ~body ~timeout ~verify_tls:false
154
+
url
155
+
in
156
+
Ok (Requests.Response.text response)
157
+
158
+
(** {1 Response Helpers} *)
159
+
160
+
(** Check if response is an acknowledgement *)
161
+
let is_ack resp_header = resp_header.method_ = "SETACK"
162
+
163
+
(** Parse and check for SETACK *)
164
+
let parse_ack resp =
165
+
match decode (response_codec empty_payload_codec) resp with
166
+
| Ok r when is_ack r.resp_header -> Ok ()
167
+
| Ok _ -> Error (`Msg "Command not acknowledged")
168
+
| Error _ -> Error (`Msg "Invalid response")
+96
lib/protocol.mli
+96
lib/protocol.mli
···
1
+
(** Meross HTTP protocol primitives.
2
+
3
+
Core protocol implementation for local Meross device communication. Handles
4
+
authentication (MD5 signature), request/response framing, and HTTP
5
+
transport.
6
+
7
+
Messages use a JSON format with [header] (auth, namespace) and [payload]. *)
8
+
9
+
(** {1:header Message header} *)
10
+
11
+
type header = {
12
+
from_ : string;
13
+
message_id : string;
14
+
method_ : string; (** "GET", "SET", or "SETACK" *)
15
+
namespace : string; (** e.g. "Appliance.System.All" *)
16
+
payload_version : int;
17
+
sign : string; (** MD5 signature *)
18
+
timestamp : int;
19
+
}
20
+
(** Request/response header with authentication. *)
21
+
22
+
val header_codec : header Jsont.t
23
+
(** Codec for header serialization. *)
24
+
25
+
val make_header : method_:string -> namespace:string -> header
26
+
(** [make_header ~method_ ~namespace] builds header with fresh auth. *)
27
+
28
+
(** {1:request Request types} *)
29
+
30
+
type 'a request = { header : header; payload : 'a }
31
+
(** Generic request with typed payload. *)
32
+
33
+
val request_codec : 'a Jsont.t -> 'a request Jsont.t
34
+
(** [request_codec payload_codec] builds request codec. *)
35
+
36
+
type 'a response = { resp_header : header; resp_payload : 'a }
37
+
(** Generic response with typed payload. *)
38
+
39
+
val response_codec : 'a Jsont.t -> 'a response Jsont.t
40
+
(** [response_codec payload_codec] builds response codec. *)
41
+
42
+
(** {1:payloads Common payloads} *)
43
+
44
+
val empty_payload_codec : unit Jsont.t
45
+
(** Empty payload codec for requests without data. *)
46
+
47
+
type enable_payload = { enable : int }
48
+
(** Enable payload for SET commands. *)
49
+
50
+
val enable_payload_codec : enable_payload Jsont.t
51
+
52
+
(** {1:builders Request builders} *)
53
+
54
+
val make_request_empty : method_:string -> namespace:string -> string
55
+
(** [make_request_empty ~method_ ~namespace] builds request with empty payload.
56
+
*)
57
+
58
+
val make_request_enable : namespace:string -> string
59
+
(** [make_request_enable ~namespace] builds SET request with enable=1. *)
60
+
61
+
(** {1:transport HTTP transport} *)
62
+
63
+
type http
64
+
(** HTTP client type. *)
65
+
66
+
val create_http : net:_ Eio.Net.t -> clock:_ Eio.Time.clock -> http
67
+
(** [create_http ~net ~clock] creates an HTTP client. *)
68
+
69
+
val http_post :
70
+
?timeout:float ->
71
+
http:http ->
72
+
sw:Eio.Switch.t ->
73
+
string ->
74
+
string ->
75
+
(string, [> `Msg of string ]) result
76
+
(** [http_post ?timeout ~http ~sw ip json] posts JSON to device's /config
77
+
endpoint. Default timeout is 2 seconds. *)
78
+
79
+
(** {1:response Response helpers} *)
80
+
81
+
val is_ack : header -> bool
82
+
(** [is_ack header] returns true if method is "SETACK". *)
83
+
84
+
val parse_ack : string -> (unit, [> `Msg of string ]) result
85
+
(** [parse_ack resp] checks response is a valid acknowledgement. *)
86
+
87
+
(** {1:utils Utilities} *)
88
+
89
+
val unix_epoch_seconds : unit -> int
90
+
(** [unix_epoch_seconds ()] returns current Unix timestamp. *)
91
+
92
+
val decode : 'a Jsont.t -> string -> ('a, string) result
93
+
(** [decode codec s] decodes JSON string. *)
94
+
95
+
val encode : 'a Jsont.t -> 'a -> string
96
+
(** [encode codec v] encodes value to JSON string. *)
+43
lib/runtime.ml
+43
lib/runtime.ml
···
1
+
(** Meross runtime stats.
2
+
3
+
WiFi signal strength and other runtime information. *)
4
+
5
+
module P = Protocol
6
+
7
+
let ( let* ) = Result.bind
8
+
9
+
(** {1 Types} *)
10
+
11
+
type t = { signal : int (** WiFi signal strength 0-100 *) }
12
+
13
+
(** {1 Codecs} *)
14
+
15
+
let codec =
16
+
Jsont.Object.map ~kind:"runtime" (fun signal ->
17
+
{ signal = Option.value ~default:0 signal })
18
+
|> Jsont.Object.opt_mem "signal" Jsont.int ~enc:(fun r -> Some r.signal)
19
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
20
+
21
+
type payload = { runtime : t }
22
+
23
+
let payload_codec =
24
+
Jsont.Object.map ~kind:"runtime_payload" (fun r -> { runtime = r })
25
+
|> Jsont.Object.mem "runtime" codec ~enc:(fun p -> p.runtime)
26
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
27
+
28
+
(** {1 Operations} *)
29
+
30
+
(** Get runtime stats *)
31
+
let get ~http ~sw ip =
32
+
let json =
33
+
P.make_request_empty ~method_:"GET" ~namespace:"Appliance.System.Runtime"
34
+
in
35
+
let* resp = P.http_post ~http ~sw ip json in
36
+
match P.decode (P.response_codec payload_codec) resp with
37
+
| Error _ -> Error (`Msg "Device does not support runtime info")
38
+
| Ok r -> Ok r.resp_payload.runtime
39
+
40
+
(** Get WiFi signal strength *)
41
+
let get_signal ~http ~sw ip =
42
+
let* r = get ~http ~sw ip in
43
+
Ok r.signal
+33
lib/runtime.mli
+33
lib/runtime.mli
···
1
+
(** Meross runtime stats.
2
+
3
+
Runtime information via [Appliance.System.Runtime] including WiFi signal
4
+
strength. *)
5
+
6
+
(** {1:types Types} *)
7
+
8
+
type t = { signal : int (** WiFi signal strength 0-100 *) }
9
+
(** Runtime statistics. *)
10
+
11
+
type payload = { runtime : t }
12
+
(** Payload container. *)
13
+
14
+
(** {1:codecs Codecs} *)
15
+
16
+
val codec : t Jsont.t
17
+
val payload_codec : payload Jsont.t
18
+
19
+
(** {1:operations Operations} *)
20
+
21
+
val get :
22
+
http:Protocol.http ->
23
+
sw:Eio.Switch.t ->
24
+
string ->
25
+
(t, [> `Msg of string ]) result
26
+
(** [get ~net ~sw ip] retrieves runtime stats. *)
27
+
28
+
val get_signal :
29
+
http:Protocol.http ->
30
+
sw:Eio.Switch.t ->
31
+
string ->
32
+
(int, [> `Msg of string ]) result
33
+
(** [get_signal ~net ~sw ip] gets WiFi signal strength. *)
+157
lib/timers.ml
+157
lib/timers.ml
···
1
+
(** Meross timer control (TimerX namespace).
2
+
3
+
TimerX provides countdown timers for turning devices on/off after a
4
+
specified duration. *)
5
+
6
+
module P = Protocol
7
+
8
+
let ( let* ) = Result.bind
9
+
10
+
(** {1 Types} *)
11
+
12
+
type countdown = {
13
+
onoff : int; (** Target state: 0=off, 1=on *)
14
+
end_time : int; (** Unix timestamp when timer fires *)
15
+
duration : int; (** Duration in seconds *)
16
+
}
17
+
(** Countdown timer configuration *)
18
+
19
+
type t = {
20
+
channel : int;
21
+
timer_type : int; (** 1 = countdown *)
22
+
down : countdown option;
23
+
}
24
+
(** Timer entry *)
25
+
26
+
(** {1 Codecs} *)
27
+
28
+
let countdown_codec =
29
+
Jsont.Object.map ~kind:"countdown" (fun onoff end_time duration ->
30
+
{
31
+
onoff = Option.value ~default:0 onoff;
32
+
end_time = Option.value ~default:0 end_time;
33
+
duration = Option.value ~default:0 duration;
34
+
})
35
+
|> Jsont.Object.opt_mem "onoff" Jsont.int ~enc:(fun c -> Some c.onoff)
36
+
|> Jsont.Object.opt_mem "end" Jsont.int ~enc:(fun c -> Some c.end_time)
37
+
|> Jsont.Object.opt_mem "duration" Jsont.int ~enc:(fun c -> Some c.duration)
38
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
39
+
40
+
let timer_codec =
41
+
Jsont.Object.map ~kind:"timer" (fun channel timer_type down ->
42
+
{
43
+
channel = Option.value ~default:0 channel;
44
+
timer_type = Option.value ~default:1 timer_type;
45
+
down;
46
+
})
47
+
|> Jsont.Object.opt_mem "channel" Jsont.int ~enc:(fun t -> Some t.channel)
48
+
|> Jsont.Object.opt_mem "type" Jsont.int ~enc:(fun t -> Some t.timer_type)
49
+
|> Jsont.Object.opt_mem "down" countdown_codec ~enc:(fun t -> t.down)
50
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
51
+
52
+
type payload = { timerx : t list }
53
+
(** Payload with timer list *)
54
+
55
+
let payload_codec =
56
+
Jsont.Object.map ~kind:"timerx_payload" (fun t -> { timerx = t })
57
+
|> Jsont.Object.mem "timerx" (Jsont.list timer_codec) ~enc:(fun p -> p.timerx)
58
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
59
+
60
+
(** {1 Operations} *)
61
+
62
+
(** Get all timers *)
63
+
let get ~http ~sw ip =
64
+
let json =
65
+
P.make_request_empty ~method_:"GET" ~namespace:"Appliance.Control.TimerX"
66
+
in
67
+
let* resp = P.http_post ~http ~sw ip json in
68
+
Logs.info (fun m -> m "TimerX GET response: %s" resp);
69
+
match P.decode (P.response_codec payload_codec) resp with
70
+
| Error _ -> Ok []
71
+
| Ok r -> Ok r.resp_payload.timerx
72
+
73
+
(** Set a countdown timer to turn off after duration seconds *)
74
+
let set_off_timer ~http ~sw ip ~duration =
75
+
let now = P.unix_epoch_seconds () in
76
+
let timer =
77
+
{
78
+
channel = 0;
79
+
timer_type = 1;
80
+
(* countdown *)
81
+
down =
82
+
Some { onoff = 0; (* turn OFF *) end_time = now + duration; duration };
83
+
}
84
+
in
85
+
let payload = { timerx = [ timer ] } in
86
+
let req =
87
+
{
88
+
P.header =
89
+
P.make_header ~method_:"SET" ~namespace:"Appliance.Control.TimerX";
90
+
P.payload;
91
+
}
92
+
in
93
+
let json = P.encode (P.request_codec payload_codec) req in
94
+
Logs.info (fun m -> m "TimerX SET request: %s" json);
95
+
let* resp = P.http_post ~http ~sw ip json in
96
+
Logs.info (fun m -> m "TimerX SET response: %s" resp);
97
+
P.parse_ack resp
98
+
99
+
(** Set a countdown timer to turn on after duration seconds *)
100
+
let set_on_timer ~http ~sw ip ~duration =
101
+
let now = P.unix_epoch_seconds () in
102
+
let timer =
103
+
{
104
+
channel = 0;
105
+
timer_type = 1;
106
+
(* countdown *)
107
+
down =
108
+
Some { onoff = 1; (* turn ON *) end_time = now + duration; duration };
109
+
}
110
+
in
111
+
let payload = { timerx = [ timer ] } in
112
+
let req =
113
+
{
114
+
P.header =
115
+
P.make_header ~method_:"SET" ~namespace:"Appliance.Control.TimerX";
116
+
P.payload;
117
+
}
118
+
in
119
+
let json = P.encode (P.request_codec payload_codec) req in
120
+
Logs.info (fun m -> m "TimerX SET request: %s" json);
121
+
let* resp = P.http_post ~http ~sw ip json in
122
+
Logs.info (fun m -> m "TimerX SET response: %s" resp);
123
+
P.parse_ack resp
124
+
125
+
(** Cancel all timers *)
126
+
let clear ~http ~sw ip =
127
+
let payload = { timerx = [] } in
128
+
let req =
129
+
{
130
+
P.header =
131
+
P.make_header ~method_:"SET" ~namespace:"Appliance.Control.TimerX";
132
+
P.payload;
133
+
}
134
+
in
135
+
let json = P.encode (P.request_codec payload_codec) req in
136
+
let* resp = P.http_post ~http ~sw ip json in
137
+
P.parse_ack resp
138
+
139
+
(** {1 Pretty Printing} *)
140
+
141
+
let format_duration secs =
142
+
if secs < 60 then Printf.sprintf "%ds" secs
143
+
else if secs < 3600 then Printf.sprintf "%dm%ds" (secs / 60) (secs mod 60)
144
+
else Printf.sprintf "%dh%dm" (secs / 3600) (secs mod 3600 / 60)
145
+
146
+
let pp_countdown ppf c =
147
+
let action = if c.onoff = 0 then "OFF" else "ON" in
148
+
let now = P.unix_epoch_seconds () in
149
+
let remaining = c.end_time - now in
150
+
if remaining > 0 then
151
+
Fmt.pf ppf "turn %s in %s" action (format_duration remaining)
152
+
else Fmt.pf ppf "turn %s (expired)" action
153
+
154
+
let pp ppf t =
155
+
match t.down with
156
+
| Some c -> Fmt.pf ppf "Timer[ch%d]: %a" t.channel pp_countdown c
157
+
| None -> Fmt.pf ppf "Timer[ch%d]: (no config)" t.channel
+67
lib/timers.mli
+67
lib/timers.mli
···
1
+
(** Meross timer control.
2
+
3
+
Countdown timers via [Appliance.Control.TimerX] for scheduling automatic
4
+
power state changes after a duration. *)
5
+
6
+
(** {1:types Types} *)
7
+
8
+
type countdown = {
9
+
onoff : int; (** Target state: 0=off, 1=on *)
10
+
end_time : int; (** Unix timestamp when timer fires *)
11
+
duration : int; (** Duration in seconds *)
12
+
}
13
+
(** Countdown configuration. *)
14
+
15
+
type t = {
16
+
channel : int; (** Output channel (0 for single-outlet) *)
17
+
timer_type : int; (** Timer type: 1=countdown *)
18
+
down : countdown option;
19
+
}
20
+
(** Timer entry. *)
21
+
22
+
type payload = { timerx : t list }
23
+
(** Payload container. *)
24
+
25
+
(** {1:codecs JSON codecs} *)
26
+
27
+
val countdown_codec : countdown Jsont.t
28
+
val timer_codec : t Jsont.t
29
+
val payload_codec : payload Jsont.t
30
+
31
+
(** {1:operations Operations} *)
32
+
33
+
val get :
34
+
http:Protocol.http ->
35
+
sw:Eio.Switch.t ->
36
+
string ->
37
+
(t list, [> `Msg of string ]) result
38
+
(** [get ~net ~sw ip] retrieves all active timers. *)
39
+
40
+
val set_off_timer :
41
+
http:Protocol.http ->
42
+
sw:Eio.Switch.t ->
43
+
string ->
44
+
duration:int ->
45
+
(unit, [> `Msg of string ]) result
46
+
(** [set_off_timer ~net ~sw ip ~duration] sets timer to turn off. *)
47
+
48
+
val set_on_timer :
49
+
http:Protocol.http ->
50
+
sw:Eio.Switch.t ->
51
+
string ->
52
+
duration:int ->
53
+
(unit, [> `Msg of string ]) result
54
+
(** [set_on_timer ~net ~sw ip ~duration] sets timer to turn on. *)
55
+
56
+
val clear :
57
+
http:Protocol.http ->
58
+
sw:Eio.Switch.t ->
59
+
string ->
60
+
(unit, [> `Msg of string ]) result
61
+
(** [clear ~net ~sw ip] cancels all timers. *)
62
+
63
+
(** {1:pp Pretty printing} *)
64
+
65
+
val format_duration : int -> string
66
+
val pp_countdown : countdown Fmt.t
67
+
val pp : t Fmt.t
+161
lib/triggers.ml
+161
lib/triggers.ml
···
1
+
(** Meross trigger/automation control.
2
+
3
+
Triggers are automation rules like "turn off after X seconds" or countdown
4
+
timers. *)
5
+
6
+
module P = Protocol
7
+
8
+
let ( let* ) = Result.bind
9
+
10
+
(** {1 Types} *)
11
+
12
+
type rule = {
13
+
week : int; (** Day bitmask: bit 0=Sun, 1=Mon, ..., 6=Sat; 127=daily *)
14
+
duration : int; (** Duration in seconds *)
15
+
}
16
+
17
+
type t = {
18
+
id : string;
19
+
trigger_type : int; (** 1 = weekly, 2 = once/countdown *)
20
+
enabled : bool;
21
+
channel : int;
22
+
alias : string;
23
+
create_time : int;
24
+
rule : rule;
25
+
}
26
+
27
+
(** {1 Codecs} *)
28
+
29
+
let rule_codec =
30
+
Jsont.Object.map ~kind:"rule" (fun week duration -> { week; duration })
31
+
|> Jsont.Object.mem "week" Jsont.int ~enc:(fun r -> r.week)
32
+
|> Jsont.Object.mem "duration" Jsont.int ~enc:(fun r -> r.duration)
33
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
34
+
35
+
let codec =
36
+
Jsont.Object.map ~kind:"trigger"
37
+
(fun id trigger_type enabled channel alias create_time rule ->
38
+
{
39
+
id;
40
+
trigger_type = Option.value ~default:0 trigger_type;
41
+
enabled = enabled = 1;
42
+
channel = Option.value ~default:0 channel;
43
+
alias = Option.value ~default:"" alias;
44
+
create_time = Option.value ~default:0 create_time;
45
+
rule;
46
+
})
47
+
|> Jsont.Object.mem "id" Jsont.string ~enc:(fun t -> t.id)
48
+
|> Jsont.Object.opt_mem "type" Jsont.int ~enc:(fun t -> Some t.trigger_type)
49
+
|> Jsont.Object.mem "enable" Jsont.int ~enc:(fun t ->
50
+
if t.enabled then 1 else 0)
51
+
|> Jsont.Object.opt_mem "channel" Jsont.int ~enc:(fun t -> Some t.channel)
52
+
|> Jsont.Object.opt_mem "alias" Jsont.string ~enc:(fun t ->
53
+
if t.alias = "" then None else Some t.alias)
54
+
|> Jsont.Object.opt_mem "createTime" Jsont.int ~enc:(fun t ->
55
+
Some t.create_time)
56
+
|> Jsont.Object.mem "rule" rule_codec ~enc:(fun t -> t.rule)
57
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
58
+
59
+
type payload = { triggerx : t list }
60
+
61
+
let payload_codec =
62
+
Jsont.Object.map ~kind:"triggerx_payload" (fun t -> { triggerx = t })
63
+
|> Jsont.Object.mem "triggerx" (Jsont.list codec) ~enc:(fun p -> p.triggerx)
64
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
65
+
66
+
type single_payload = { trigger : t }
67
+
(** Single trigger payload for SET operations *)
68
+
69
+
let single_payload_codec =
70
+
Jsont.Object.map ~kind:"single_triggerx_payload" (fun t -> { trigger = t })
71
+
|> Jsont.Object.mem "triggerx" codec ~enc:(fun p -> p.trigger)
72
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
73
+
74
+
type digest_payload = { digest : t list }
75
+
(** Digest payload uses "digest" field instead of "triggerx" *)
76
+
77
+
let digest_payload_codec =
78
+
Jsont.Object.map ~kind:"digest_payload" (fun d -> { digest = d })
79
+
|> Jsont.Object.mem "digest" (Jsont.list codec) ~enc:(fun p -> p.digest)
80
+
|> Jsont.Object.skip_unknown |> Jsont.Object.finish
81
+
82
+
(** {1 Operations} *)
83
+
84
+
(** Get all triggers via Digest *)
85
+
let get ~http ~sw ip =
86
+
let json =
87
+
P.make_request_empty ~method_:"GET" ~namespace:"Appliance.Digest.TriggerX"
88
+
in
89
+
let* resp = P.http_post ~http ~sw ip json in
90
+
match P.decode (P.response_codec digest_payload_codec) resp with
91
+
| Error _ -> Ok []
92
+
| Ok r -> Ok r.resp_payload.digest
93
+
94
+
(** Generate a unique trigger ID using secure random *)
95
+
let make_id () =
96
+
let rand_bytes = Crypto_rng.generate 3 in
97
+
Printf.sprintf "%02x%02x%02x"
98
+
(Char.code rand_bytes.[0])
99
+
(Char.code rand_bytes.[1])
100
+
(Char.code rand_bytes.[2])
101
+
102
+
(** Create a countdown trigger to turn off after duration seconds *)
103
+
let set_countdown ~http ~sw ip ~duration =
104
+
let trigger =
105
+
{
106
+
id = make_id ();
107
+
trigger_type = 2;
108
+
(* 2 = once/countdown *)
109
+
enabled = true;
110
+
channel = 0;
111
+
alias = "auto-off";
112
+
create_time = int_of_float (Unix.time ());
113
+
rule = { week = 128; duration };
114
+
(* MSB set for once triggers *)
115
+
}
116
+
in
117
+
let payload = { trigger } in
118
+
let req =
119
+
{
120
+
P.header =
121
+
P.make_header ~method_:"SET" ~namespace:"Appliance.Control.TriggerX";
122
+
P.payload;
123
+
}
124
+
in
125
+
let json = P.encode (P.request_codec single_payload_codec) req in
126
+
Logs.info (fun m -> m "TriggerX request: %s" json);
127
+
let* resp = P.http_post ~http ~sw ip json in
128
+
Logs.info (fun m -> m "TriggerX response: %s" resp);
129
+
P.parse_ack resp
130
+
131
+
(** Cancel all triggers *)
132
+
let clear ~http ~sw ip =
133
+
(* Send empty trigger list to clear *)
134
+
let payload = { triggerx = [] } in
135
+
let req =
136
+
{
137
+
P.header =
138
+
P.make_header ~method_:"SET" ~namespace:"Appliance.Control.TriggerX";
139
+
P.payload;
140
+
}
141
+
in
142
+
let json = P.encode (P.request_codec payload_codec) req in
143
+
let* resp = P.http_post ~http ~sw ip json in
144
+
P.parse_ack resp
145
+
146
+
(** {1 Pretty Printing} *)
147
+
148
+
let pp_rule ppf r =
149
+
if r.week = 0 then Fmt.pf ppf "once, %ds" r.duration
150
+
else if r.week = 127 then Fmt.pf ppf "daily, %ds" r.duration
151
+
else Fmt.pf ppf "week=%d, %ds" r.week r.duration
152
+
153
+
let pp ppf t =
154
+
let state = if t.enabled then "enabled" else "disabled" in
155
+
Fmt.pf ppf "Trigger %s [%s]: %a (ch=%d)" t.id state pp_rule t.rule t.channel
156
+
157
+
(** Format duration as human readable *)
158
+
let format_duration secs =
159
+
if secs < 60 then Printf.sprintf "%ds" secs
160
+
else if secs < 3600 then Printf.sprintf "%dm%ds" (secs / 60) (secs mod 60)
161
+
else Printf.sprintf "%dh%dm" (secs / 3600) (secs mod 3600 / 60)
+68
lib/triggers.mli
+68
lib/triggers.mli
···
1
+
(** Meross trigger/automation control.
2
+
3
+
Automation rules via [Appliance.Control.TriggerX] for scheduled or
4
+
countdown-based actions. Supports weekly schedules and one-time countdown
5
+
timers. *)
6
+
7
+
(** {1:types Types} *)
8
+
9
+
type rule = {
10
+
week : int; (** Day bitmask: 0=Sun..6=Sat, 127=daily, 128=once *)
11
+
duration : int; (** Duration in seconds *)
12
+
}
13
+
(** Trigger timing rule. *)
14
+
15
+
type t = {
16
+
id : string; (** Unique trigger ID *)
17
+
trigger_type : int; (** 1=weekly, 2=once/countdown *)
18
+
enabled : bool; (** Whether trigger is active *)
19
+
channel : int; (** Output channel *)
20
+
alias : string; (** User-defined name *)
21
+
create_time : int; (** Creation timestamp *)
22
+
rule : rule; (** Timing configuration *)
23
+
}
24
+
(** Trigger configuration. *)
25
+
26
+
(** {1:operations Operations} *)
27
+
28
+
val get :
29
+
http:Protocol.http ->
30
+
sw:Eio.Switch.t ->
31
+
string ->
32
+
(t list, [> `Msg of string ]) result
33
+
(** [get ~net ~sw ip] retrieves all triggers. *)
34
+
35
+
val set_countdown :
36
+
http:Protocol.http ->
37
+
sw:Eio.Switch.t ->
38
+
string ->
39
+
duration:int ->
40
+
(unit, [> `Msg of string ]) result
41
+
(** [set_countdown ~net ~sw ip ~duration] creates countdown to turn off. *)
42
+
43
+
val clear :
44
+
http:Protocol.http ->
45
+
sw:Eio.Switch.t ->
46
+
string ->
47
+
(unit, [> `Msg of string ]) result
48
+
(** [clear ~net ~sw ip] removes all triggers. *)
49
+
50
+
(** {1:pp Pretty printing} *)
51
+
52
+
val format_duration : int -> string
53
+
val pp_rule : rule Fmt.t
54
+
val pp : t Fmt.t
55
+
56
+
(** {1:codecs Codecs} *)
57
+
58
+
val rule_codec : rule Jsont.t
59
+
val codec : t Jsont.t
60
+
61
+
type payload = { triggerx : t list }
62
+
63
+
val payload_codec : payload Jsont.t
64
+
65
+
type digest_payload = { digest : t list }
66
+
67
+
val digest_payload_codec : digest_payload Jsont.t
68
+
val make_id : unit -> string
+46
meross.opam
+46
meross.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "Meross smart plug local control over HTTP"
4
+
description:
5
+
"Control Meross smart plugs over local HTTP API without cloud. Supports power control, energy monitoring, timers, triggers, LED control, and Matter pairing."
6
+
maintainer: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
7
+
authors: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
8
+
license: "MIT"
9
+
homepage: "https://tangled.org/gazagnaire.org/ocaml-meross"
10
+
bug-reports: "https://tangled.org/gazagnaire.org/ocaml-meross/issues"
11
+
depends: [
12
+
"ocaml" {>= "5.1"}
13
+
"dune" {>= "3.21" & >= "3.21"}
14
+
"cmdliner" {>= "1.2"}
15
+
"requests"
16
+
"digestif" {>= "1.0"}
17
+
"eio" {>= "1.0"}
18
+
"eio_main" {>= "1.0"}
19
+
"fmt" {>= "0.9"}
20
+
"ipaddr" {>= "5.0"}
21
+
"jsont" {>= "0.1.0"}
22
+
"bytesrw" {>= "0.1.0"}
23
+
"logs" {>= "0.7"}
24
+
"crypto-rng" {>= "1.0"}
25
+
"ptime" {>= "1.0"}
26
+
"uri" {>= "4.0"}
27
+
"alcotest" {with-test}
28
+
"crowbar" {with-test}
29
+
"odoc" {with-doc}
30
+
]
31
+
build: [
32
+
["dune" "subst"] {dev}
33
+
[
34
+
"dune"
35
+
"build"
36
+
"-p"
37
+
name
38
+
"-j"
39
+
jobs
40
+
"@install"
41
+
"@runtest" {with-test}
42
+
"@doc" {with-doc}
43
+
]
44
+
]
45
+
dev-repo: "git+https://tangled.org/gazagnaire.org/ocaml-meross"
46
+
x-maintenance-intent: ["(latest)"]
+3
test/dune
+3
test/dune
+3
test/test.ml
+3
test/test.ml
+592
test/test_meross.ml
+592
test/test_meross.ml
···
1
+
(* Tests for Meross protocol encoding/decoding *)
2
+
3
+
let is_substring str ~substring =
4
+
let len = String.length substring in
5
+
let rec check i =
6
+
if i + len > String.length str then false
7
+
else if String.sub str i len = substring then true
8
+
else check (i + 1)
9
+
in
10
+
check 0
11
+
12
+
(* {1 Protocol Tests} *)
13
+
14
+
let test_header_codec () =
15
+
let header : Meross.Protocol.header =
16
+
{
17
+
from_ = "";
18
+
message_id = "abc123";
19
+
method_ = "GET";
20
+
namespace = "Appliance.System.All";
21
+
payload_version = 1;
22
+
sign = "def456";
23
+
timestamp = 1234567890;
24
+
}
25
+
in
26
+
let encoded = Meross.Protocol.encode Meross.Protocol.header_codec header in
27
+
Alcotest.(check bool)
28
+
"contains messageId" true
29
+
(String.length encoded > 0 && is_substring encoded ~substring:"messageId");
30
+
Alcotest.(check bool)
31
+
"contains namespace" true
32
+
(is_substring encoded ~substring:"Appliance.System.All")
33
+
34
+
let test_header_roundtrip () =
35
+
let header : Meross.Protocol.header =
36
+
{
37
+
from_ = "test";
38
+
message_id = "abcdef1234567890abcdef1234567890";
39
+
method_ = "GET";
40
+
namespace = "Appliance.System.All";
41
+
payload_version = 1;
42
+
sign = "fedcba0987654321fedcba0987654321";
43
+
timestamp = 1234567890;
44
+
}
45
+
in
46
+
let encoded = Meross.Protocol.encode Meross.Protocol.header_codec header in
47
+
match Meross.Protocol.decode Meross.Protocol.header_codec encoded with
48
+
| Ok decoded ->
49
+
Alcotest.(check string) "from_" header.from_ decoded.from_;
50
+
Alcotest.(check string) "message_id" header.message_id decoded.message_id;
51
+
Alcotest.(check string) "method_" header.method_ decoded.method_;
52
+
Alcotest.(check string) "namespace" header.namespace decoded.namespace;
53
+
Alcotest.(check int)
54
+
"payload_version" header.payload_version decoded.payload_version;
55
+
Alcotest.(check string) "sign" header.sign decoded.sign;
56
+
Alcotest.(check int) "timestamp" header.timestamp decoded.timestamp
57
+
| Error e -> Alcotest.fail (Printf.sprintf "decode failed: %s" e)
58
+
59
+
let test_make_header () =
60
+
let header =
61
+
Meross.Protocol.make_header ~method_:"GET" ~namespace:"Appliance.System.All"
62
+
in
63
+
Alcotest.(check string) "method" "GET" header.method_;
64
+
Alcotest.(check string) "namespace" "Appliance.System.All" header.namespace;
65
+
Alcotest.(check int) "payload_version" 1 header.payload_version;
66
+
Alcotest.(check int) "message_id length" 32 (String.length header.message_id);
67
+
Alcotest.(check int) "sign length" 32 (String.length header.sign)
68
+
69
+
let test_make_request_empty () =
70
+
let req =
71
+
Meross.Protocol.make_request_empty ~method_:"GET"
72
+
~namespace:"Appliance.System.All"
73
+
in
74
+
Alcotest.(check bool) "is json" true (String.length req > 0 && req.[0] = '{');
75
+
Alcotest.(check bool)
76
+
"contains header" true
77
+
(is_substring req ~substring:"header");
78
+
Alcotest.(check bool)
79
+
"contains payload" true
80
+
(is_substring req ~substring:"payload");
81
+
Alcotest.(check bool)
82
+
"contains namespace" true
83
+
(is_substring req ~substring:"Appliance.System.All")
84
+
85
+
let test_make_request_enable () =
86
+
let req =
87
+
Meross.Protocol.make_request_enable ~namespace:"Appliance.System.DND"
88
+
in
89
+
Alcotest.(check bool) "is json" true (String.length req > 0 && req.[0] = '{');
90
+
Alcotest.(check bool)
91
+
"contains enable" true
92
+
(is_substring req ~substring:"enable")
93
+
94
+
let test_is_ack () =
95
+
let header : Meross.Protocol.header =
96
+
{
97
+
from_ = "";
98
+
message_id = "abc";
99
+
method_ = "SETACK";
100
+
namespace = "test";
101
+
payload_version = 1;
102
+
sign = "def";
103
+
timestamp = 0;
104
+
}
105
+
in
106
+
Alcotest.(check bool) "is ack" true (Meross.Protocol.is_ack header);
107
+
let header2 = { header with method_ = "GET" } in
108
+
Alcotest.(check bool) "not ack" false (Meross.Protocol.is_ack header2)
109
+
110
+
let test_unix_epoch () =
111
+
let ts = Meross.Protocol.unix_epoch_seconds () in
112
+
(* Should be a reasonable timestamp (after 2020) *)
113
+
Alcotest.(check bool) "reasonable timestamp" true (ts > 1577836800)
114
+
115
+
let test_parse_ack_valid () =
116
+
let header : Meross.Protocol.header =
117
+
{
118
+
from_ = "";
119
+
message_id = "test";
120
+
method_ = "SETACK";
121
+
namespace = "test";
122
+
payload_version = 1;
123
+
sign = "test";
124
+
timestamp = 0;
125
+
}
126
+
in
127
+
let resp =
128
+
Printf.sprintf {|{"header":%s,"payload":{}}|}
129
+
(Meross.Protocol.encode Meross.Protocol.header_codec header)
130
+
in
131
+
match Meross.Protocol.parse_ack resp with
132
+
| Ok () -> ()
133
+
| Error (`Msg e) -> Alcotest.fail e
134
+
135
+
let test_parse_ack_not_ack () =
136
+
let header : Meross.Protocol.header =
137
+
{
138
+
from_ = "";
139
+
message_id = "test";
140
+
method_ = "GET";
141
+
namespace = "test";
142
+
payload_version = 1;
143
+
sign = "test";
144
+
timestamp = 0;
145
+
}
146
+
in
147
+
let resp =
148
+
Printf.sprintf {|{"header":%s,"payload":{}}|}
149
+
(Meross.Protocol.encode Meross.Protocol.header_codec header)
150
+
in
151
+
match Meross.Protocol.parse_ack resp with
152
+
| Ok () -> Alcotest.fail "should not be ack"
153
+
| Error (`Msg _) -> ()
154
+
155
+
(* {1 Electricity Tests} *)
156
+
157
+
let test_electricity_type () =
158
+
let e : Meross.Electricity.t =
159
+
{ power = 100.0; voltage = 220.0; current = 0.5 }
160
+
in
161
+
Alcotest.(check (float 0.01)) "power" 100.0 e.power;
162
+
Alcotest.(check (float 0.01)) "voltage" 220.0 e.voltage;
163
+
Alcotest.(check (float 0.001)) "current" 0.5 e.current
164
+
165
+
let test_electricity_pp () =
166
+
let e : Meross.Electricity.t =
167
+
{ power = 100.0; voltage = 220.0; current = 0.5 }
168
+
in
169
+
let s = Fmt.str "%a" Meross.Electricity.pp e in
170
+
Alcotest.(check bool) "contains power" true (is_substring s ~substring:"100");
171
+
Alcotest.(check bool)
172
+
"contains voltage" true
173
+
(is_substring s ~substring:"220")
174
+
175
+
(* {1 Consumption Tests} *)
176
+
177
+
let test_consumption_type () =
178
+
let entry : Meross.Consumption.entry =
179
+
{ date = "2025-01-20"; value = 1234.5 }
180
+
in
181
+
Alcotest.(check string) "date" "2025-01-20" entry.date;
182
+
Alcotest.(check (float 0.01)) "value" 1234.5 entry.value
183
+
184
+
let test_consumption_pp () =
185
+
let entry : Meross.Consumption.entry =
186
+
{ date = "2025-01-20"; value = 1234.5 }
187
+
in
188
+
let s = Fmt.str "%a" Meross.Consumption.pp_entry entry in
189
+
Alcotest.(check bool)
190
+
"contains date" true
191
+
(is_substring s ~substring:"2025-01-20");
192
+
Alcotest.(check bool) "contains value" true (is_substring s ~substring:"1234")
193
+
194
+
(* {1 Timers Tests} *)
195
+
196
+
let test_timers_countdown_type () =
197
+
let c : Meross.Timers.countdown =
198
+
{ onoff = 0; end_time = 1234567890; duration = 300 }
199
+
in
200
+
Alcotest.(check int) "onoff" 0 c.onoff;
201
+
Alcotest.(check int) "end_time" 1234567890 c.end_time;
202
+
Alcotest.(check int) "duration" 300 c.duration
203
+
204
+
let test_timers_type () =
205
+
let t : Meross.Timers.t =
206
+
{
207
+
channel = 0;
208
+
timer_type = 1;
209
+
down = Some { onoff = 0; end_time = 1234567890; duration = 300 };
210
+
}
211
+
in
212
+
Alcotest.(check int) "channel" 0 t.channel;
213
+
Alcotest.(check int) "timer_type" 1 t.timer_type;
214
+
Alcotest.(check bool) "has down" true (Option.is_some t.down)
215
+
216
+
let test_timers_countdown_codec_roundtrip () =
217
+
let c : Meross.Timers.countdown =
218
+
{ onoff = 1; end_time = 1234567890; duration = 600 }
219
+
in
220
+
let encoded = Meross.Protocol.encode Meross.Timers.countdown_codec c in
221
+
match Meross.Protocol.decode Meross.Timers.countdown_codec encoded with
222
+
| Ok decoded ->
223
+
Alcotest.(check int) "onoff" c.onoff decoded.onoff;
224
+
Alcotest.(check int) "end_time" c.end_time decoded.end_time;
225
+
Alcotest.(check int) "duration" c.duration decoded.duration
226
+
| Error e -> Alcotest.fail (Printf.sprintf "decode failed: %s" e)
227
+
228
+
let test_timers_timer_codec_roundtrip () =
229
+
let t : Meross.Timers.t =
230
+
{
231
+
channel = 0;
232
+
timer_type = 1;
233
+
down = Some { onoff = 0; end_time = 1234567890; duration = 300 };
234
+
}
235
+
in
236
+
let encoded = Meross.Protocol.encode Meross.Timers.timer_codec t in
237
+
match Meross.Protocol.decode Meross.Timers.timer_codec encoded with
238
+
| Ok decoded -> (
239
+
Alcotest.(check int) "channel" t.channel decoded.channel;
240
+
Alcotest.(check int) "timer_type" t.timer_type decoded.timer_type;
241
+
Alcotest.(check bool) "has down" true (Option.is_some decoded.down);
242
+
match (t.down, decoded.down) with
243
+
| Some c1, Some c2 ->
244
+
Alcotest.(check int) "down.onoff" c1.onoff c2.onoff;
245
+
Alcotest.(check int) "down.duration" c1.duration c2.duration
246
+
| _ -> Alcotest.fail "down mismatch")
247
+
| Error e -> Alcotest.fail (Printf.sprintf "decode failed: %s" e)
248
+
249
+
let test_timers_payload_codec_roundtrip () =
250
+
let p : Meross.Timers.payload =
251
+
{
252
+
timerx =
253
+
[
254
+
{
255
+
channel = 0;
256
+
timer_type = 1;
257
+
down = Some { onoff = 0; end_time = 1234567890; duration = 300 };
258
+
};
259
+
{ channel = 1; timer_type = 1; down = None };
260
+
];
261
+
}
262
+
in
263
+
let encoded = Meross.Protocol.encode Meross.Timers.payload_codec p in
264
+
match Meross.Protocol.decode Meross.Timers.payload_codec encoded with
265
+
| Ok decoded ->
266
+
Alcotest.(check int) "timerx count" 2 (List.length decoded.timerx)
267
+
| Error e -> Alcotest.fail (Printf.sprintf "decode failed: %s" e)
268
+
269
+
let test_timers_format_duration () =
270
+
Alcotest.(check string) "seconds" "30s" (Meross.Timers.format_duration 30);
271
+
Alcotest.(check string) "minutes" "5m30s" (Meross.Timers.format_duration 330);
272
+
Alcotest.(check string) "hours" "1h30m" (Meross.Timers.format_duration 5400)
273
+
274
+
(* {1 Triggers Tests} *)
275
+
276
+
let test_triggers_rule_type () =
277
+
let r : Meross.Triggers.rule = { week = 127; duration = 300 } in
278
+
Alcotest.(check int) "week" 127 r.week;
279
+
Alcotest.(check int) "duration" 300 r.duration
280
+
281
+
let test_triggers_type () =
282
+
let t : Meross.Triggers.t =
283
+
{
284
+
id = "abc123";
285
+
trigger_type = 2;
286
+
enabled = true;
287
+
channel = 0;
288
+
alias = "test";
289
+
create_time = 1234567890;
290
+
rule = { week = 128; duration = 300 };
291
+
}
292
+
in
293
+
Alcotest.(check string) "id" "abc123" t.id;
294
+
Alcotest.(check int) "trigger_type" 2 t.trigger_type;
295
+
Alcotest.(check bool) "enabled" true t.enabled
296
+
297
+
let test_triggers_make_id () =
298
+
let id1 = Meross.Triggers.make_id () in
299
+
let id2 = Meross.Triggers.make_id () in
300
+
Alcotest.(check int) "id length" 6 (String.length id1);
301
+
Alcotest.(check bool) "ids are different" true (id1 <> id2)
302
+
303
+
let test_triggers_rule_codec_roundtrip () =
304
+
let r : Meross.Triggers.rule = { week = 127; duration = 600 } in
305
+
let encoded = Meross.Protocol.encode Meross.Triggers.rule_codec r in
306
+
match Meross.Protocol.decode Meross.Triggers.rule_codec encoded with
307
+
| Ok decoded ->
308
+
Alcotest.(check int) "week" r.week decoded.week;
309
+
Alcotest.(check int) "duration" r.duration decoded.duration
310
+
| Error e -> Alcotest.fail (Printf.sprintf "decode failed: %s" e)
311
+
312
+
let test_triggers_codec_roundtrip () =
313
+
let t : Meross.Triggers.t =
314
+
{
315
+
id = "abc123";
316
+
trigger_type = 2;
317
+
enabled = true;
318
+
channel = 0;
319
+
alias = "test-trigger";
320
+
create_time = 1234567890;
321
+
rule = { week = 128; duration = 300 };
322
+
}
323
+
in
324
+
let encoded = Meross.Protocol.encode Meross.Triggers.codec t in
325
+
match Meross.Protocol.decode Meross.Triggers.codec encoded with
326
+
| Ok decoded ->
327
+
Alcotest.(check string) "id" t.id decoded.id;
328
+
Alcotest.(check int) "trigger_type" t.trigger_type decoded.trigger_type;
329
+
Alcotest.(check bool) "enabled" t.enabled decoded.enabled;
330
+
Alcotest.(check int) "channel" t.channel decoded.channel;
331
+
Alcotest.(check string) "alias" t.alias decoded.alias;
332
+
Alcotest.(check int) "rule.week" t.rule.week decoded.rule.week;
333
+
Alcotest.(check int) "rule.duration" t.rule.duration decoded.rule.duration
334
+
| Error e -> Alcotest.fail (Printf.sprintf "decode failed: %s" e)
335
+
336
+
let test_triggers_format_duration () =
337
+
Alcotest.(check string) "seconds" "30s" (Meross.Triggers.format_duration 30);
338
+
Alcotest.(check string)
339
+
"minutes" "5m30s"
340
+
(Meross.Triggers.format_duration 330);
341
+
Alcotest.(check string) "hours" "1h30m" (Meross.Triggers.format_duration 5400)
342
+
343
+
(* {1 Abilities Tests} *)
344
+
345
+
let test_abilities_has_electricity () =
346
+
let abilities = [ "Appliance.Control.Electricity"; "Appliance.System.All" ] in
347
+
Alcotest.(check bool)
348
+
"has electricity" true
349
+
(Meross.Abilities.has_electricity abilities);
350
+
Alcotest.(check bool)
351
+
"no electricity" false
352
+
(Meross.Abilities.has_electricity [ "Appliance.System.All" ])
353
+
354
+
let test_abilities_has_consumption () =
355
+
let abilities =
356
+
[ "Appliance.Control.ConsumptionX"; "Appliance.System.All" ]
357
+
in
358
+
Alcotest.(check bool)
359
+
"has consumption" true
360
+
(Meross.Abilities.has_consumption abilities);
361
+
Alcotest.(check bool)
362
+
"no consumption" false
363
+
(Meross.Abilities.has_consumption [ "Appliance.System.All" ])
364
+
365
+
let test_abilities_has_timers () =
366
+
let abilities = [ "Appliance.Control.TimerX"; "Appliance.System.All" ] in
367
+
Alcotest.(check bool)
368
+
"has timers" true
369
+
(Meross.Abilities.has_timers abilities);
370
+
Alcotest.(check bool)
371
+
"no timers" false
372
+
(Meross.Abilities.has_timers [ "Appliance.System.All" ])
373
+
374
+
let test_abilities_has_dnd () =
375
+
let abilities = [ "Appliance.System.DNDMode"; "Appliance.System.All" ] in
376
+
Alcotest.(check bool) "has dnd" true (Meross.Abilities.has_dnd abilities);
377
+
Alcotest.(check bool)
378
+
"no dnd" false
379
+
(Meross.Abilities.has_dnd [ "Appliance.System.All" ])
380
+
381
+
let test_abilities_has_runtime () =
382
+
let abilities = [ "Appliance.System.Runtime"; "Appliance.System.All" ] in
383
+
Alcotest.(check bool)
384
+
"has runtime" true
385
+
(Meross.Abilities.has_runtime abilities);
386
+
Alcotest.(check bool)
387
+
"no runtime" false
388
+
(Meross.Abilities.has_runtime [ "Appliance.System.All" ])
389
+
390
+
let test_abilities_has_matter () =
391
+
let abilities_with = [ "Appliance.Config.Matter"; "Appliance.System.All" ] in
392
+
let abilities_bind = [ "Appliance.Control.Bind"; "Appliance.System.All" ] in
393
+
let abilities_without =
394
+
[ "Appliance.System.All"; "Appliance.Control.Toggle" ]
395
+
in
396
+
Alcotest.(check bool)
397
+
"has matter" true
398
+
(Meross.Abilities.has_matter abilities_with);
399
+
Alcotest.(check bool)
400
+
"has bind" true
401
+
(Meross.Abilities.has_matter abilities_bind);
402
+
Alcotest.(check bool)
403
+
"no matter" false
404
+
(Meross.Abilities.has_matter abilities_without)
405
+
406
+
(* {1 Runtime Tests} *)
407
+
408
+
let test_runtime_type () =
409
+
let r : Meross.Runtime.t = { signal = 75 } in
410
+
Alcotest.(check int) "signal" 75 r.signal
411
+
412
+
let test_runtime_codec_roundtrip () =
413
+
let r : Meross.Runtime.t = { signal = 85 } in
414
+
let encoded = Meross.Protocol.encode Meross.Runtime.codec r in
415
+
match Meross.Protocol.decode Meross.Runtime.codec encoded with
416
+
| Ok decoded -> Alcotest.(check int) "signal" r.signal decoded.signal
417
+
| Error e -> Alcotest.fail (Printf.sprintf "decode failed: %s" e)
418
+
419
+
let test_runtime_payload_codec_roundtrip () =
420
+
let p : Meross.Runtime.payload = { runtime = { signal = 90 } } in
421
+
let encoded = Meross.Protocol.encode Meross.Runtime.payload_codec p in
422
+
match Meross.Protocol.decode Meross.Runtime.payload_codec encoded with
423
+
| Ok decoded ->
424
+
Alcotest.(check int) "signal" p.runtime.signal decoded.runtime.signal
425
+
| Error e -> Alcotest.fail (Printf.sprintf "decode failed: %s" e)
426
+
427
+
(* {1 DND Tests} *)
428
+
429
+
let test_dnd_type () =
430
+
let d : Meross.Dnd.t = { enabled = true } in
431
+
Alcotest.(check bool) "enabled" true d.enabled
432
+
433
+
let test_dnd_codec_roundtrip () =
434
+
let d : Meross.Dnd.t = { enabled = true } in
435
+
let encoded = Meross.Protocol.encode Meross.Dnd.codec d in
436
+
match Meross.Protocol.decode Meross.Dnd.codec encoded with
437
+
| Ok decoded -> Alcotest.(check bool) "enabled" d.enabled decoded.enabled
438
+
| Error e -> Alcotest.fail (Printf.sprintf "decode failed: %s" e)
439
+
440
+
let test_dnd_codec_disabled () =
441
+
let d : Meross.Dnd.t = { enabled = false } in
442
+
let encoded = Meross.Protocol.encode Meross.Dnd.codec d in
443
+
match Meross.Protocol.decode Meross.Dnd.codec encoded with
444
+
| Ok decoded -> Alcotest.(check bool) "disabled" false decoded.enabled
445
+
| Error e -> Alcotest.fail (Printf.sprintf "decode failed: %s" e)
446
+
447
+
let test_dnd_payload_codec_roundtrip () =
448
+
let p : Meross.Dnd.payload = { dnd_mode = { enabled = true } } in
449
+
let encoded = Meross.Protocol.encode Meross.Dnd.payload_codec p in
450
+
match Meross.Protocol.decode Meross.Dnd.payload_codec encoded with
451
+
| Ok decoded ->
452
+
Alcotest.(check bool)
453
+
"enabled" p.dnd_mode.enabled decoded.dnd_mode.enabled
454
+
| Error e -> Alcotest.fail (Printf.sprintf "decode failed: %s" e)
455
+
456
+
(* {1 Device Tests} *)
457
+
458
+
let test_device_info_type () =
459
+
let info : Meross.Device.info =
460
+
{
461
+
device_type = "mss315";
462
+
mac = "AA:BB:CC:DD:EE:FF";
463
+
uuid = "test-uuid";
464
+
ip = "192.168.1.100";
465
+
firmware = "1.0.0";
466
+
is_on = true;
467
+
}
468
+
in
469
+
Alcotest.(check string) "device_type" "mss315" info.device_type;
470
+
Alcotest.(check string) "mac" "AA:BB:CC:DD:EE:FF" info.mac;
471
+
Alcotest.(check bool) "is_on" true info.is_on
472
+
473
+
let test_device_pp () =
474
+
let info : Meross.Device.info =
475
+
{
476
+
device_type = "mss315";
477
+
mac = "AA:BB:CC:DD:EE:FF";
478
+
uuid = "test-uuid";
479
+
ip = "192.168.1.100";
480
+
firmware = "1.0.0";
481
+
is_on = true;
482
+
}
483
+
in
484
+
let s = Fmt.str "%a" Meross.Device.pp info in
485
+
Alcotest.(check bool)
486
+
"contains type" true
487
+
(is_substring s ~substring:"mss315");
488
+
Alcotest.(check bool)
489
+
"contains ip" true
490
+
(is_substring s ~substring:"192.168.1.100");
491
+
Alcotest.(check bool) "contains ON" true (is_substring s ~substring:"ON")
492
+
493
+
let test_device_pp_short () =
494
+
let info : Meross.Device.info =
495
+
{
496
+
device_type = "mss315";
497
+
mac = "AA:BB:CC:DD:EE:FF";
498
+
uuid = "test-uuid";
499
+
ip = "192.168.1.100";
500
+
firmware = "1.0.0";
501
+
is_on = false;
502
+
}
503
+
in
504
+
let s = Fmt.str "%a" Meross.Device.pp_short info in
505
+
Alcotest.(check bool)
506
+
"contains ip" true
507
+
(is_substring s ~substring:"192.168.1.100");
508
+
Alcotest.(check bool) "contains OFF" true (is_substring s ~substring:"OFF")
509
+
510
+
(* {1 Test Suite} *)
511
+
512
+
let suite =
513
+
[
514
+
( "protocol",
515
+
[
516
+
Alcotest.test_case "header_codec" `Quick test_header_codec;
517
+
Alcotest.test_case "header_roundtrip" `Quick test_header_roundtrip;
518
+
Alcotest.test_case "make_header" `Quick test_make_header;
519
+
Alcotest.test_case "make_request_empty" `Quick test_make_request_empty;
520
+
Alcotest.test_case "make_request_enable" `Quick test_make_request_enable;
521
+
Alcotest.test_case "is_ack" `Quick test_is_ack;
522
+
Alcotest.test_case "unix_epoch" `Quick test_unix_epoch;
523
+
Alcotest.test_case "parse_ack_valid" `Quick test_parse_ack_valid;
524
+
Alcotest.test_case "parse_ack_not_ack" `Quick test_parse_ack_not_ack;
525
+
] );
526
+
( "electricity",
527
+
[
528
+
Alcotest.test_case "type" `Quick test_electricity_type;
529
+
Alcotest.test_case "pp" `Quick test_electricity_pp;
530
+
] );
531
+
( "consumption",
532
+
[
533
+
Alcotest.test_case "type" `Quick test_consumption_type;
534
+
Alcotest.test_case "pp" `Quick test_consumption_pp;
535
+
] );
536
+
( "timers",
537
+
[
538
+
Alcotest.test_case "countdown_type" `Quick test_timers_countdown_type;
539
+
Alcotest.test_case "type" `Quick test_timers_type;
540
+
Alcotest.test_case "countdown_codec_roundtrip" `Quick
541
+
test_timers_countdown_codec_roundtrip;
542
+
Alcotest.test_case "timer_codec_roundtrip" `Quick
543
+
test_timers_timer_codec_roundtrip;
544
+
Alcotest.test_case "payload_codec_roundtrip" `Quick
545
+
test_timers_payload_codec_roundtrip;
546
+
Alcotest.test_case "format_duration" `Quick test_timers_format_duration;
547
+
] );
548
+
( "triggers",
549
+
[
550
+
Alcotest.test_case "rule_type" `Quick test_triggers_rule_type;
551
+
Alcotest.test_case "type" `Quick test_triggers_type;
552
+
Alcotest.test_case "make_id" `Quick test_triggers_make_id;
553
+
Alcotest.test_case "rule_codec_roundtrip" `Quick
554
+
test_triggers_rule_codec_roundtrip;
555
+
Alcotest.test_case "codec_roundtrip" `Quick
556
+
test_triggers_codec_roundtrip;
557
+
Alcotest.test_case "format_duration" `Quick
558
+
test_triggers_format_duration;
559
+
] );
560
+
( "abilities",
561
+
[
562
+
Alcotest.test_case "has_electricity" `Quick
563
+
test_abilities_has_electricity;
564
+
Alcotest.test_case "has_consumption" `Quick
565
+
test_abilities_has_consumption;
566
+
Alcotest.test_case "has_timers" `Quick test_abilities_has_timers;
567
+
Alcotest.test_case "has_dnd" `Quick test_abilities_has_dnd;
568
+
Alcotest.test_case "has_runtime" `Quick test_abilities_has_runtime;
569
+
Alcotest.test_case "has_matter" `Quick test_abilities_has_matter;
570
+
] );
571
+
( "runtime",
572
+
[
573
+
Alcotest.test_case "type" `Quick test_runtime_type;
574
+
Alcotest.test_case "codec_roundtrip" `Quick test_runtime_codec_roundtrip;
575
+
Alcotest.test_case "payload_codec_roundtrip" `Quick
576
+
test_runtime_payload_codec_roundtrip;
577
+
] );
578
+
( "dnd",
579
+
[
580
+
Alcotest.test_case "type" `Quick test_dnd_type;
581
+
Alcotest.test_case "codec_roundtrip" `Quick test_dnd_codec_roundtrip;
582
+
Alcotest.test_case "codec_disabled" `Quick test_dnd_codec_disabled;
583
+
Alcotest.test_case "payload_codec_roundtrip" `Quick
584
+
test_dnd_payload_codec_roundtrip;
585
+
] );
586
+
( "device",
587
+
[
588
+
Alcotest.test_case "info_type" `Quick test_device_info_type;
589
+
Alcotest.test_case "pp" `Quick test_device_pp;
590
+
Alcotest.test_case "pp_short" `Quick test_device_pp_short;
591
+
] );
592
+
]