Create modules in config.ml

config.ml

@@ -1,88 +1,102 @@
 open Ipaddr
+open Utils
 
-type zone =
-  | ZoneIpv4 of V4.Prefix.t
-  | ZoneIpv6 of V6.Prefix.t
-  | Zone of string
-  | ZoneList of zone list
-  | ZoneExclude of zone
-
-type addrs = ZoneName of string | Ipv4 of V4.Prefix.t | Ipv6 of V6.Prefix.t
-
-type l4_rule =
-  | TcpRule of { sport : int list; dport : int list }
-  | UdpRule of { sport : int list; dport : int list }
-  | IcmpRule
-
-type rule = { src : addrs list; dest : addrs list; l4 : l4_rule }
-type config = { zones : (string * zone) list; rules : rule list }
-
-let rec zone_of_json json =
-  match json with
-  | `String s -> (
-      let zone = Zone s in
-      let zone =
-        match V6.Prefix.of_string s with Ok p -> ZoneIpv6 p | Error _ -> zone
-      in
-      match V4.Prefix.of_string s with Ok p -> ZoneIpv4 p | Error _ -> zone)
-  | `Assoc [ ("exclude", e) ] -> ZoneExclude (zone_of_json e)
-  | `List l -> ZoneList (List.map zone_of_json l)
-  | _ -> assert false
-
-let addrs_of_json json =
-  let open Yojson.Basic.Util in
-  let value = json |> to_string in
-  let addrs = ZoneName value in
-  let addrs =
-    match V6.Prefix.of_string value with Ok p -> Ipv6 p | Error _ -> addrs
-  in
-  match V4.Prefix.of_string value with Ok p -> Ipv4 p | Error _ -> addrs
-
-let addrs_list_of_json json =
-  let open Yojson.Basic.Util in
-  let elems = json |> to_list in
-  List.map addrs_of_json elems
+module Zone = struct
+  type t =
+    | Ipv4 of V4.Prefix.t
+    | Ipv6 of V6.Prefix.t
+    | Name of string
+    | List of t list
+    | Not of t
+
+  let name str = Name str
+  let ipv4 prefix = Ipv4 prefix
+  let ipv6 prefix = Ipv6 prefix
+
+  let rec of_json = function
+    | `String str ->
+        str |> V6.Prefix.of_string |> Result.map ipv6
+        &?> (str |> V4.Prefix.of_string |> Result.map ipv4)
+        &> (str |> name)
+    | `Assoc [ ("not", json) ] -> Not (of_json json)
+    | `List list -> List (List.map of_json list)
+    | _ -> assert false
+end
 
-let to_list_force = function `List l -> l | _ -> []
+module Addrs = struct
+  type t = Name of string | Ipv4 of V4.Prefix.t | Ipv6 of V6.Prefix.t
+
+  let name str = Name str
+  let ipv4 prefix = Ipv4 prefix
+  let ipv6 prefix = Ipv6 prefix
+
+  let of_json json =
+    let open Yojson.Basic.Util in
+    let str = json |> to_string in
+    str |> V6.Prefix.of_string |> Result.map ipv6
+    &?> (str |> V4.Prefix.of_string |> Result.map ipv4)
+    &> (str |> name)
+end
 
 let to_int_list json =
   let open Yojson.Basic.Util in
-  json |> to_list_force |> List.map to_int
+  json |> to_list |> List.map to_int
 
-let tcp_rule_of_json json =
-  let open Yojson.Basic.Util in
-  let sport = json |> member "sport" |> to_int_list in
-  let dport = json |> member "dport" |> to_int_list in
-  TcpRule { sport; dport }
+module PayloadRule = struct
+  module Tcp = struct
+    type t = { sport : int list; dport : int list }
 
-let udp_rule_of_json json =
-  let open Yojson.Basic.Util in
-  let sport = json |> member "sport" |> to_int_list in
-  let dport = json |> member "dport" |> to_int_list in
-  UdpRule { sport; dport }
+    let of_json json =
+      let open Yojson.Basic.Util in
+      let sport = json |> member "sport" |> to_int_list in
+      let dport = json |> member "dport" |> to_int_list in
+      { sport; dport }
+  end
 
-let l4_rule_of_json json =
-  let open Yojson.Basic.Util in
-  let proto = json |> member "proto" |> to_string in
-  match proto with
-  | "tcp" -> tcp_rule_of_json json
-  | "udp" -> udp_rule_of_json json
-  | "icmp" -> IcmpRule
-  | _ -> assert false
-
-let rule_of_json json =
+  module Udp = struct
+    type t = { sport : int list; dport : int list }
+
+    let of_json json =
+      let open Yojson.Basic.Util in
+      let sport = json |> member "sport" |> to_int_list in
+      let dport = json |> member "dport" |> to_int_list in
+      { sport; dport }
+  end
+
+  type t = Tcp of Tcp.t | Udp of Udp.t | Icmp
+
+  let of_json json =
+    let open Yojson.Basic.Util in
+    match json |> member "proto" |> to_string with
+    | "tcp" -> Tcp (Tcp.of_json json)
+    | "udp" -> Udp (Udp.of_json json)
+    | "icmp" -> Icmp
+    | _ -> assert false
+end
+
+let to_addr_list json =
   let open Yojson.Basic.Util in
-  let src = addrs_list_of_json (json |> member "src") in
-  let dest = addrs_list_of_json (json |> member "dest") in
-  let l4 = l4_rule_of_json json in
-  { src; dest; l4 }
+  json |> to_list |> List.map Addrs.of_json
+
+module Rule = struct
+  type t = { src : Addrs.t list; dest : Addrs.t list; payload : PayloadRule.t }
+
+  let of_json json =
+    let open Yojson.Basic.Util in
+    let src = json |> member "src" |> to_addr_list in
+    let dest = json |> member "dest" |> to_addr_list in
+    let payload = PayloadRule.of_json json in
+    { src; dest; payload }
+end
+
+type t = { zones : (string * Zone.t) list; rules : Rule.t list }
 
 let zones_of_json json =
   let open Yojson.Basic.Util in
-  json |> to_assoc |> List.map (fun (n, z) -> (n, zone_of_json z))
+  json |> to_assoc |> List.map (fun (n, z) -> (n, Zone.of_json z))
 
-let config_of_json json =
+let of_json json =
   let open Yojson.Basic.Util in
   let zones = json |> member "zones" |> zones_of_json in
-  let rules = json |> member "rules" |> to_list |> List.map rule_of_json in
+  let rules = json |> member "rules" |> to_list |> List.map Rule.of_json in
   { zones; rules }