Merge pull request #44 from hannesm/no-cstruct

adapt to mirage-crypto, x509, tls 1.0.0 API changes

bin/sign.ml

@@ -38,9 +38,7 @@ let return x = Lwt_scheduler.inj (Lwt.return x)
 let lwt = { Dkim.Sigs.bind; return }
 
 let priv_of_seed seed =
-  let g =
-    let seed = Cstruct.of_string seed in
-    Mirage_crypto_rng.(create ~seed (module Fortuna)) in
+  let g = Mirage_crypto_rng.(create ~seed (module Fortuna)) in
   Mirage_crypto_pk.Rsa.generate ~g ~bits:2048 ()
 
 module Flow = struct
@@ -174,23 +172,18 @@ let newline =
 let private_key =
   let parser str =
     let ( >>= ) = Result.bind in
-    let ( >>| ) x f = Result.map f x in
-    match
-      Base64.decode ~pad:true str
-      >>| Cstruct.of_string
-      >>= X509.Private_key.decode_der
-    with
+    match Base64.decode ~pad:true str >>= X509.Private_key.decode_der with
     | Ok _ as v -> v
     | Error _ ->
     match Fpath.of_string str with
     | Ok path when Sys.file_exists str && not (Sys.is_directory str) ->
         let contents = contents_of_path path in
-        X509.Private_key.decode_pem (Cstruct.of_string contents)
+        X509.Private_key.decode_pem contents
     | Ok path -> error_msgf "%a does not exist" Fpath.pp path
     | Error _ as err -> err in
   let pp ppf pk =
     let contents = X509.Private_key.encode_pem pk in
-    Fmt.pf ppf "%s%!" (Cstruct.to_string contents) in
+    Fmt.pf ppf "%s%!" contents in
   Arg.conv (parser, pp)
 
 let domain_name =

bin/verify.ml

@@ -218,7 +218,7 @@ let nameserver_of_string str =
           let* ipaddr, port =
             Ipaddr.with_port_of_string ~default:853 nameserver in
           let* authenticator = Ca_certs.authenticator () in
-          let tls = Tls.Config.client ~authenticator () in
+          let* tls = Tls.Config.client ~authenticator () in
           Ok (`Tls (tls, ipaddr, port))
       | nameserver :: authenticator ->
           let* ipaddr, port =
@@ -227,7 +227,7 @@ let nameserver_of_string str =
           let* authenticator = X509.Authenticator.of_string authenticator in
           let time () = Some (Ptime.v (Ptime_clock.now_d_ps ())) in
           let authenticator = authenticator time in
-          let tls = Tls.Config.client ~authenticator () in
+          let* tls = Tls.Config.client ~authenticator () in
           Ok (`Tls (tls, ipaddr, port))
       | [] -> assert false)
   | "tcp" :: nameserver | nameserver ->

dkim-mirage.opam

@@ -28,5 +28,5 @@ depends: [
   "digestif"          {with-test}
   "fmt"               {with-test}
   "logs"              {with-test}
-  "mirage-crypto-rng" {with-test & >= "0.11.0"}
+  "mirage-crypto-rng" {with-test & >= "1.0.0"}
 ]

dkim.opam

@@ -33,9 +33,13 @@ depends: [
   "fmt"               {>= "0.8.7"}
   "fpath"
   "base64"            {>= "3.0.0"}
-  "mirage-crypto"     {>= "0.9.2"}
-  "mirage-crypto-pk"  {>= "0.9.2"}
-  "x509"              {>= "0.12.0"}
-  "mirage-crypto-rng" {with-test & >= "0.11.0"}
+  "mirage-crypto"     {>= "1.0.0"}
+  "mirage-crypto-pk"  {>= "1.0.0"}
+  "x509"              {>= "1.0.0"}
+  "mirage-crypto-rng" {with-test & >= "1.0.0"}
   "alcotest"          {with-test}
 ]
+
+pin-depends: [
+  [ "mrmime.0.7.0" "git+https://github.com/hannesm/mrmime.git#60dc0cd3befab0af6c0418d97c3927fe9ec5650b" ]
+]

lib/dkim.ml

