feat: ✨ support finite gen using just lists

bin/addressBook.ml

@@ -54,3 +54,9 @@ let gen_of_prefix pre =
   Int32.add a i
   |> Ip.of_int32
   |> return
+
+let seq_of_prefix pre =
+  let (f, l) = Pre.first pre, Pre.last pre in
+  let a, b = Ip.to_int32 f, Ip.to_int32 l in
+  Seq.range32 a b
+  |> Seq.map Ip.of_int32

bin/main.ml

@@ -15,7 +15,7 @@ let () =
   Log.debug "book is:\n  %s" (AddressBook.dump book);
   Log.debug "rules is:\n  %s" (List.map Rule.dump rules |> String.concat "\n  ");
   let scenarios =
-    List.map (fun rule -> Scenario.gen book rule) rules
+    List.map (fun rule -> Scenario.seq book rule) rules
     |> List.map (fun seq -> Seq.take 10 seq |> List.of_seq)
     |> List.concat
   in

bin/scenario.ml

@@ -54,6 +54,39 @@ let gen book rule =
   |> Seq.mapi (fun idx (src_ip, dst_ip, url_domain) ->
          {src_ip; dst_ip; url_domain; description=(desc idx)})
 
+let seq_addr addr =
+  match addr with
+  | AddressBook.SingleHost host -> `IP [host]
+  | INet pre ->
+     let rand = Random.State.make_self_init () in
+     `IP (AddressBook.seq_of_prefix pre |> List.of_seq |> list_shuffle rand)
+  | FQDN url -> `FQDN url
+  | Group _ -> failwith "Scenario.seq_addr: unexpected Group"
+
+let seq_aux book rule =
+  let open ListMonad in
+  Rule.sources book rule >>= fun src_addr ->
+  match seq_addr src_addr with
+  | `FQDN url -> failwith (!%"seq_aux fqdn in source: %s" url)
+  | `IP addrs ->
+     addrs >>= fun src ->
+     let src_ip = Ip.to_string src in
+     Rule.destinations book rule >>= fun dst_addr ->
+     begin match seq_addr dst_addr with
+         | `FQDN url -> [(src_ip, "", url)]
+         | `IP addrs ->
+            addrs >>= fun dst ->
+            return (src_ip, Ip.to_string dst, "")
+     end
+
+
+let seq book rule =
+  let desc idx = !%"%s-%04d" rule.Rule.name (idx+1) in
+  seq_aux book rule
+  |> List.to_seq
+  |> Seq.mapi (fun idx (src_ip, dst_ip, url_domain) ->
+         {src_ip; dst_ip; url_domain; description=(desc idx)})
+
 let to_csv ss =
   let header = [|
     "protocol"; "src-ip"; "src-port(option)"; "src-nat-ip(option)"; "is-receiver-physical(option)";

lib/common.ml

@@ -2,6 +2,26 @@ let (!%) s = Printf.sprintf s
 
 let seq_unit x = List.to_seq [x]
 
+let list_split_at i xs =
+  let rec iter store = function
+    | (0, xs) -> (List.rev store, xs)
+    | (_, []) -> (List.rev store, [])
+    | (n, x :: xs) -> iter (x :: store) (n - 1, xs)
+  in
+  match iter [] (i, xs) with
+  | (_, []) -> None
+  | (xs, y :: ys) -> Some (y, xs @ ys)
+
+let rec list_shuffle rand xs =
+  let module R = Random.State in
+  match xs with
+  | [] -> []
+  | _ :: _ ->
+     let i = R.int rand (List.length xs) in
+     match list_split_at i xs with
+     | Some(x, xs) -> x :: list_shuffle rand xs
+     | None -> []
+
 module SeqMonad = struct
   type 'a t = 'a Seq.t
 
@@ -39,4 +59,17 @@ module Seq = struct
     if n < 0 then invalid_arg "Seq.take";
     take_aux n xs
 
+  let range a b = take (b - a + 1) (ints a)
+  let (--) a b = range a b
+
+  let rec ints32 i32 = fun () -> Cons (i32, ints32 (Int32.succ i32))
+  let range32 a b =
+    let n = Int32.(to_int (succ (sub b a))) in
+    take n (ints32 a)
+end
+
+module ListMonad = struct
+  include List
+  let return x = [x]
+  let (>>=) m f = concat_map f m
 end