Merge pull request #114 from hannesm/next

remove rresult dependency, use Result instead

charrua.opam

@@ -25,7 +25,6 @@ depends: [
   "macaddr-sexp"
   "ethernet"      {>= "2.2.0"}
   "tcpip"         {>= "5.0.0"}
-  "rresult"
 ]
 synopsis: "DHCP wire frame encoder and decoder"
 description: """

lib/dhcp_wire.ml

@@ -18,6 +18,8 @@
 open Sexplib.Conv
 open Sexplib.Std
 
+let ( let* ) = Result.bind
+
 let guard p e = if p then Result.Ok () else Result.Error e
 
 let some_or_invalid f v = match f v with
@@ -1078,31 +1080,34 @@ let buf_of_options sbuf options =
     set_uint8 ebuf 0 (option_code_to_int END); shift ebuf 1
 
 let pkt_of_buf buf len =
-  let open Rresult in
   let open Printf in
   let wrap () =
     let min_len = sizeof_dhcp + Ethernet_wire.sizeof_ethernet +
                   Ipv4_wire.sizeof_ipv4 + Udp_wire.sizeof_udp
     in
-    guard (len >= min_len) (sprintf "packet is too small: %d < %d" len min_len)
-    >>= fun () ->
+    let* () =
+      guard (len >= min_len) (sprintf "packet is too small: %d < %d" len min_len)
+    in
     (* Handle ethernet *)
-    Ethernet_packet.Unmarshal.of_cstruct buf >>= fun (eth_header, eth_payload) ->
+    let* eth_header, eth_payload = Ethernet_packet.Unmarshal.of_cstruct buf in
     match eth_header.Ethernet_packet.ethertype with
     | `ARP | `IPv6 -> Error "packet is not ipv4"
     | `IPv4 ->
-      Ipv4_packet.Unmarshal.of_cstruct eth_payload
-      >>= fun (ipv4_header, ipv4_payload) ->
+      let* ipv4_header, ipv4_payload =
+        Ipv4_packet.Unmarshal.of_cstruct eth_payload
+      in
       match Ipv4_packet.Unmarshal.int_to_protocol ipv4_header.Ipv4_packet.proto with
       | Some `ICMP | Some `TCP | None -> Error "packet is not udp"
       | Some `UDP ->
-        guard
-          (Ipv4_packet.Unmarshal.verify_transport_checksum
-             ~proto:`UDP ~ipv4_header ~transport_packet:ipv4_payload)
-          "bad udp checksum"
-        >>= fun () ->
-        Udp_packet.Unmarshal.of_cstruct ipv4_payload >>=
-        fun (udp_header, udp_payload) ->
+        let* () =
+          guard
+            (Ipv4_packet.Unmarshal.verify_transport_checksum
+               ~proto:`UDP ~ipv4_header ~transport_packet:ipv4_payload)
+            "bad udp checksum"
+        in
+        let* udp_header, udp_payload =
+          Udp_packet.Unmarshal.of_cstruct ipv4_payload
+        in
         let op = int_to_op_exn (get_dhcp_op udp_payload) in
         let htype = if (get_dhcp_htype udp_payload) = 1 then
             Ethernet_10mb
@@ -1126,7 +1131,7 @@ let pkt_of_buf buf len =
           else
             Error "Not a mac address."
         in
-        check_chaddr >>= fun chaddr ->
+        let* chaddr = check_chaddr in
         let sname = cstruct_copy_normalized copy_dhcp_sname udp_payload in
         let file = cstruct_copy_normalized copy_dhcp_file udp_payload in
         let options = options_of_buf udp_payload len in
@@ -1219,20 +1224,22 @@ let buf_of_pkt pkg =
   Cstruct.sub dhcp 0 l
 
 let is_dhcp buf _len =
-  let open Rresult in
   let aux buf =
-    Ethernet_packet.Unmarshal.of_cstruct buf >>= fun (eth_header, eth_payload) ->
+    let* eth_header, eth_payload = Ethernet_packet.Unmarshal.of_cstruct buf in
     match eth_header.Ethernet_packet.ethertype with
     | `ARP | `IPv6 -> Ok false
     | `IPv4 ->
-      Ipv4_packet.Unmarshal.of_cstruct eth_payload >>= fun (ipv4_header, ipv4_payload) ->
+      let* ipv4_header, ipv4_payload =
+        Ipv4_packet.Unmarshal.of_cstruct eth_payload
+      in
       (* TODO: tcpip doesn't currently do checksum checking, so we lose some
          functionality by making this change *)
       match Ipv4_packet.Unmarshal.int_to_protocol ipv4_header.Ipv4_packet.proto with
       | Some `ICMP | Some `TCP | None -> Ok false
       | Some `UDP ->
-        Udp_packet.Unmarshal.of_cstruct ipv4_payload >>=
-        fun (udp_header, _udp_payload) ->
+        let* udp_header, _udp_payload =
+          Udp_packet.Unmarshal.of_cstruct ipv4_payload
+        in
         Ok ((udp_header.Udp_packet.dst_port = server_port ||
              udp_header.Udp_packet.dst_port = client_port)
             &&

lib/dune

@@ -1,6 +1,6 @@
 (library
  (name dhcp_wire)
  (public_name charrua)
- (preprocess (pps ppx_sexp_conv ppx_cstruct -- -no-check))
+ (preprocess (pps ppx_sexp_conv ppx_cstruct))
  (libraries cstruct ethernet sexplib tcpip.ipv4 tcpip.udp ipaddr ipaddr-sexp
-            macaddr macaddr-sexp rresult))
+            macaddr macaddr-sexp))

test/client/test_client.ml

@@ -54,7 +54,7 @@ let client_to_selecting () =
   let buf = Dhcp_wire.buf_of_pkt pkt in
   let answer = Dhcp_wire.pkt_of_buf buf (Cstruct.length buf) in
   Alcotest.(check (result pass reject)) "input succeeds" answer answer;
-  (s, Rresult.R.get_ok answer)
+  (s, Result.get_ok answer)
 
 let assert_reply p =
   let open Dhcp_server.Input in
@@ -99,7 +99,7 @@ let client_asks_dhcprequest () =
     | `Response (_s, pkt) ->
       let buf = Dhcp_wire.buf_of_pkt pkt in
       parseable buf;
-      let dhcprequest = Rresult.R.get_ok @@
+      let dhcprequest = Result.get_ok @@
         Dhcp_wire.pkt_of_buf buf (Cstruct.length buf) in
       Alcotest.(check (option msgtype)) "responded to DHCPOFFER with DHCPREQUEST"
         (Some DHCPREQUEST) (find_message_type dhcprequest.options)
@@ -116,7 +116,7 @@ let server_gives_dhcpack () =
   | `New_lease _-> Alcotest.fail "thought a DHCPOFFER was a lease"
   | `Response (_s, pkt) ->
     let buf = Dhcp_wire.buf_of_pkt pkt in
-    let dhcprequest = Rresult.R.get_ok @@ Dhcp_wire.pkt_of_buf buf (Cstruct.length buf) in
+    let dhcprequest = Result.get_ok @@ Dhcp_wire.pkt_of_buf buf (Cstruct.length buf) in
     let (dhcpack, _db) = assert_reply @@ Dhcp_server.Input.input_pkt config db dhcprequest 0l in
       Alcotest.(check (option msgtype)) "got a DHCPACK in response to DHCPREQUEST"
         (Some DHCPACK) (find_message_type dhcpack.options)
@@ -130,7 +130,7 @@ let client_returns_lease () =
   | `Noop | `New_lease _ -> Alcotest.fail "incorrect response to DHCPOFFER"
   | `Response (s, pkt) ->
     let buf = Dhcp_wire.buf_of_pkt pkt in
-    let dhcprequest = Rresult.R.get_ok @@ Dhcp_wire.pkt_of_buf buf (Cstruct.length buf) in
+    let dhcprequest = Result.get_ok @@ Dhcp_wire.pkt_of_buf buf (Cstruct.length buf) in
     let (dhcpack, _db) = assert_reply @@ Dhcp_server.Input.input_pkt config db dhcprequest 0l in
     Alcotest.(check (option msgtype)) "got a DHCPACK in response to DHCPREQUEST"
       (Some DHCPACK) (find_message_type dhcpack.options);
@@ -166,7 +166,7 @@ let random_bound n =
   | `Noop | `New_lease _ -> Alcotest.fail "couldn't enter REQUESTING properly"
   | `Response (s, dhcprequest) ->
     let buf = Dhcp_wire.buf_of_pkt dhcprequest in
-    let dhcprequest = Rresult.R.get_ok @@ Dhcp_wire.pkt_of_buf buf (Cstruct.length buf) in
+    let dhcprequest = Result.get_ok @@ Dhcp_wire.pkt_of_buf buf (Cstruct.length buf) in
     let (dhcpack, _db) = assert_reply @@ Dhcp_server.Input.input_pkt config db dhcprequest 0l in
     match Dhcp_client.input s (Dhcp_wire.buf_of_pkt dhcpack) with
     | `Noop | `Response _ -> Alcotest.fail "client did not recognize DHCPACK as

test/test.ml

@@ -50,7 +50,7 @@ let addr_in_range addr range =
   let addr_32 = Ipaddr.V4.to_int32 addr in
   addr_32 >= low_32 && addr_32 <= high_32
 
-let assert_error x = assert (Rresult.R.is_error x)
+let assert_error x = assert (Result.is_error x)
 
 open Dhcp_wire
 open Dhcp_server