@@ -926,25 +926,22 @@ let verify ({ bind; return } as state) ~epoch fields
       | _, _ -> false in
     let ( >>= ) = bind in
 
-    match
-      (X509.Public_key.decode_der (Cstruct.of_string server.p), fst dkim.a)
-    with
+    match (X509.Public_key.decode_der server.p, fst dkim.a) with
     | Ok (`RSA key), Value.RSA ->
-        let digest =
-          `Digest (Cstruct.of_string (Digestif.to_raw_string k hash)) in
+        let digest = `Digest (Digestif.to_raw_string k hash) in
         let r0 =
           let b, _ = dkim.signature in
-          Mirage_crypto_pk.Rsa.PKCS1.verify ~hashp ~key
-            ~signature:(Cstruct.of_string b) digest in
+          Mirage_crypto_pk.Rsa.PKCS1.verify ~hashp ~key ~signature:b digest
+        in
         Log.debug (fun m -> m "Header fields verified: %b." r0) ;
         verify_body state ~simple ~relaxed dkim >>= fun r1 ->
         Log.debug (fun m -> m "Body verified: %b." r1) ;
         return (r0 && r1)
     | Ok (`ED25519 key), Value.ED25519 ->
-        let msg = Cstruct.of_string (Digestif.to_raw_string k hash) in
+        let msg = Digestif.to_raw_string k hash in
         let r0 =
           let b, _ = dkim.signature in
-          Mirage_crypto_ec.Ed25519.verify ~key (Cstruct.of_string b) ~msg in
+          Mirage_crypto_ec.Ed25519.verify ~key b ~msg in
         Log.debug (fun m -> m "Header fields verified: %b." r0) ;
         verify_body state ~simple ~relaxed dkim >>= fun r1 ->
         Log.debug (fun m -> m "Body verified: %b." r1) ;
@@ -967,7 +964,7 @@ let dkim_field_and_value =
 let server_of_dkim : key:Mirage_crypto_pk.Rsa.priv -> 'a dkim -> server =
  fun ~key dkim ->
   let pub = Mirage_crypto_pk.Rsa.pub_of_priv key in
-  let p = Cstruct.to_string (X509.Public_key.encode_der (`RSA pub)) in
+  let p = X509.Public_key.encode_der (`RSA pub) in
   let k, h = dkim.a in
   { v = "DKIM1"; h = [ h ]; n = None; k; p; s = [ Value.All ]; t = [] }
 
@@ -1100,7 +1097,7 @@ let sign :
     | Error _ -> assert false in
   canon field_dkim_signature unstrctrd (fun x -> Queue.push x q) ;
   let (H (k, vhash)) = digesti (fun f -> Queue.iter f q) in
-  let message = `Digest (Cstruct.of_string (Digestif.to_raw_string k vhash)) in
+  let message = `Digest (Digestif.to_raw_string k vhash) in
   let hash =
     match k with
     | Digestif.SHA1 -> `SHA1
@@ -1111,5 +1108,4 @@ let sign :
     | Digestif.MD5 -> `MD5
     | _ -> Fmt.invalid_arg "Unrecognized hash" in
   let signature = Mirage_crypto_pk.Rsa.PKCS1.sign ~hash ~key message in
-  let signature = Cstruct.to_string signature in
   return { dkim' with signature = (signature, bh) }

mirage/dune

@@ -1,5 +1,4 @@
 (library
  (name dkim_mirage)
  (public_name dkim-mirage)
- (libraries dkim mirage-random mirage-time mirage-clock tcpip
-   dns-client-mirage lwt))
+ (libraries dkim mirage-time mirage-clock tcpip dns-client-mirage lwt))

test/test.ml

@@ -46,9 +46,7 @@ let sjc2__domainkey_discoursemail_com =
 let seed = Base64.decode_exn "Do8KdmOYnU7yzqDn3A3lJwwXPaa1NRdv6E9R2KgZyXg="
 
 let priv_of_seed =
-  let g =
-    let seed = Cstruct.of_string seed in
-    Mirage_crypto_rng.(create ~seed (module Fortuna)) in
+  let g = Mirage_crypto_rng.(create ~seed (module Fortuna)) in
   Mirage_crypto_pk.Rsa.generate ~g ~bits:2048 ()
 
 let mails =