seppo/test/t_tls.ml

(*
 *    _  _   ____                         _  
 *  _| || |_/ ___|  ___ _ __  _ __   ___ | | 
 * |_  ..  _\___ \ / _ \ '_ \| '_ \ / _ \| | 
 * |_      _|___) |  __/ |_) | |_) | (_) |_| 
 *   |_||_| |____/ \___| .__/| .__/ \___/(_) 
 *                     |_|   |_|             
 *
 * Personal Social Web.
 *
 * t_tls.ml
 *
 * Copyright (C) The #Seppo contributors. All rights reserved.
 *
 * This program is free software: you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program.  If not, see <http://www.gnu.org/licenses/>.
 *)

open Alcotest

let set_up = "setup", `Quick, (fun () ->  
    Mirage_crypto_rng_lwt.initialize (module Mirage_crypto_rng.Fortuna);
    Unix.chdir "../../../test/"
  )

let tc_digest_sha256 = "tc_digest_sha256", `Quick, (fun () ->
    let `Hex h = ""
                 |> Cstruct.of_string
                 |> Mirage_crypto.Hash.SHA256.digest
                 |> Hex.of_cstruct in
    (* https://de.wikipedia.org/wiki/SHA-2 *)
    h |> check string __LOC__ "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855";
    ""
    |> Cstruct.of_string
    |> Mirage_crypto.Hash.SHA256.digest
    |> Cstruct.to_string
    |> Base64.encode_exn
    (* printf "%s" "" | openssl dgst -sha256 -binary | base64 *)
    |> check string __LOC__ "47DEQpj8HBSa+/TImW+5JCeuQeRkm5NMpJWZG3hSuFU="
  )

(*
https://blog.joinmastodon.org/2018/06/how-to-implement-a-basic-activitypub-server/

openssl genrsa -out private.pem 2048
openssl rsa -in private.pem -outform PEM -pubout -out public.pem
*)

(*
 * https://discuss.ocaml.org/t/tls-signature-with-opam-tls/9399/3?u=mro
 *)
let tc_sign_sha256 = "tc_sign_sha256", `Quick, (fun () ->
    let data = "to-be-signed-data" |> Cstruct.of_string in
    Lwt.bind
    (*
$ openssl genrsa -out private.pem 2048
$ openssl rsa -in private.pem -outform PEM -pubout -out public.pem
    *)
      (* https://mirleft.github.io/ocaml-tls/doc/tls/X509_lwt/#val-private_of_pems *)
      (X509_lwt.private_of_pems ~cert:"data/tls.pub.pem" ~priv_key:"data/tls.priv.pem")
      (fun (_, priv) ->
      (*
    https://mirleft.github.io/ocaml-x509/doc/x509/X509/Private_key/#cryptographic-sign-operation
    *)
         X509.Private_key.sign `SHA256 ~scheme:`RSA_PKCS1 priv
           (`Message data)
         |> Result.get_ok
         |> Lwt.return)
    |>
    Lwt_main.run
    |> Cstruct.to_string
    |> Base64.encode_exn
    |> check string __LOC__
      "TVMQvS8OZ94BFvMn8ToL0jG01L1T3Dww4o7R6NwcJd7KsOmZtUKzzCezbnY5gjSECj/cfXxs2mrZlk9xGntTKqhJ6YIZmM3BBdXuPl8IyWms/qtqZ4d+NVfMVDhYeGm43+j2HTegpcH2px9auXSThd2WcJmc7J98g9hx5+pEr6hA2UjawzOPYxIyyhNHzX9L1hTu6Xyjq6OkPWgqK9aHnAnGG1f3LgH+YTR0T/l5ODPCyKboFMfvmnQ2PDNRPgsz82j9YuMVF2sE/TCdpTg+T6dX99Hmp35lomXnf1GSTrVAWBcx6mFEOABMrFSRRcMzGo9zCWPb/y8V3xWaSpjroQ==";
    let pk = match "data/tls.priv.pem"
                   |> Seppo_lib.File.to_bytes
                   |> Cstruct.of_bytes
                   |> X509.Private_key.decode_pem with
    | Ok ((`RSA _) as pk) -> pk
    | Ok _           -> failwith "wrong key type, must be RSA for now"
    | Error (`Msg s) -> failwith s in
    let (al,si) = data |> Seppo_lib.Ap.PubKeyPem.sign pk in
    al |> check string __LOC__ "rsa-sha256";
    si |> Cstruct.to_string |> Base64.encode_exn |> check string __LOC__
      "TVMQvS8OZ94BFvMn8ToL0jG01L1T3Dww4o7R6NwcJd7KsOmZtUKzzCezbnY5gjSECj/cfXxs2mrZlk9xGntTKqhJ6YIZmM3BBdXuPl8IyWms/qtqZ4d+NVfMVDhYeGm43+j2HTegpcH2px9auXSThd2WcJmc7J98g9hx5+pEr6hA2UjawzOPYxIyyhNHzX9L1hTu6Xyjq6OkPWgqK9aHnAnGG1f3LgH+YTR0T/l5ODPCyKboFMfvmnQ2PDNRPgsz82j9YuMVF2sE/TCdpTg+T6dX99Hmp35lomXnf1GSTrVAWBcx6mFEOABMrFSRRcMzGo9zCWPb/y8V3xWaSpjroQ=="
  )

let tc_sign_sha512 = "tc_sign_sha512", `Quick, (fun () ->
    let module PSS_SHA512 = Mirage_crypto_pk.Rsa.PSS (Mirage_crypto.Hash.SHA512) in
    let priv = Mirage_crypto_pk.Rsa.generate ~bits:2048 () in
    X509.Private_key.encode_pem (`RSA priv)
    |> Cstruct.to_bytes
    |> Bytes.length
    |> check int __LOC__ 1704;
    let data = "to-be-signed-data" in
    let signature =
      PSS_SHA512.sign ~key:priv (`Message (Cstruct.of_string data))
    in
    signature |> Cstruct.to_bytes |> Bytes.length
    |> check int __LOC__ 256
  )

let tc_cstruct = "tc_cstruct", `Quick, (fun () ->
    let nonce = Cstruct.of_string "012345678901"
    and ciph  = Cstruct.of_string "some more length foo bar" in
    let c' = Cstruct.append nonce ciph in
    let nonce' = Cstruct.to_string ~len:12 c'
    and ciph' = Cstruct.to_string ~off:12 c' in
    nonce' |> check string __LOC__ "012345678901";
    ciph' |> check string __LOC__ "some more length foo bar";
    ()
  )

let tc_crypt = "tc_crypt", `Quick, (fun () ->
    let key' = "My key secret 123456789012345678" |> Cstruct.of_string in
    let key = key' |> Mirage_crypto.Chacha20.of_secret
    and nonce = "My nonce 123" |> Cstruct.of_string
    and pay = "My payload may be arbitrary long and winded or just some bytes" |> Cstruct.of_string
    in
    key' |> Cstruct.length |> check int __LOC__ 32;
    nonce |> Cstruct.length |> check int __LOC__ 12;
    let ct = "9xRgUgzAoYRSW8JU8ggA8d+nH5cVj3XB86bwAvagZAkjbMTOrqWxIEJDEaLhdQ7VX0UHoASNzjyVj84iBPt6/vFospvJ1u+qIhiOJVci" in
    Mirage_crypto.Chacha20.authenticate_encrypt ~key ~nonce pay
    |> Cstruct.to_string
    |> Base64.encode_string
    |> check string __LOC__ ct;
    ct
    |> Base64.decode_exn
    |> Cstruct.of_string
    |> Mirage_crypto.Chacha20.authenticate_decrypt ~key ~nonce
    |> Option.get
    |> Cstruct.to_string
    |> check string __LOC__ "My payload may be arbitrary long and winded or just some bytes";
    ()
  )

let tc_pem = "tc_pem", `Quick, (fun () ->
    match "data/tls.priv.pem" |> Seppo_lib.Ap.PubKeyPem.private_of_pem with
    | Ok (`RSA _) -> ()
    | Ok _        -> "wrong key type, must be RSA for now" |> check string __LOC__ ""
    | Error s     -> s |> check string __LOC__ "."
  )

let tc_fingerprint = "tc_fingerprint", `Quick, (fun () ->
    "data/cavage.priv.pem"
    |> Seppo_lib.File.to_bytes
    |> Cstruct.of_bytes
    |> X509.Private_key.decode_pem
    |> Result.get_ok
    |> X509.Private_key.public
    |> X509.Public_key.fingerprint
    |> Cstruct.to_hex_string
    |> check string __LOC__ "6abc29c310d9c042fd93e21828b8178161400a3b78adf0f09d62ac13712eb5fe";
    "data/cavage.pub.pem"
    |> Seppo_lib.File.to_bytes
    |> Cstruct.of_bytes
    |> X509.Public_key.decode_pem
    |> Result.get_ok
    |> X509.Public_key.fingerprint
    |> Cstruct.to_hex_string
    |> check string __LOC__ "6abc29c310d9c042fd93e21828b8178161400a3b78adf0f09d62ac13712eb5fe"
  )

let tc_id = "tc_id", `Quick, (fun () ->
    "data/cavage.priv.pem"
    |> Seppo_lib.File.to_bytes
    |> Cstruct.of_bytes
    |> X509.Private_key.decode_pem
    |> Result.get_ok
    |> X509.Private_key.public
    |> X509.Public_key.id
    |> Cstruct.to_hex_string
    |> check string __LOC__ "24dce701a655bcb523595c43ef65b72358a869e4";
    "data/cavage.pub.pem"
    |> Seppo_lib.File.to_bytes
    |> Cstruct.of_bytes
    |> X509.Public_key.decode_pem
    |> Result.get_ok
    |> X509.Public_key.id
    |> Cstruct.to_hex_string
    |> check string __LOC__ "24dce701a655bcb523595c43ef65b72358a869e4"
  )

let () =
  run
    "seppo_suite" [
    __FILE__ , [ 
      set_up;
      tc_digest_sha256;
      tc_sign_sha256;
      tc_sign_sha512;
      tc_cstruct;
      tc_crypt;
      tc_pem;
      tc_fingerprint;
      tc_id;
    ]
  ]