seppo/test/cookie_test.ml

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

let test_cookie () =
  let hk,hv = [("k0","v0");("k1","v1")] |> Cohttp.Cookie.Cookie_hdr.serialize in
  hk |> Assrt.equals_string __LOC__ "cookie";
  hv |> Assrt.equals_string __LOC__ "k0=v0; k1=v1";
  let _c = Cohttp.Cookie.Set_cookie_hdr.make
      ~domain:"example.com"
      ~expiration:`Session
      ~http_only:true
      ~path:"/foo/bar/"
      ~secure:true
      ("k","v=v; :") in
  assert _c.http_only;
  let (hk,hv) = _c |> Cohttp.Cookie.Set_cookie_hdr.serialize in
  hk |> Assrt.equals_string __LOC__ "Set-Cookie";
  hv |> Assrt.equals_string __LOC__ {|k=v=v; :; domain=example.com; path=/foo/bar/; secure; httponly|};
  (match hv
         |> Cohttp.Header.init_with "Cookie"
         |> Cohttp.Cookie.Cookie_hdr.extract with
  | [("k","v=v"); (":",""); ("domain","example.com"); ("path","/foo/bar/"); ("secure",""); ("httponly","")] ->
    assert true
  | l -> l |> List.length |> Assrt.equals_int __LOC__ (-1)
  );
  assert true


let test_encrypt () =
  let sec = "My secret Secret 89 123456789 12" |> Cstruct.of_string
  and nonce = "123456789012" |> Cstruct.of_string in
  let ci = "Merhaba, world!"
           |> Cstruct.of_string
           |> Cookie.encrypt sec nonce 
  in
  ci |> Assrt.equals_string __LOC__ "MTIzNDU2Nzg5MDEyAGoh40PQjxKT7k6hzTRa5pJ1Z6TauBDAsYaEMm2A4w";
  ci |> Cookie.decrypt sec
  |> Option.get
  |> Assrt.equals_string __LOC__ "Merhaba, world!";
  assert true

let test_chacha20 () =
  let sec = "My secret Secret 89 123456789 12" |> Cstruct.of_string
  and nonce = "123456789012" |> Cstruct.of_string in
  assert (32 = (sec |> Cstruct.length));
  assert (12 = (nonce |> Cstruct.length));
  let key = sec |> Mirage_crypto.Chacha20.of_secret in
  "Merhaba, world!"
  |> Cstruct.of_string
  |> Mirage_crypto.Chacha20.authenticate_encrypt ~key ~nonce
  |> Mirage_crypto.Chacha20.authenticate_decrypt ~key ~nonce
  |> Option.get
  |> Cstruct.to_string
  |> Assrt.equals_string __LOC__ "Merhaba, world!";
  assert true

let test_chacha20_b64 () =
  let sec = "My secret Secret 89 123456789 12" |> Cstruct.of_string
  and nonce = "123456789012" |> Cstruct.of_string in
  assert (32 = (sec |> Cstruct.length));
  assert (12 = (nonce |> Cstruct.length));
  let key = sec |> Mirage_crypto.Chacha20.of_secret in
  "Merhaba, world!"
  |> Cstruct.of_string
  |> Mirage_crypto.Chacha20.authenticate_encrypt ~key ~nonce
  |> Cstruct.to_string
  |> Base64.encode_string
  |> Base64.decode_exn
  |> Cstruct.of_string
  |> Mirage_crypto.Chacha20.authenticate_decrypt ~key ~nonce
  |> Option.get
  |> Cstruct.to_string
  |> Assrt.equals_string __LOC__ "Merhaba, world!";
  assert true

let test_mk () =
  let (t,_,_) = Ptime.of_rfc3339 "2022-02-02T22:22:22+02:00" |> Result.get_ok
  and nonce = ("0123456789ab" |> Cstruct.of_string) in
  "0123456789abcdef0123456789abcdef"
  |> Cstruct.of_string
  |> Cookie.mk ("sepp", t) nonce
  |> Result.get_ok
  |> Assrt.equals_string __LOC__ "MDEyMzQ1Njc4OWFidvsUpFAkq93MA41ORpoq-zqlgyEHDBngjRK145yugGW3vqrbSCIlhbQ";
  assert true

let () =
  Mirage_crypto_rng_lwt.initialize (module Mirage_crypto_rng.Fortuna);
  Unix.chdir "../../../test/";
  test_cookie ();
  test_encrypt ();
  test_chacha20 ();
  test_chacha20_b64 ();
  test_mk ();
  assert true