open Ipaddr open Utils 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 |> V6.of_string |> Result.map V6.Prefix.of_addr |> Result.map ipv6) &?> (str |> V4.Prefix.of_string |> Result.map ipv4) &?> (str |> V4.of_string |> Result.map V4.Prefix.of_addr |> Result.map ipv4) &> (str |> name) | `Assoc [ ("not", json) ] -> Not (of_json json) | `List list -> List (List.map of_json list) | _ -> failwith "invalid zone definition" end 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 |> V6.of_string |> Result.map V6.Prefix.of_addr |> Result.map ipv6) &?> (str |> V4.Prefix.of_string |> Result.map ipv4) &?> (str |> V4.of_string |> Result.map V4.Prefix.of_addr |> Result.map ipv4) &> (str |> name) end let to_list_loose = function `List list -> list | _ -> [] let to_int_list json = let open Yojson.Basic.Util in json |> to_list_loose |> List.map to_int module PayloadRule = struct module Tcp = 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 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 | proto -> failwith ("invalid protocol " ^ proto) end let to_addr_list json = json |> to_list_loose |> 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)) 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_loose |> List.map Rule.of_json in { zones; rules }