seppo/test/cfg_test.ml

(*
 *    _  _   ____                         _  
 *  _| || |_/ ___|  ___ _ __  _ __   ___ | | 
 * |_  ..  _\___ \ / _ \ '_ \| '_ \ / _ \| | 
 * |_      _|___) |  __/ |_) | |_) | (_) |_| 
 *   |_||_| |____/ \___| .__/| .__/ \___/(_) 
 *                     |_|   |_|             
 *
 * Personal Social Web.
 *
 * cfg_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_rnd_pwd () =
  let p = Cfg.random_pwd () in
  Logr.info (fun m -> m "cfg_test.test_rnd_pwd 1 %s" p);
  p |> String.length |> Assrt.equals_int __LOC__ 16;
  assert true

let test_csexp () =
  Logr.info (fun m -> m "cfg_test.test_csexp");
  Csexp.Atom "uhu"
  |> Csexp.to_string
  |> Assrt.equals_string __LOC__ "3:uhu";

  Csexp.List [ Csexp.Atom "a"; Csexp.Atom "b"]
  |> Csexp.to_string
  |> Assrt.equals_string __LOC__ "(1:a1:b)";

  Csexp.List [ Csexp.Atom "/^.*$/"; Csexp.Atom "$1"]
  |> Csexp.to_string
  |> Assrt.equals_string __LOC__ "(6:/^.*$/2:$1)";

  Csexp.List [ Csexp.Atom "/^.* $/"; Csexp.Atom "$1 "]
  |> Csexp.to_string
  |> Assrt.equals_string __LOC__ "(7:/^.* $/3:$1 )";

  Csexp.List [
    Csexp.List [ Csexp.Atom "/^.*$/"; Csexp.Atom "$1" ];
    Csexp.List [ Csexp.Atom "/.*/"; Csexp.Atom "$1" ]
  ]
  |> Csexp.to_string
  |> Assrt.equals_string __LOC__ "((6:/^.*$/2:$1)(4:/.*/2:$1))";

  (match Csexp.parse_string "((6:/^.*$/2:$1)(4:/.*/2:$1))" with
   | Ok Csexp.List [
       Csexp.List [ Csexp.Atom a; Csexp.Atom b ];
       Csexp.List [ Csexp.Atom c; Csexp.Atom d ]
     ] ->
     a |> Assrt.equals_string __LOC__ "/^.*$/";
     b |> Assrt.equals_string __LOC__ "$1";
     c |> Assrt.equals_string __LOC__ "/.*/";
     d |> Assrt.equals_string __LOC__ "$1"
   | Error (idx, txt) ->
     Logr.err (fun m -> m "%s char %d of '%s'" E.e9001 idx txt);
     assert false;
   | _ -> assert false);

  (match Csexp.parse_string "1:a" with
   | Ok Csexp.Atom "a" -> ()
   | _ -> assert false);

  (* https://github.com/ocaml-dune/csexp/issues/21 *)
  (match Csexp.parse_string_many "1:a" with
   | Ok [Csexp.Atom "a"] -> ()
   | _ -> assert false);
  (match Csexp.parse_string_many "1:a2:bb" with
   | Ok [Csexp.Atom "a"; Csexp.Atom "bb"] -> ()
   | _ -> assert false);
  (match Csexp.parse_string_many "(1:a2:bb)" with
   | Ok [Csexp.List [Csexp.Atom "a"; Csexp.Atom "bb"]] -> ()
   | _ -> assert false);
  (match Csexp.parse_string_many "(1:a)(2:bb)" with
   | Ok [Csexp.List [Csexp.Atom "a"]; Csexp.List [Csexp.Atom "bb"]] -> ()
   | _ -> assert false);

  let fn = "tmp/~cfg~" in
  (try Sys.remove fn with | _ -> ());
  let oc = open_out_gen [ Open_wronly; Open_creat; Open_excl; Open_binary ] 0o444 fn in
  Csexp.Atom "a\nb" |> Csexp.to_channel oc;
  oc |> close_out;
  let ic = open_in_gen [ Open_rdonly; Open_binary ] 0 fn in
  (match Csexp.input_many ic with
   | Ok [Csexp.Atom v] -> Assrt.equals_string __LOC__ "a\nb" v
   | _ -> assert false);
  close_in ic;
  Unix.unlink fn;
  assert true


let test_sexp0 () =
  Logr.info (fun m -> m "cfg_test.test_sexp0");
  let open Sexplib in
  Sexp.Atom "uhu"
  |> Sexp.to_string_hum
  |> Assrt.equals_string __LOC__ "uhu"
  ;
  Sexp.List [ Sexp.Atom "a"; Sexp.Atom "b"]
  |> Sexp.to_string_hum
  |> Assrt.equals_string __LOC__ "(a b)"
  ;
  Sexp.List [ Sexp.Atom "/^.*$/"; Sexp.Atom "$1"]
  |> Sexp.to_string_hum
  |> Assrt.equals_string __LOC__ "(/^.*$/ $1)"
  ;
  Sexp.List [ Sexp.Atom "/^.* $/"; Sexp.Atom "$1 "]
  |> Sexp.to_string_hum
  |> Assrt.equals_string __LOC__ "(\"/^.* $/\" \"$1 \")"
  ;
  (match Sexp.of_string " ( ( /^.*$/ $1 ) ( \"/.*/\" \"$1\" ) )" with
   | Sexp.List [
       Sexp.List [ Sexp.Atom a; Sexp.Atom b ];
       Sexp.List [ Sexp.Atom c; Sexp.Atom d ]
     ] ->
     a |> Assrt.equals_string __LOC__ "/^.*$/";
     b |> Assrt.equals_string __LOC__ "$1";
     c |> Assrt.equals_string __LOC__ "/.*/";
     d |> Assrt.equals_string __LOC__ "$1"
   | _ -> assert false);
  assert true

let test_bcrypt () =
  Logr.info (fun m -> m "cfg_test.test_bcrypt");
  assert (
    "$2y$06$4xLSOcTZedSV78qdnjktl.0V4VsUwLycCIkIaRrdxoSP6jtCWJJxu"
    |> Bcrypt.hash_of_string
    |> Bcrypt.verify "correct battery horse staple");
  (* compatibility with golang.org/x/crypto/bcrypt bcrypt.GenerateFromPassword *)
  assert (
    "$2a$10$qp5lpHEpXCym7CGYxnPJ7.OhIRAyvtj6iPWJslXOFzl4Hni23h4tu"
    |> Bcrypt.hash_of_string
    |> Bcrypt.verify "demodemodemo")

(*
let test_sexp1 () =
  let c0 = Config.load "config_test.0.sx" in
  assert ("string" = c0.title);
  Assrt.equals_int __LOC__ 5 (List.length c0.url_cleaner);
  Assrt.equals_int __LOC__ 2 (List.length c0.posse)
*)

let test_profile () =
  Logr.info (fun m -> m "cfg_test.test_profile");
  let p = Cfg.Profile.from_file "data/profile.s" |> Result.get_ok in
  let Rfc4287.Rfc4646 language = p.language in
  p.title    |> Assrt.equals_string __LOC__ "Oh my blog";
  p.bio      |> Assrt.equals_string __LOC__ "some longer text
that may span mul-
tiple lines";
  language |> Assrt.equals_string __LOC__ "en";
  p.timezone |> Timedesc.Time_zone.name |> Assrt.equals_string __LOC__ "Europe/Zurich";
  p.posts_per_page |> Assrt.equals_int __LOC__ 50;
  assert true

let () =
  Mirage_crypto_rng_lwt.initialize (module Mirage_crypto_rng.Fortuna);
  Unix.chdir "../../../test/";
  test_rnd_pwd ();
  test_csexp ();
  test_sexp0 ();
  test_bcrypt ();
  (* test_sexp1 (); *)
  test_profile ();
  assert true