seppo/test/tls_test.ml

(*
 *    _  _   ____                         _  
 *  _| || |_/ ___|  ___ _ __  _ __   ___ | | 
 * |_  ..  _\___ \ / _ \ '_ \| '_ \ / _ \| | 
 * |_      _|___) |  __/ |_) | |_) | (_) |_| 
 *   |_||_| |____/ \___| .__/| .__/ \___/(_) 
 *                     |_|   |_|             
 *
 * Personal Social Web.
 *
 * test_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/>.
 *)

let test_digest_sha256 () =
  Seppo_lib.Logr.info (fun m -> m "%s.%s" "Tls_test" "test_digest_sha256");
  let `Hex h = ""
               |> Cstruct.of_string
               |> Mirage_crypto.Hash.SHA256.digest
               |> Hex.of_cstruct in
  (* https://de.wikipedia.org/wiki/SHA-2 *)
  h |> Assrt.equals_string __LOC__ "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855";
  ""
  |> Cstruct.of_string
  |> Mirage_crypto.Hash.SHA256.digest
  |> Cstruct.to_string
  |> Base64.encode_exn
  (* printf "%s" "" | openssl dgst -sha256 -binary | base64 *)
  |> Assrt.equals_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 test_sign_sha256 () =
  Seppo_lib.Logr.info (fun m -> m "%s.%s" "Tls_test" "test_sign_sha256");
  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
  |> Assrt.equals_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 |> Assrt.equals_string __LOC__ "rsa-sha256";
  si |> Cstruct.to_string |> Base64.encode_exn |> Assrt.equals_string __LOC__
    "TVMQvS8OZ94BFvMn8ToL0jG01L1T3Dww4o7R6NwcJd7KsOmZtUKzzCezbnY5gjSECj/cfXxs2mrZlk9xGntTKqhJ6YIZmM3BBdXuPl8IyWms/qtqZ4d+NVfMVDhYeGm43+j2HTegpcH2px9auXSThd2WcJmc7J98g9hx5+pEr6hA2UjawzOPYxIyyhNHzX9L1hTu6Xyjq6OkPWgqK9aHnAnGG1f3LgH+YTR0T/l5ODPCyKboFMfvmnQ2PDNRPgsz82j9YuMVF2sE/TCdpTg+T6dX99Hmp35lomXnf1GSTrVAWBcx6mFEOABMrFSRRcMzGo9zCWPb/y8V3xWaSpjroQ=="

let test_sign_sha512 () =
  Seppo_lib.Logr.info (fun m -> m "%s.%s" "Tls_test" "test_sign_sha512");
  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
  |> Assrt.equals_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
  |> Assrt.equals_int __LOC__ 256

let test_cstruct () =
  Seppo_lib.Logr.info (fun m -> m "%s.%s" "Tls_test" "test_cstruct");
  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' |> Assrt.equals_string __LOC__ "012345678901";
  ciph' |> Assrt.equals_string __LOC__ "some more length foo bar";
  assert true

let test_crypt () =
  Seppo_lib.Logr.info (fun m -> m "%s.%s" "Tls_test" "test_crypt");
  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 |> Assrt.equals_int __LOC__ 32;
  nonce |> Cstruct.length |> Assrt.equals_int __LOC__ 12;
  let ct = "9xRgUgzAoYRSW8JU8ggA8d+nH5cVj3XB86bwAvagZAkjbMTOrqWxIEJDEaLhdQ7VX0UHoASNzjyVj84iBPt6/vFospvJ1u+qIhiOJVci" in
  Mirage_crypto.Chacha20.authenticate_encrypt ~key ~nonce pay
  |> Cstruct.to_string
  |> Base64.encode_string
  |> Assrt.equals_string __LOC__ ct;
  ct
  |> Base64.decode_exn
  |> Cstruct.of_string
  |> Mirage_crypto.Chacha20.authenticate_decrypt ~key ~nonce
  |> Option.get
  |> Cstruct.to_string
  |> Assrt.equals_string __LOC__ "My payload may be arbitrary long and winded or just some bytes";
  assert true

let test_pem () =
  Seppo_lib.Logr.info (fun m -> m "%s.%s" "Tls_test" "test_pem");
  match "data/tls.priv.pem" |> Seppo_lib.Ap.PubKeyPem.private_of_pem with
  | Ok (`RSA _) -> assert true
  | Ok _        -> "wrong key type, must be RSA for now" |> Assrt.equals_string __LOC__ ""
  | Error s     -> s |> Assrt.equals_string __LOC__ "."

let test_fingerprint () =
  Seppo_lib.Logr.info (fun m -> m "%s.%s" "Tls_test" "test_fingerprint");
  "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
  |> Assrt.equals_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
  |> Assrt.equals_string __LOC__ "6abc29c310d9c042fd93e21828b8178161400a3b78adf0f09d62ac13712eb5fe"

let test_id () =
  Seppo_lib.Logr.info (fun m -> m "%s.%s" "Tls_test" "test_id");
  "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
  |> Assrt.equals_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
  |> Assrt.equals_string __LOC__ "24dce701a655bcb523595c43ef65b72358a869e4"

let () =
  Mirage_crypto_rng_lwt.initialize (module Mirage_crypto_rng.Fortuna);
  Unix.chdir "../../../test/";
  test_digest_sha256 ();
  test_sign_sha256 ();
  test_sign_sha512 ();
  test_cstruct ();
  test_crypt ();
  test_pem ();
  test_fingerprint ();
  test_id ();
  assert true