seppo/test/http_test.ml

(*
 *    _  _   ____                         _ 
 *  _| || |_/ ___|  ___ _ __  _ __   ___ | | 
 * |_  ..  _\___ \ / _ \ '_ \| '_ \ / _ \| | 
 * |_      _|___) |  __/ |_) | |_) | (_) |_| 
 *   |_||_| |____/ \___| .__/| .__/ \___/(_) 
 *                     |_|   |_|             
 *
 * Personal Social Web.
 *
 * http_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_relpa () =
  Http.relpa "a/b/" "a/b/d/e" |> Assrt.equals_string __LOC__ "d/e";
  Http.relpa "a/B/" "a/b/d/e" |> Assrt.equals_string __LOC__ ""

let test_uri () =
  let base = "https://example.com:443/a/b/c?d=e#f" |> Uri.of_string in

  base |> Uri.path
  |> Assrt.equals_string __LOC__ "/a/b/c";

  "../i.j" |> Uri.of_string |> Http.reso ~base |> Uri.to_string
  |> Assrt.equals_string __LOC__ "https://example.com:443/a/i.j";

  let re = "https://example.com:443/a/b/C/d.e#ff" |> Uri.of_string |> Http.abs_to_rel ~base in
  re |> Uri.to_string |> Assrt.equals_string __LOC__ "C/d.e#ff";

  Uri.make ~path:"." () |> Http.reso ~base:Uri.empty |> Uri.to_string |> Assrt.equals_string __LOC__ ""

module Request = struct
  let test_uri () =
    let abs' (r : Cgi.Request.t) : Uri.t =
      Uri.make
        ~scheme:r.scheme
        ~host:r.host
        ~port:(int_of_string r.server_port)
        ~path:(r.script_name ^ r.path_info)
        ()
    and r : Cgi.Request.t = {
      content_type   = "text/plain";
      content_length = None;
      host           = "example.com";
      http_cookie    = "";
      path_info      = "/shaarli";
      query_string   = "post=uhu";
      request_method = "GET";
      remote_addr    = "127.0.0.1";
      scheme         = "https";
      script_name    = "/sub/seppo.cgi";
      server_port    = "443";
      raw_string     = Sys.getenv_opt
    } in
    r |> abs' |> Uri.to_string |> Assrt.equals_string __LOC__ "https://example.com:443/sub/seppo.cgi/shaarli";
    r |> Cgi.Request.abs |> Uri.of_string |> Uri.to_string |> Assrt.equals_string __LOC__ "https://example.com/sub/seppo.cgi/shaarli?post=uhu";
    r |> Cgi.Request.path_and_query |> Assrt.equals_string __LOC__ "/sub/seppo.cgi/shaarli?post=uhu";
    r |> Cgi.Request.path_and_query |> Uri.of_string |> Uri.to_string |> Assrt.equals_string __LOC__ "/sub/seppo.cgi/shaarli?post=uhu";
    "a" |> Assrt.equals_string __LOC__ "a";
    assert true

  let test_query_string () =
    match "" |> Uri.query_of_encoded with
    | [("",[])] -> ()
    | _ -> "no" |> Assrt.equals_string __LOC__ ""
end

module Cookie = struct
  let test_rfc1123 () =
    let s = "Thu, 01 Jan 1970 00:00:00 GMT" in
    Ptime.epoch |> Http.to_rfc1123 |> Assrt.equals_string __LOC__ s;
    assert true

  let test_to_string () =
    let http_only = Some true
    and path = Some "seppo.cgi"
    and same_site = Some `Strict
    and max_age = Some (30. *. 60.)
    and secure = Some true in
    Cookie.to_string ?path ?secure ?http_only ?same_site ("auth_until", "2022-04-08T22:30:07Z")
    |> Assrt.equals_string __LOC__
      "auth_until=2022-04-08T22:30:07Z; Path=seppo.cgi; Secure; HttpOnly; \
       SameSite=Strict";
    Cookie.to_string ?max_age ?path ?secure ?http_only ?same_site ("auth", "yes")
    |> Assrt.equals_string __LOC__
      "auth=yes; Max-Age=1800; Path=seppo.cgi; Secure; HttpOnly; \
       SameSite=Strict";
    assert true

  let test_of_string () =
    let c = Cookie.to_string ("#Seppo!", "foo") in
    c |> Assrt.equals_string __LOC__ "#Seppo!=foo";
    let v = match c |> Cookie.of_string with
      | ("#Seppo!", v) :: [] -> v
      | _ -> assert false
    in
    v |> Assrt.equals_string __LOC__ "foo";
    assert true
end

module Form = struct
  let test_of_channel () =
    let ic = "data/cgi_" ^ "2022-04-05T125146.post" |> open_in in
    let fv = ic |> Http.Form.of_channel in
    ic |> close_in;
    (match fv with
     | [ (k0, [ v0 ]); (k1, [ v1 ]); (k2, [ v2 ]); (k3, [ v3 ]) ] ->
       k0 |> Assrt.equals_string __LOC__ "login";
       v0 |> Assrt.equals_string __LOC__ "demo";
       k1 |> Assrt.equals_string __LOC__ "password";
       v1 |> Assrt.equals_string __LOC__ "demodemodemo";
       k2 |> Assrt.equals_string __LOC__ "token";
       v2
       |> Assrt.equals_string __LOC__
         "ff13e7eaf9541ca2ba30fd44e864c3ff014d2bc9";
       k3 |> Assrt.equals_string __LOC__ "returnurl";
       v3
       |> Assrt.equals_string __LOC__ "https://demo.mro.name/shaarligo/o/p/";
       assert true
     | _ -> assert false);
    (* match
       fv
       |> Http.Form.filter_sort_keys
         [ "login"; "password"; "token"; "returnurl" ]
       with
       | [ (k0, [ v0 ]); (k1, [ v1 ]); (k2, [ v2 ]); (k3, [ v3 ]) ] ->
       k0 |> Assrt.equals_string __LOC__ "login";
       v0 |> Assrt.equals_string __LOC__ "demo";
       k1 |> Assrt.equals_string __LOC__ "password";
       v1 |> Assrt.equals_string __LOC__ "demodemodemo";
       k2 |> Assrt.equals_string __LOC__ "returnurl";
       v2
       |> Assrt.equals_string __LOC__ "https://demo.mro.name/shaarligo/o/p/";
       k3 |> Assrt.equals_string __LOC__ "token";
       v3
       |> Assrt.equals_string __LOC__
         "ff13e7eaf9541ca2ba30fd44e864c3ff014d2bc9";
       assert true
       | _ -> assert false *);
    assert true

  let test_to_html () =
    let defs = [
      ("ka", (Ok "va", "text", [("autofocus",""); ("pattern", {|^\S+$|})]));
    ] in
    (match List.assoc_opt "ka" defs with
     | Some (Ok v,_,_) -> v
     | _ -> "foo")
    |> Assrt.equals_string __LOC__ "va";
    assert true

  let test_from_html () =
    let pred ty valu (na,va) =
      Result.bind
        valu
        (fun v ->
           match v with
           | None -> Ok None
           | Some v as vv ->
             match ty,na with
             | _,"pattern" ->
               Logr.debug (fun m -> m "    '%s' ~ /%s/" v va);
               Ok vv
             | _ ->
               Logr.debug (fun m -> m "    ignored %s='%s'" na va);
               Ok vv)
    in
    let string (name,(ty,preds)) vals =
      let v = Option.bind
          (List.assoc_opt name vals)
          (fun v -> Some (v |> String.concat "")) in
      List.fold_left (pred ty) (Ok v) preds in
    let _validate defs vals =
      Logr.debug (fun m -> m "Form.validate");
      let field init (name,(ty,preds)) =
        match string (name,(ty,preds)) vals with
        | Error _ as inp ->
          (match init with
           | Error a -> Error (inp :: a)
           | Ok a    -> Error (inp :: a)
          )
        | Ok _ as inp ->
          (match init with
           | Error a -> Error (inp :: a)
           | Ok a    -> Ok    (inp :: a)
          )
      in
      List.fold_left field (Ok []) defs
    in
    let def0 = ("ka", ("text", [("autofocus",""); ("pattern", {|^\S+$|})])) in
    let _defs = [ def0; ] in
    let vals = [
      ("ka", ["vb"]);
    ] in
    (* match _validate defs vals with
       | Ok res -> List.assoc_opt "ka" res
                 |> Option.value ~default:(Ok None)
                 |> Result.get_ok
                 |> Option.get
                 |> Assrt.equals_string __LOC__ "vb"
       | _ -> assert false); *)
    let ( let* ) = Result.bind in
    let run () =
      let* k = string def0 vals in
      Ok k in
    (match run() with
     | Ok (Some v)   -> v |> Assrt.equals_string __LOC__ "vb"
     | _ -> assert true);
    assert true

  let test_from_html1 () =
    let i0 : Http.Form.input = ("k0", "text", [
        ("autofocus", "autofocus");
        ("required",  "required");
        ("pattern",   {|^[a-z][0-9]+$|});
      ]) in
    let i1 = ("k1", "text", [
        ("required",  "required");
        ("minlength", "1");
        ("maxlength", "50");
        ("pattern",   {|^v.$|});
      ]) in
    let vals : Http.Form.t = [
      ("k0", ["v0"]);
      ("k1", ["v1"]);
    ] in
    let ( let* ) = Result.bind in
    let run () =
      let* v0 = vals |> Http.Form.string i0 in
      let* v1 = Http.Form.string i1 vals in
      v0 |> Assrt.equals_string __LOC__ "v0";
      v1 |> Assrt.equals_string __LOC__ "v1";
      Ok () in
    (match run() with
     | Error (_,e) -> e |> Assrt.equals_string __LOC__ ""
     | _    -> ())
end


module Header = struct
  let test_headers () =
    Logr.info (fun m -> m "http_test.test_headers");
    let h = [ ("A", "a"); ("B", "b") ] @ [ ("C", "c") ]
            |> Cohttp.Header.of_list in
    h |> Cohttp.Header.to_string
    |> Assrt.equals_string __LOC__ "A: a\r\nB: b\r\nC: c\r\n\r\n";
    h |> Cohttp.Header.to_frames
    |> String.concat "\n"
    |> Assrt.equals_string __LOC__ "A: a\nB: b\nC: c";
    Cohttp.Header.get h "a"
    |> Option.value ~default:"-"
    |> Assrt.equals_string __LOC__ "a";
    assert true

  let test_signature () =
    Logr.info (fun m -> m "http_test.test_signature");
    let si = {|keyId="Test",algorithm="rsa-sha256",headers="(request-target) host date",signature="qdx+H7PHHDZgy4y/Ahn9Tny9V3GP6YgBPyUXMmoxWtLbHpUnXS2mg2+SbrQDMCJypxBLSPQR2aAjn7ndmw2iicw3HMbe8VfEdKFYRqzic+efkb3nndiv/x1xSHDJWeSWkx3ButlYSuBskLu6kd9Fswtemr3lgdDEmn04swr2Os0="|} in
    let si = Http.Signature.decode si |> Result.get_ok in
    si |> List.length |> Assrt.equals_int __LOC__ 4;
    assert true

  let test_to_sign_string_basic () =
    let open Cohttp in
    let uri = Uri.of_string "/foo?param=value&pet=dog" in
    let request = Some ("post",uri) in
    [
      ("host", "example.com");
      ("date", "Sun, 05 Jan 2014 21:31:40 GMT");
    ]
    |> Header.of_list
    |> Http.Signature.to_sign_string ~request
    |> Assrt.equals_string __LOC__
      {|(request-target): post /foo?param=value&pet=dog
host: example.com
date: Sun, 05 Jan 2014 21:31:40 GMT|};
    assert true

(*
 * https://datatracker.ietf.org/doc/html/draft-cavage-http-signatures-12#appendix-C.2
 *)
  let test_sign_basic () =
    Logr.info (fun m -> m "http_test.test_sign_basic");
    let pk = match Ap.PubKeyPem.private_of_pem "data/cavage.priv.pem" with
      | Ok pk -> pk
      | _     -> failwith "ouch" in
    let open Cohttp in
    let sig_ = "qdx+H7PHHDZgy4y/Ahn9Tny9V3GP6YgBPyUXMmoxWtLbHpUnXS2mg2+SbrQDMCJypxBLSPQR2aAjn7ndmw2iicw3HMbe8VfEdKFYRqzic+efkb3nndiv/x1xSHDJWeSWkx3ButlYSuBskLu6kd9Fswtemr3lgdDEmn04swr2Os0="
    and uri = Uri.of_string "/foo?param=value&pet=dog"
    and h = [
      ("host", "example.com");
      ("date", "Sun, 05 Jan 2014 21:31:40 GMT");
    ] |> Header.of_list in
    let request = Some("post",uri) in
    let s = h |> Http.Signature.to_sign_string ~request in
    s |> Assrt.equals_string __LOC__
      "(request-target): post /foo?param=value&pet=dog\n\
       host: example.com\n\
       date: Sun, 05 Jan 2014 21:31:40 GMT";
    let al,si = s |> Cstruct.of_string |> Ap.PubKeyPem.sign pk in
    al |> Assrt.equals_string __LOC__ "rsa-sha256";
    si |> Cstruct.to_string |> Base64.encode_exn |> Assrt.equals_string __LOC__ sig_;

    Logr.info (fun m -> m "http_test.test_sign_basic II");
    let pub = "data/cavage.pub.pem" |> File.to_string |> Ap.PubKeyPem.of_pem |> Result.get_ok in
    let uuid = Uuidm.v `V4 in
    (match Ap.PubKeyPem.verify ~uuid ~algo:"rsa-sha256" pub si (s |> Cstruct.of_string) with
     | Error `Msg e -> e |> Assrt.equals_string __LOC__ ""
     | Ok _ -> "ha!" |> Assrt.equals_string __LOC__ "ha!");
    assert true

(*
 * https://datatracker.ietf.org/doc/html/draft-cavage-http-signatures-12#appendix-C.3
 *)
  let test_sign_all_headers () =
    Logr.info (fun m -> m "http_test.test_sign_all_headers");
    let open Cohttp in
    let h = [
      ("(request-target)", "post /foo?param=value&pet=dog");
      ("(created)", "1402170695");
      ("(expires)", "1402170699");
      ("host", "example.com");
      ("date", "Sun, 05 Jan 2014 21:31:40 GMT");
      ("content-type", "application/json");
      ("digest", "SHA-256=X48E9qOokqqrvdts8nOJRJN3OWDUoyWxBf7kbu9DBPE=");
      ("content-length", "18");
    ] |> Header.of_list in
    h
    |> Header.to_frames
    |> String.concat "\n"
    |> Assrt.equals_string __LOC__
      "(request-target): post /foo?param=value&pet=dog\n\
       (created): 1402170695\n\
       (expires): 1402170699\n\
       host: example.com\n\
       date: Sun, 05 Jan 2014 21:31:40 GMT\n\
       content-type: application/json\n\
       digest: SHA-256=X48E9qOokqqrvdts8nOJRJN3OWDUoyWxBf7kbu9DBPE=\n\
       content-length: 18"
    ;
    let pk = Ap.PubKeyPem.private_of_pem "data/cavage.priv.pem"
             |> Result.get_ok in
    let al,si = h
                |> Header.to_frames
                |> String.concat "\n"
                |> Cstruct.of_string
                |> Ap.PubKeyPem.sign pk
    in
    (*  |> Assrt.equals_string __LOC__
          "vSdrb+dS3EceC9bcwHSo4MlyKS59iFIrhgYkz8+oVLEEzmYZZvRs8rgOp+63LEM3v+MFHB32NfpB2bEKBIvB1q52LaEUHFv120V01IL+TAD48XaERZFukWgHoBTLMhYS2Gb51gWxpeIq8knRmPnYePbF5MOkR0Zkly4zKH7s1dE="
    *)
    al |> Assrt.equals_string __LOC__ "rsa-sha256";
    si |> Cstruct.to_string |> Base64.encode_exn |> Assrt.equals_string __LOC__
      "nAkCW0wg9AbbStQRLi8fsS1mPPnA6S5+/0alANcoDFG9hG0bJ8NnMRcB1Sz1eccNMzzLEke7nGXqoiJYZFfT81oaRqh/MNFwQVX4OZvTLZ5xVZQuchRkOSO7b2QX0aFWFOUq6dnwAyliHrp6w3FOxwkGGJPaerw2lOYLdC/Bejk="

  let test_signed_headers () =
    Logr.info (fun m -> m "http_test.test_signed_headers");
    let open Cohttp in
    (* values from
       https://datatracker.ietf.org/doc/html/draft-cavage-http-signatures-12#appendix-C.3
    *)
    let id = Uri.of_string "https://example.com/actor/"
    and dgst = Some "SHA-256=X48E9qOokqqrvdts8nOJRJN3OWDUoyWxBf7kbu9DBPE="
    and date,_,_ = Ptime.of_rfc3339 "2014-01-05T22:31:40+01:00" |> Result.get_ok
    and uri = Uri.of_string "https://example.com/foo?param=value&pet=dog" in
    let key_id = Uri.with_fragment id (Some "main-key")
    and pk = match Ap.PubKeyPem.private_of_pem "data/cavage.priv.pem" with
      | Ok pk -> pk
      | _     -> failwith "ouch" in
    Http.signed_headers (key_id,Ap.PubKeyPem.sign pk,date) dgst uri
    |> Header.to_frames
    |> String.concat "\n"
    |> Assrt.equals_string __LOC__
      "host: example.com\n\
       date: Sun, 05 Jan 2014 21:31:40 GMT\n\
       digest: SHA-256=X48E9qOokqqrvdts8nOJRJN3OWDUoyWxBf7kbu9DBPE=\n\
       signature: \
       keyId=\"https://example.com/actor/#main-key\",\
       algorithm=\"rsa-sha256\",\
       headers=\"(request-target) host date digest\",\
       signature=\"WC34OEWXgO0viIZAu5qnBcKj5nOMlgjs0ASxgJPYX9x1VtKrYRRhAosH7ixFnkJneSHGn8yY9lowNvbdBg+ZsINx6P0e1WyB0YJbwsREYKYpG1sjwS3R3iCXmXf3m+txiCNhFcbbvb0Grq3wbAWGB0VW7ymI6AHixDXFLD5IYl4=\""

  (* https://datatracker.ietf.org/doc/html/rfc7235#appendix-C *)
  let test_parse_auth_params () =
    Logr.info (fun m -> m "http_test.test_parse_auth_param");
    let module P = Http.Signature.P in
    (match {|uhu|} |>  Tyre.exec (P.token |> Tyre.compile) with
     | Ok "uhu" -> "super"
     | _         -> "was anderes")
    |> Assrt.equals_string __LOC__ "super";
    (match {|"uhu"|} |>  Tyre.exec (P.quoted_string |> Tyre.compile) with
     | Ok "uhu" -> "super"
     | _     -> "was anderes")
    |> Assrt.equals_string __LOC__ "super";
    (match {|uhu="aha"|} |>  Tyre.exec (P.auth_param|> Tyre.compile) with
     | Ok ("uhu","aha") -> "super"
     | _     -> "was anderes")
    |> Assrt.equals_string __LOC__ "super";
    (match {|uhu="ah\"a"|} |>  Tyre.exec (P.auth_param|> Tyre.compile) with
     | Ok ("uhu",{|ah"a|}) -> "super"
     | _     -> "was anderes")
    |> Assrt.equals_string __LOC__ "super";
    (match {|a="A", b="B"|} |>  Tyre.exec (P.list_auth_param|> Tyre.compile) with
     | Ok [("a","A"); ("b","B")] -> "super"
     | _               -> "was anderes")
    |> Assrt.equals_string __LOC__ "super";
    (match {|a="A", nasty="na,s\"ty",b="B"|} |>  Tyre.exec (P.list_auth_param|> Tyre.compile) with
     | Ok [("a","A");
           ("nasty",{|na,s"ty|});
           ("b","B")] -> "super"
     | _               -> "was anderes")
    |> Assrt.equals_string __LOC__ "super";
    assert true

  let test_parse_signature () =
    Logr.info (fun m -> m "http_test.test_parse_signature");
    (* https://datatracker.ietf.org/doc/html/draft-cavage-http-signatures-12#section-4.1.1 *)
    let _sihe = {|keyId="rsa-key-1",algorithm="hs2019", created=1402170695, expires=1402170995, headers="(request-target) (created) (expires) host date digest content-length", signature="Base64(RSA-SHA256(signing string))"|}
                |> Http.Signature.decode in
    let _sihe = {|keyId="hmac-key-1",algorithm="hs2019",created=1402170695,headers="(request-target) (created) host digest content-length",signature="Base64(HMAC-SHA512(signing string))"|}
                |> Http.Signature.decode in
    (*
    date='Thu, 29 Jun 2023 09:51:37 GMT' digest='SHA-256=rSBxGz18uv2ZvY9PxjkuKv6ZWR78M/5S2m+yOXrq+ik=' signature='keyId="https://alpaka.social/users/traunstein#main-key",algorithm="rsa-sha256",headers="(request-target) host date digest content-type",signature="JIHBg3VahvgFweniUBfH0QSHOuilcYW313i7H6gptKT/uOSfs5QhADm7LKLZ6q7jZWtQLi4Ge8dhxVeYhGpdU5P3iABn665z3TvuUiwVUO0sGI6yAv+z9wVmFfPLFsTYOB09Fy+yht+E4Z9GOF6C/U79eb/y8QOuj1OJB3L+427IQpnJMuPh5e22LBM1E/eXLbvWyshKqX0n8WZj4qPezzsH21Afn+dUnd2jc2XqUbOpzeFkz45ut0okZAF3686/sQ0sBcloSFfvdB+EuLqZLJSYcnMe3Qe8dUpibgm5+v0XfgLZYPL2P7VpuMXkQB9neRbSCdTWojcABBwUGWV0DA=="'
    *)
    let h = [
      ("date",{|Thu, 29 Jun 2023 09:51:37 GMT|});
      ("digest",{|SHA-256=rSBxGz18uv2ZvY9PxjkuKv6ZWR78M/5S2m+yOXrq+ik=|});
      ("signature",{|keyId="https://alpaka.social/users/traunstein#main-key",algorithm="rsa-sha256",headers="(request-target) host date digest content-type",signature="JIHBg3VahvgFweniUBfH0QSHOuilcYW313i7H6gptKT/uOSfs5QhADm7LKLZ6q7jZWtQLi4Ge8dhxVeYhGpdU5P3iABn665z3TvuUiwVUO0sGI6yAv+z9wVmFfPLFsTYOB09Fy+yht+E4Z9GOF6C/U79eb/y8QOuj1OJB3L+427IQpnJMuPh5e22LBM1E/eXLbvWyshKqX0n8WZj4qPezzsH21Afn+dUnd2jc2XqUbOpzeFkz45ut0okZAF3686/sQ0sBcloSFfvdB+EuLqZLJSYcnMe3Qe8dUpibgm5+v0XfgLZYPL2P7VpuMXkQB9neRbSCdTWojcABBwUGWV0DA=="|});
    ] |> Cohttp.Header.of_list in
    let sh = "signature" |> Cohttp.Header.get h |> Option.value ~default:"-" in
    sh
    |> Assrt.equals_string __LOC__ {|keyId="https://alpaka.social/users/traunstein#main-key",algorithm="rsa-sha256",headers="(request-target) host date digest content-type",signature="JIHBg3VahvgFweniUBfH0QSHOuilcYW313i7H6gptKT/uOSfs5QhADm7LKLZ6q7jZWtQLi4Ge8dhxVeYhGpdU5P3iABn665z3TvuUiwVUO0sGI6yAv+z9wVmFfPLFsTYOB09Fy+yht+E4Z9GOF6C/U79eb/y8QOuj1OJB3L+427IQpnJMuPh5e22LBM1E/eXLbvWyshKqX0n8WZj4qPezzsH21Afn+dUnd2jc2XqUbOpzeFkz45ut0okZAF3686/sQ0sBcloSFfvdB+EuLqZLJSYcnMe3Qe8dUpibgm5+v0XfgLZYPL2P7VpuMXkQB9neRbSCdTWojcABBwUGWV0DA=="|};
    (match sh |> Http.Signature.decode
     (* Http.Signature.decode *) with
    | Ok sh ->
      sh |> List.length |> Assrt.equals_int __LOC__ 4;
      List.assoc_opt "keyId" sh |> Option.value ~default:"-"
      |> Assrt.equals_string __LOC__ "https://alpaka.social/users/traunstein#main-key";
      List.assoc_opt "algorithm" sh |> Option.value ~default:"-"
      |> Assrt.equals_string __LOC__ "rsa-sha256";
      List.assoc_opt "headers" sh |> Option.value ~default:"-"
      |> Assrt.equals_string __LOC__ "(request-target) host date digest content-type";
      List.assoc_opt "signature" sh |> Option.value ~default:"-"
      |> Assrt.equals_string __LOC__ "JIHBg3VahvgFweniUBfH0QSHOuilcYW313i7H6gptKT/uOSfs5QhADm7LKLZ6q7jZWtQLi4Ge8dhxVeYhGpdU5P3iABn665z3TvuUiwVUO0sGI6yAv+z9wVmFfPLFsTYOB09Fy+yht+E4Z9GOF6C/U79eb/y8QOuj1OJB3L+427IQpnJMuPh5e22LBM1E/eXLbvWyshKqX0n8WZj4qPezzsH21Afn+dUnd2jc2XqUbOpzeFkz45ut0okZAF3686/sQ0sBcloSFfvdB+EuLqZLJSYcnMe3Qe8dUpibgm5+v0XfgLZYPL2P7VpuMXkQB9neRbSCdTWojcABBwUGWV0DA=="
    | _ -> "fail" |> Assrt.equals_string __LOC__ "");
    assert true

  let test_verify_basic () =
    Logr.info (fun m -> m "http_test.test_verify_basic");
    let pub = "data/cavage.pub.pem" |> File.to_string |> Ap.PubKeyPem.of_pem |> Result.get_ok in
    let request = Some("post", Uri.of_string "/foo?param=value&pet=dog") in
    let h = [
      ("some", "bogus");
      ("date", {|Sun, 05 Jan 2014 21:31:40 GMT|});
      ("signature", {|keyId="Test",algorithm="rsa-sha256",headers="(request-target) host date",signature="qdx+H7PHHDZgy4y/Ahn9Tny9V3GP6YgBPyUXMmoxWtLbHpUnXS2mg2+SbrQDMCJypxBLSPQR2aAjn7ndmw2iicw3HMbe8VfEdKFYRqzic+efkb3nndiv/x1xSHDJWeSWkx3ButlYSuBskLu6kd9Fswtemr3lgdDEmn04swr2Os0="|});
      ("more", "bogus");
      ("host", {|example.com|});
    ] |> Cohttp.Header.of_list in
    (* fetch http header values and map from lowercase plus the special name (request-target) *)
    let hdr = Cohttp.Header.get h in
    (* take a list of header names and fetch them incl. values. *)
    let hdrs =
      List.fold_left
        (fun init k ->
           (match hdr k with
            | None   -> init
            | Some v -> Cohttp.Header.add init k v)
        )
        (Cohttp.Header.init ()) in


    let foo () =
      Logr.debug (fun m -> m "%s.%s get & parse the signature header" "Ap.Inbox" "post");
      let ( let* ) = Result.bind in
      let* si_v = "signature" |> hdr |> Option.to_result ~none:Http.s502' in
      let* si_v = si_v
                  |> Http.Signature.decode
                  |> Result.map_error
                    (function
                      | `NoMatch _
                      | `ConverterFailure _ ->
                        Logr.debug (fun m -> m "%s.%s Signature parsing failure" "Ap.Inbox" "post");
                        Http.s502') in
      let* algo = si_v |> List.assoc_opt "algorithm" |> Option.to_result ~none:Http.s502' in
      let* heads = si_v |> List.assoc_opt "headers" |> Option.to_result ~none:Http.s502' in
      let  heads = heads |> String.split_on_char ' ' in
      let* keyid = si_v |> List.assoc_opt "keyId" |> Option.to_result ~none:Http.s502' in
      let  _keyid = keyid |> Uri.of_string in
      let* sign = si_v |> List.assoc_opt "signature" |> Option.to_result ~none:Http.s502' in
      let sign = sign |> Base64.decode_exn |> Cstruct.of_string in

      Logr.debug (fun m -> m "%s.%s fetch the remote actor profile & key" "Ap.Inbox" "post");

      Logr.debug (fun m -> m "%s.%s get the verified header values, signature algorithm %s" "Ap.Inbox" "post" algo);
      let uuid = Uuidm.v `V4 in
      let heads = heads |> hdrs in
      let* _ = heads
               |> Http.Signature.to_sign_string ~request
               |> Cstruct.of_string
               |> Ap.PubKeyPem.verify ~uuid ~algo pub sign
               |> Result.map_error (fun (`Msg e) ->
                   Logr.warn (fun m -> m "%s.%s %s" "Ap.Inbox" "post" e);
                   Http.s502') in
      Ok heads
    in
    let v l n = Cohttp.Header.get l n |> Option.value ~default:"?" in
    (match foo () with
     | Error _ -> "aua" |> Assrt.equals_string __LOC__ "-"
     | Ok h->
       h |> Cohttp.Header.to_list |> List.length |> Assrt.equals_int __LOC__ 2;
       "date" |> v h |> Assrt.equals_string __LOC__ "Sun, 05 Jan 2014 21:31:40 GMT";
       "host" |> v h |> Assrt.equals_string __LOC__ "example.com");
    assert true
end

let () =
  Logr.info (fun m -> m "http_test");
  Unix.chdir "../../../test/";
  test_relpa ();
  test_uri ();
  Request.test_uri ();
  Request.test_query_string ();
  Cookie.test_rfc1123 ();
  Cookie.test_to_string ();
  Cookie.test_of_string ();
  Form.test_of_channel ();
  Form.test_to_html ();
  Form.test_from_html ();
  Form.test_from_html1 ();
  Header.test_headers ();
  Header.test_signature ();
  Header.test_to_sign_string_basic ();
  Header.test_sign_basic ();
  Header.test_sign_all_headers ();
  Header.test_signed_headers ();
  Header.test_parse_auth_params ();
  Header.test_parse_signature ();
  Header.test_verify_basic ();
  assert true