seppo/test/t_http.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 Alcotest
open Seppo_lib

let set_up () =
  Mirage_crypto_rng_unix.use_default ();
  Unix.chdir "../../../test/"


let tc_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 base = Uri.of_string "a/b/" in
  Uri.resolve "" base (Uri.of_string "c/d/") |> Uri.to_string |> check string __LOC__ "a/b/c/d/";
  Uri.resolve "" base ((Http.relpa (base |> Uri.to_string) ("a/b/c/d/")) |> Uri.of_string) |> Uri.to_string |> check string __LOC__ "a/b/c/d/";
  ()

let tc_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__ "";

  let a = Uri.of_string "https://example.com/path" in
  assert ("https://example.com/path" |> Uri.of_string |>  Uri.equal a);
  assert ("https://EXAMPLE.com/path" |> Uri.of_string |>  Uri.equal a);
  ()

let tc_rel_cd () =
  "/seppo.cgi" |> Cgi.cd_cgi_bin_twin_path |> Assrt.equals_string __LOC__ ".";
  "/sub/dir/seppo.cgi" |> Cgi.cd_cgi_bin_twin_path |> Assrt.equals_string __LOC__ ".";
  "/cgi-bin/seppo.cgi" |> Cgi.cd_cgi_bin_twin_path |> Assrt.equals_string __LOC__ "..";
  "/cgi-bin/sub/dir/seppo.cgi" |> Cgi. cd_cgi_bin_twin_path |> Assrt.equals_string __LOC__ "../../../sub/dir"

module Request = struct
  let tc_rx_script_name  () =
    let chk n fn =
      if Str.string_match Cgi.Request.rx_script_name fn 0
      then (
        fn |> Str.matched_group 5 |> Assrt.equals_string __LOC__ n;
        fn |> Str.matched_group 3 )
      else "no match"
    in
    "/seppo.cgi"             |> chk "seppo.cgi" |> Assrt.equals_string __LOC__ "/";
    "/cgi-bin/seppo.cgi"     |> chk "seppo.cgi" |> Assrt.equals_string __LOC__ "/";
    "/cgi-bin/uhu/seppo.cgi" |> chk "seppo.cgi" |> Assrt.equals_string __LOC__ "/uhu/";
    "/apchk.cgi"             |> chk "apchk.cgi" |> Assrt.equals_string __LOC__ "/";
    "/cgi-bin/uhu/apchk.cgi" |> chk "apchk.cgi" |> Assrt.equals_string __LOC__ "/uhu/";
    ()

  let tc_uri () =
    let 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 |> Cgi.Request.abs |> Uri.to_string |> Assrt.equals_string __LOC__ "https://example.com/sub/seppo.cgi/shaarli?post=uhu";
    r |> Cgi.Request.path_and_query |> Uri.to_string |> Assrt.equals_string __LOC__ "/sub/seppo.cgi/shaarli?post=uhu";
    "a" |> Assrt.equals_string __LOC__ "a";
    assert true

  let tc_base () =
    Uri.make ~scheme:"https" ~host:"example.com" ()
    |> Cgi.Request.base' "/seppo.cgi"
    |> Uri.to_string
    |> Assrt.equals_string __LOC__ "https://example.com/";
    Uri.make ~scheme:"https" ~host:"example.com" ()
    |> Cgi.Request.base' "/a/b/seppo.cgi"
    |> Uri.to_string
    |> Assrt.equals_string __LOC__ "https://example.com/a/b/";
    let 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    = "/cgi-bin/sub/seppo.cgi";
      server_port    = "443";
      raw_string     = Sys.getenv_opt
    } in
    r |> Cgi.Request.base
    |> Uri.to_string
    |> Assrt.equals_string __LOC__ "https://example.com/sub/";
    {r with script_name = "/sib/seppo.cgi"}
    |> Cgi.Request.base
    |> Uri.to_string
    |> Assrt.equals_string __LOC__ "https://example.com/sib/";
    {r with script_name = "/seppo.cgi"}
    |> Cgi.Request.base
    |> Uri.to_string
    |> Assrt.equals_string __LOC__ "https://example.com/";
    ()

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

module Cookie = struct
  let tc_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 tc_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 tc_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 Header = struct
  let tc_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 tc_sig_encode () =
    [ "k1","v1";
      "k2","v2"; ] |> Http.Signature.encode
    |> check string __LOC__ {|k1="v1",k2="v2"|};
    `GET
    |> Cohttp.Code.string_of_method
    |> Astring.String.map Astring.Char.Ascii.lowercase
    |> check string __LOC__ "get"

  let tc_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' = si
              |> Http.Signature.decode
              |> Result.get_ok in
    si' |> List.length |> Assrt.equals_int __LOC__ 4;
    si'
    |> Tyre.eval Http.Signature.P.list_auth_param
    |> check string __LOC__ si

  let priv_key_cavage =
    {|-----BEGIN RSA PRIVATE KEY-----
MIICXgIBAAKBgQDCFENGw33yGihy92pDjZQhl0C36rPJj+CvfSC8+q28hxA161QF
NUd13wuCTUcq0Qd2qsBe/2hFyc2DCJJg0h1L78+6Z4UMR7EOcpfdUE9Hf3m/hs+F
UR45uBJeDK1HSFHD8bHKD6kv8FPGfJTotc+2xjJwoYi+1hqp1fIekaxsyQIDAQAB
AoGBAJR8ZkCUvx5kzv+utdl7T5MnordT1TvoXXJGXK7ZZ+UuvMNUCdN2QPc4sBiA
QWvLw1cSKt5DsKZ8UETpYPy8pPYnnDEz2dDYiaew9+xEpubyeW2oH4Zx71wqBtOK
kqwrXa/pzdpiucRRjk6vE6YY7EBBs/g7uanVpGibOVAEsqH1AkEA7DkjVH28WDUg
f1nqvfn2Kj6CT7nIcE3jGJsZZ7zlZmBmHFDONMLUrXR/Zm3pR5m0tCmBqa5RK95u
412jt1dPIwJBANJT3v8pnkth48bQo/fKel6uEYyboRtA5/uHuHkZ6FQF7OUkGogc
mSJluOdc5t6hI1VsLn0QZEjQZMEOWr+wKSMCQQCC4kXJEsHAve77oP6HtG/IiEn7
kpyUXRNvFsDE0czpJJBvL/aRFUJxuRK91jhjC68sA7NsKMGg5OXb5I5Jj36xAkEA
gIT7aFOYBFwGgQAQkWNKLvySgKbAZRTeLBacpHMuQdl1DfdntvAyqpAZ0lY0RKmW
G6aFKaqQfOXKCyWoUiVknQJAXrlgySFci/2ueKlIE1QqIiLSZ8V8OlpFLRnb1pzI
7U1yQXnTAEFYM560yJlzUpOb1V4cScGd365tiSMvxLOvTA==
-----END RSA PRIVATE KEY-----
|}
    |> X509.Private_key.decode_pem |> Result.get_ok

  let pub_key_cavage =
    {|-----BEGIN PUBLIC KEY-----
MIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQDCFENGw33yGihy92pDjZQhl0C3
6rPJj+CvfSC8+q28hxA161QFNUd13wuCTUcq0Qd2qsBe/2hFyc2DCJJg0h1L78+6
Z4UMR7EOcpfdUE9Hf3m/hs+FUR45uBJeDK1HSFHD8bHKD6kv8FPGfJTotc+2xjJw
oYi+1hqp1fIekaxsyQIDAQAB
-----END PUBLIC KEY-----
|}
    |> X509.Public_key.decode_pem |> Result.get_ok

  let tc_sign2 () =
    `GET |> Cohttp.Code.string_of_method |> check string __LOC__ "GET";
    let n,s = ["date","today";
               "digest","SHA256=0815"]
              |> Http.Signature.to_sign_string
                `GET
                ("https://example.com/uhu?foo=bar#baz" |> Uri.of_string) in
    n |> check string __LOC__ "(request-target) host date digest";
    s |> check string __LOC__ "(request-target): get /uhu?foo=bar\nhost: example.com\ndate: today\ndigest: SHA256=0815";
    ["host","example.com";
     "date","today";
     "digest","SHA256=0815"]
    |> Http.Signature.add
      priv_key_cavage
      `GET
      ("https://example.com/uhu?foo=bar#baz" |> Uri.of_string)
    |> Result.get_ok
    |> Cohttp.Header.of_list
    |> Cohttp.Header.to_frames |> Astring.String.concat ~sep:"\n"
    |> check string __LOC__ {|host: example.com
date: today
digest: SHA256=0815
signature: algorithm="rsa-sha256",headers="(request-target) host date digest",signature="AFq6XChsi63zuCVVzeVigx7BV/HzHnsg304i9uqJ44t2QufQ4WvYS1jDh2B539B3VyBQiuXoiNrSssMoShVORmZzA1y4dnnFlYncFdQRsRDRA//E2YB39ECSby0Fl6pBK+Ws/090RWcxFxTBFsD0H9JQuVASbBCDxy2lhHTFugg="|}

  let tc_to_sign_string_basic () =
    let open Cohttp in
    let uri = Uri.of_string "/foo?param=value&pet=dog" in
    [
      "host", "example.com" ;
      "date", "Sun, 05 Jan 2014 21:31:40 GMT" ;
    ]
    |> Header.of_list
    |> Http.Signature.to_sign_string0 ~request:(Some (`POST,uri))
    |> 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 tc_sign_basic () =
    Logr.info (fun m -> m "http_test.test_sign_basic");
    let pk = priv_key_cavage 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 s = h |> Http.Signature.to_sign_string0 ~request:(Some (`POST,uri)) 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 |> Ap.PubKeyPem.sign pk in
    al |> Assrt.equals_string __LOC__ "rsa-sha256";
    si |> Base64.encode_exn |> Assrt.equals_string __LOC__ sig_;

    Logr.info (fun m -> m "http_test.test_sign_basic II");
    let pub = pub_key_cavage in
    (match Ap.PubKeyPem.verify ~algo:"rsa-sha256" ~inbox:Uri.empty ~key:pub ~signature:si s 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 tc_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 = priv_key_cavage in
    let al,si = h
                |> Header.to_frames
                |> String.concat "\n"
                |> Ap.PubKeyPem.sign pk
    in
    (*  |> Assrt.equals_string __LOC__
          "vSdrb+dS3EceC9bcwHSo4MlyKS59iFIrhgYkz8+oVLEEzmYZZvRs8rgOp+63LEM3v+MFHB32NfpB2bEKBIvB1q52LaEUHFv120V01IL+TAD48XaERZFukWgHoBTLMhYS2Gb51gWxpeIq8knRmPnYePbF5MOkR0Zkly4zKH7s1dE="
    *)
    al |> Assrt.equals_string __LOC__ "rsa-sha256";
    si |> Base64.encode_exn |> Assrt.equals_string __LOC__
      "nAkCW0wg9AbbStQRLi8fsS1mPPnA6S5+/0alANcoDFG9hG0bJ8NnMRcB1Sz1eccNMzzLEke7nGXqoiJYZFfT81oaRqh/MNFwQVX4OZvTLZ5xVZQuchRkOSO7b2QX0aFWFOUq6dnwAyliHrp6w3FOxwkGGJPaerw2lOYLdC/Bejk="

  let tc_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 = priv_key_cavage in
    Http.signed_headers (key_id,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 tc_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 tc_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 tc_verify_basic () =
    Logr.info (fun m -> m "http_test.test_verify_basic");
    let pub = pub_key_cavage 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 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 heads = heads |> hdrs in
      let* _ = heads
               |> Http.Signature.to_sign_string0 ~request:(Some (`POST,Uri.of_string "/foo?param=value&pet=dog"))
               |> Ap.PubKeyPem.verify ~algo ~inbox:Uri.empty ~key:pub ~signature: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

  let tc_verify_hs2019_raw () =
      (*
2024-09-16T14:26:45.455+02:00 DEBUG Is2s.Inbox.post ba111224-c9b7-4c56-ae48-82f04795f23e Signature: keyId="https://gotosocial.dev.seppo.social/users/demo/main-key",algorithm="hs2019",headers="(request-target) host date digest",signature="MG9tIV9rWJHDFKEFGsjakYoBtPjZbyk/ddTn6Xr2xHkmTVZDmkJmGcD4yDfWfQ4m8BYS+jd4lnb8O5fdm/pFwpFDGU70IDLsg6INGxZJQKuWbQB7dFEBJt22h8GcjOIlXvw4cKsgc3KvplIjTrFlnYiQQVvcSy+uQRXJTJTm2Y6vxOQzFvSJa0S8lXz5+x/CqpqXJtj1cSztEHZEFdBla2M30smV1uJvQcfa+lIRPwXdwtL0COsg8J00hAYBoFXPo+4N/jytArkYOFz6MasUrRODURuAE2fR6JI2aAerBy0WFE17TyWuXjWlnYt6t9aO5Wzo/qc/3DgMWHQr8NZGVg=="
2024-09-16T14:26:45.608+02:00 DEBUG Is2s.Inbox.post signature check '(request-target): post /2024-03-19/seppo.cgi/activitypub/inbox.jsa
host: dev.seppo.social
date: Mon, 16 Sep 2024 12:26:45 GMT
digest: SHA-256=bcLAcfJg/048pSOMeA29j/PqW2iQJw96mT+egmjF+Zk='
      *)
    let h = [
      ("host", {|dev.seppo.social|});
      ("date", {|Mon, 16 Sep 2024 12:26:45 GMT|});
      ("signature", {|keyId="https://gotosocial.dev.seppo.social/users/demo/main-key",algorithm="hs2019",headers="(request-target) host date digest",signature="MG9tIV9rWJHDFKEFGsjakYoBtPjZbyk/ddTn6Xr2xHkmTVZDmkJmGcD4yDfWfQ4m8BYS+jd4lnb8O5fdm/pFwpFDGU70IDLsg6INGxZJQKuWbQB7dFEBJt22h8GcjOIlXvw4cKsgc3KvplIjTrFlnYiQQVvcSy+uQRXJTJTm2Y6vxOQzFvSJa0S8lXz5+x/CqpqXJtj1cSztEHZEFdBla2M30smV1uJvQcfa+lIRPwXdwtL0COsg8J00hAYBoFXPo+4N/jytArkYOFz6MasUrRODURuAE2fR6JI2aAerBy0WFE17TyWuXjWlnYt6t9aO5Wzo/qc/3DgMWHQr8NZGVg=="|});
      ("digest", {|SHA-256=bcLAcfJg/048pSOMeA29j/PqW2iQJw96mT+egmjF+Zk=|});
    ] |> Cohttp.Header.of_list in
    let pay =  h |> Http.Signature.to_sign_string0
                 ~request:(Some (`POST,
                                 "https://dev.seppo.social/2024-03-19/seppo.cgi/activitypub/inbox.jsa" |> Uri.of_string)) in
    pay |> Assrt.equals_string __LOC__ {|(request-target): post /2024-03-19/seppo.cgi/activitypub/inbox.jsa
host: dev.seppo.social
date: Mon, 16 Sep 2024 12:26:45 GMT
signature: keyId="https://gotosocial.dev.seppo.social/users/demo/main-key",algorithm="hs2019",headers="(request-target) host date digest",signature="MG9tIV9rWJHDFKEFGsjakYoBtPjZbyk/ddTn6Xr2xHkmTVZDmkJmGcD4yDfWfQ4m8BYS+jd4lnb8O5fdm/pFwpFDGU70IDLsg6INGxZJQKuWbQB7dFEBJt22h8GcjOIlXvw4cKsgc3KvplIjTrFlnYiQQVvcSy+uQRXJTJTm2Y6vxOQzFvSJa0S8lXz5+x/CqpqXJtj1cSztEHZEFdBla2M30smV1uJvQcfa+lIRPwXdwtL0COsg8J00hAYBoFXPo+4N/jytArkYOFz6MasUrRODURuAE2fR6JI2aAerBy0WFE17TyWuXjWlnYt6t9aO5Wzo/qc/3DgMWHQr8NZGVg=="
digest: SHA-256=bcLAcfJg/048pSOMeA29j/PqW2iQJw96mT+egmjF+Zk=|};
    let signature = "signature"
                    |> Cohttp.Header.get h
                    |> Option.value ~default:"ouch"
                    |> Http.Signature.decode
                    |> Result.get_ok
                    |> List.assoc "signature" in
    signature |> check string __LOC__ {|MG9tIV9rWJHDFKEFGsjakYoBtPjZbyk/ddTn6Xr2xHkmTVZDmkJmGcD4yDfWfQ4m8BYS+jd4lnb8O5fdm/pFwpFDGU70IDLsg6INGxZJQKuWbQB7dFEBJt22h8GcjOIlXvw4cKsgc3KvplIjTrFlnYiQQVvcSy+uQRXJTJTm2Y6vxOQzFvSJa0S8lXz5+x/CqpqXJtj1cSztEHZEFdBla2M30smV1uJvQcfa+lIRPwXdwtL0COsg8J00hAYBoFXPo+4N/jytArkYOFz6MasUrRODURuAE2fR6JI2aAerBy0WFE17TyWuXjWlnYt6t9aO5Wzo/qc/3DgMWHQr8NZGVg==|};
    let signature = signature
                    |> Base64.decode_exn in
    let pe = {|{"@context":["https://www.w3.org/ns/activitystreams","http://schema.org","http://joinmastodon.org/ns","https://w3id.org/security/v1"],"attachment":[{"name":"reason","type":"PropertyValue","value":"\u003ca href=\"https://seppo.social/issues/13\" rel=\"nofollow noreferrer noopener\" target=\"_blank\"\u003ehttps://seppo.social/issues/13\u003c/a\u003e"},{"name":"2","type":"PropertyValue","value":"b"},{"name":"3","type":"PropertyValue","value":"c"},{"name":"4","type":"PropertyValue","value":"d"}],"discoverable":false,"featured":"https://gotosocial.dev.seppo.social/users/demo/collections/featured","followers":"https://gotosocial.dev.seppo.social/users/demo/followers","following":"https://gotosocial.dev.seppo.social/users/demo/following","id":"https://gotosocial.dev.seppo.social/users/demo","inbox":"https://gotosocial.dev.seppo.social/users/demo/inbox","manuallyApprovesFollowers":true,"name":"slöth","outbox":"https://gotosocial.dev.seppo.social/users/demo/outbox","preferredUsername":"demo","publicKey":{"id":"https://gotosocial.dev.seppo.social/users/demo/main-key","owner":"https://gotosocial.dev.seppo.social/users/demo","publicKeyPem":"-----BEGIN PUBLIC KEY-----\nMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAxaVct4ctlG5ssph8+Qiu\ncV3/mtoTGE3nyl+9eTUaIvqdgcedIvDrAqJ4Koj6JEFMTjHpJYBvWXWhR7QEuYZJ\n3HUjcZozxh40zCOosu841uvoIGEDq75xHRKhFRC38RBo7PRhAjqqCYgfkt7AERmw\nJBA1BF2EAPI5i5mjo2IPZzAJdByweVZoo5Wo3Ki3utF3oPXZRnuHmtLbphdJxZTD\n9MXfaZLG6sfuzv+Og7O6AninawBmYFz60d8GwfaBOKi8ftbnheh04BGir+jgE02m\nWNgdMWOBM9D0D3+kmZ2+m+rACQCT9D500EtMWZSn4ZBDQxUkLLbXrZJt5/fDRur7\nQQIDAQAB\n-----END PUBLIC KEY-----\n"},"summary":"\u003cp\u003e\u003ca href=\"https://seppo.social/issues/13\" rel=\"nofollow noreferrer noopener\" target=\"_blank\"\u003ehttps://seppo.social/issues/13\u003c/a\u003e\u003c/p\u003e","tag":[],"type":"Person","url":"https://gotosocial.dev.seppo.social/@demo"}|}
             |> Ezjsonm.from_string
             |> As2_vocab.Decode.person
             |> Result.get_ok in
    let pub = pe.public_key.pem |> Ap.PubKeyPem.of_pem |> Result.get_ok in
    let `Msg e = X509.Public_key.verify
        `SHA256
        ~scheme:`RSA_PKCS1
        ~signature
        pub
        (`Message pay)
                 |> Result.get_error in
    e |> check string __LOC__ "bad signature"

  let tc_verify_hs2019 () =
      (*
2024-09-16T14:26:45.455+02:00 DEBUG Is2s.Inbox.post ba111224-c9b7-4c56-ae48-82f04795f23e Signature: keyId="https://gotosocial.dev.seppo.social/users/demo/main-key",algorithm="hs2019",headers="(request-target) host date digest",signature="MG9tIV9rWJHDFKEFGsjakYoBtPjZbyk/ddTn6Xr2xHkmTVZDmkJmGcD4yDfWfQ4m8BYS+jd4lnb8O5fdm/pFwpFDGU70IDLsg6INGxZJQKuWbQB7dFEBJt22h8GcjOIlXvw4cKsgc3KvplIjTrFlnYiQQVvcSy+uQRXJTJTm2Y6vxOQzFvSJa0S8lXz5+x/CqpqXJtj1cSztEHZEFdBla2M30smV1uJvQcfa+lIRPwXdwtL0COsg8J00hAYBoFXPo+4N/jytArkYOFz6MasUrRODURuAE2fR6JI2aAerBy0WFE17TyWuXjWlnYt6t9aO5Wzo/qc/3DgMWHQr8NZGVg=="
2024-09-16T14:26:45.608+02:00 DEBUG Is2s.Inbox.post signature check '(request-target): post /2024-03-19/seppo.cgi/activitypub/inbox.jsa
host: dev.seppo.social
date: Mon, 16 Sep 2024 12:26:45 GMT
digest: SHA-256=bcLAcfJg/048pSOMeA29j/PqW2iQJw96mT+egmjF+Zk='
      *)
    let act = {|{"@context":["https://www.w3.org/ns/activitystreams","http://schema.org","http://joinmastodon.org/ns","https://w3id.org/security/v1"],"attachment":[{"name":"reason","type":"PropertyValue","value":"\u003ca href=\"https://seppo.social/issues/13\" rel=\"nofollow noreferrer noopener\" target=\"_blank\"\u003ehttps://seppo.social/issues/13\u003c/a\u003e"},{"name":"2","type":"PropertyValue","value":"b"},{"name":"3","type":"PropertyValue","value":"c"},{"name":"4","type":"PropertyValue","value":"d"}],"discoverable":false,"featured":"https://gotosocial.dev.seppo.social/users/demo/collections/featured","followers":"https://gotosocial.dev.seppo.social/users/demo/followers","following":"https://gotosocial.dev.seppo.social/users/demo/following","id":"https://gotosocial.dev.seppo.social/users/demo","inbox":"https://gotosocial.dev.seppo.social/users/demo/inbox","manuallyApprovesFollowers":true,"name":"slöth","outbox":"https://gotosocial.dev.seppo.social/users/demo/outbox","preferredUsername":"demo","publicKey":{"id":"https://gotosocial.dev.seppo.social/users/demo/main-key","owner":"https://gotosocial.dev.seppo.social/users/demo","publicKeyPem":"-----BEGIN PUBLIC KEY-----\nMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAxaVct4ctlG5ssph8+Qiu\ncV3/mtoTGE3nyl+9eTUaIvqdgcedIvDrAqJ4Koj6JEFMTjHpJYBvWXWhR7QEuYZJ\n3HUjcZozxh40zCOosu841uvoIGEDq75xHRKhFRC38RBo7PRhAjqqCYgfkt7AERmw\nJBA1BF2EAPI5i5mjo2IPZzAJdByweVZoo5Wo3Ki3utF3oPXZRnuHmtLbphdJxZTD\n9MXfaZLG6sfuzv+Og7O6AninawBmYFz60d8GwfaBOKi8ftbnheh04BGir+jgE02m\nWNgdMWOBM9D0D3+kmZ2+m+rACQCT9D500EtMWZSn4ZBDQxUkLLbXrZJt5/fDRur7\nQQIDAQAB\n-----END PUBLIC KEY-----\n"},"summary":"\u003cp\u003e\u003ca href=\"https://seppo.social/issues/13\" rel=\"nofollow noreferrer noopener\" target=\"_blank\"\u003ehttps://seppo.social/issues/13\u003c/a\u003e\u003c/p\u003e","tag":[],"type":"Person","url":"https://gotosocial.dev.seppo.social/@demo"}|} in
    let pe = act |> Ezjsonm.from_string |> As2_vocab.Decode.person |> Result.get_ok in
    let pub = pe.public_key.pem |> Ap.PubKeyPem.of_pem |> Result.get_ok in
    let h = [
      ("host", {|dev.seppo.social|});
      ("date", {|Mon, 16 Sep 2024 12:26:45 GMT|});
      ("signature", {|keyId="https://gotosocial.dev.seppo.social/users/demo/main-key",algorithm="hs2019",headers="(request-target) host date digest",signature="MG9tIV9rWJHDFKEFGsjakYoBtPjZbyk/ddTn6Xr2xHkmTVZDmkJmGcD4yDfWfQ4m8BYS+jd4lnb8O5fdm/pFwpFDGU70IDLsg6INGxZJQKuWbQB7dFEBJt22h8GcjOIlXvw4cKsgc3KvplIjTrFlnYiQQVvcSy+uQRXJTJTm2Y6vxOQzFvSJa0S8lXz5+x/CqpqXJtj1cSztEHZEFdBla2M30smV1uJvQcfa+lIRPwXdwtL0COsg8J00hAYBoFXPo+4N/jytArkYOFz6MasUrRODURuAE2fR6JI2aAerBy0WFE17TyWuXjWlnYt6t9aO5Wzo/qc/3DgMWHQr8NZGVg=="|});
      ("digest", {|SHA-256=bcLAcfJg/048pSOMeA29j/PqW2iQJw96mT+egmjF+Zk=|});
    ] |> Cohttp.Header.of_list in
    h |> Http.Signature.to_sign_string0 ~request:(Some (`POST,"/" |> Uri.of_string))
    |> Assrt.equals_string __LOC__ {|(request-target): post /
host: dev.seppo.social
date: Mon, 16 Sep 2024 12:26:45 GMT
signature: keyId="https://gotosocial.dev.seppo.social/users/demo/main-key",algorithm="hs2019",headers="(request-target) host date digest",signature="MG9tIV9rWJHDFKEFGsjakYoBtPjZbyk/ddTn6Xr2xHkmTVZDmkJmGcD4yDfWfQ4m8BYS+jd4lnb8O5fdm/pFwpFDGU70IDLsg6INGxZJQKuWbQB7dFEBJt22h8GcjOIlXvw4cKsgc3KvplIjTrFlnYiQQVvcSy+uQRXJTJTm2Y6vxOQzFvSJa0S8lXz5+x/CqpqXJtj1cSztEHZEFdBla2M30smV1uJvQcfa+lIRPwXdwtL0COsg8J00hAYBoFXPo+4N/jytArkYOFz6MasUrRODURuAE2fR6JI2aAerBy0WFE17TyWuXjWlnYt6t9aO5Wzo/qc/3DgMWHQr8NZGVg=="
digest: SHA-256=bcLAcfJg/048pSOMeA29j/PqW2iQJw96mT+egmjF+Zk=|};
    let si = "signature"
             |> Cohttp.Header.get h |> Option.value ~default:"ouch"
             |> Http.Signature.decode
             |> Result.get_ok in
    si |> List.length |> check int __LOC__ 4;
    si |> List.assoc "keyId" |> check string __LOC__ "https://gotosocial.dev.seppo.social/users/demo/main-key";
    si |> List.assoc "algorithm" |> check string __LOC__ "hs2019";
    let sign = si |> List.assoc "signature"  |> Base64.decode_exn in
    let inbox = "/" |> Uri.of_string in
    let `Msg m = h
                 |> Http.Signature.to_sign_string0 ~request:(Some (`GET,Uri.empty))
                 |> Ap.PubKeyPem.verify ~algo:"hs2019" ~inbox ~key:pub ~signature:sign
                 |> Result.get_error in
    m |> check string __LOC__ "bad signature"

  (* also https://datatracker.ietf.org/doc/id/draft-richanna-http-message-signatures-00.html#section-a.3

     2024-10-03T00:14:44.022+02:00 DEBUG Is2s.Inbox.post 837a994a-754b-49bd-9154-982603e3dcc7 Signature: keyId="https://gotosocial.dev.seppo.social/users/demo/main-key",algorithm="hs2019",headers="(request-target) host date digest",signature="HCnGYTDX+xfmuUysOGBN//mqInBv//55S/1NRZ+vEqMZxIgu7QsmUB/I7MfeM3PyF1oZDZ5cngsLPmuSjBVnQkAOJIebybNsh9HyLT5Ln4UDyiY30AZVuX+tNz0K5eGmnxS9LFPyfihvrnYZN+2Irny5mCPkB61u8TTmjYKG/WTLKrVhf49fwNt6U11zq7xkVkB8NT6VllH4tftx/GpfqvdCl+FA+UrtKu6GyHBQMmsEz7ybcVXhF04K8z95X2nM/I/pfmQ/b2ySpzX3YwL0UlVrFI44fq7zXIvpkKT3ntg66z3xluuhBL3y2amzty6Ciz/evcJcq6JpaVJ2jTNO5Q=="
     2024-10-03T00:14:44.205+02:00 DEBUG Is2s.Inbox.post signature check '(request-target): post /2024-03-19/seppo.cgi/activitypub/inbox.jsa
     host: mx250.darknet.mro.name
     date: Wed, 02 Oct 2024 22:14:43 GMT
     digest: SHA-256=DpWuW0JAXqss/tShNxYG7NmD+o18Ok7lNDvHRD0vbcU='
  *)
  let tc_verify_hs2019_b () =
    let signature = {|HCnGYTDX+xfmuUysOGBN//mqInBv//55S/1NRZ+vEqMZxIgu7QsmUB/I7MfeM3PyF1oZDZ5cngsLPmuSjBVnQkAOJIebybNsh9HyLT5Ln4UDyiY30AZVuX+tNz0K5eGmnxS9LFPyfihvrnYZN+2Irny5mCPkB61u8TTmjYKG/WTLKrVhf49fwNt6U11zq7xkVkB8NT6VllH4tftx/GpfqvdCl+FA+UrtKu6GyHBQMmsEz7ybcVXhF04K8z95X2nM/I/pfmQ/b2ySpzX3YwL0UlVrFI44fq7zXIvpkKT3ntg66z3xluuhBL3y2amzty6Ciz/evcJcq6JpaVJ2jTNO5Q==|}
                    |> Base64.decode_exn
    and key = {|-----BEGIN PUBLIC KEY-----
MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAxaVct4ctlG5ssph8+Qiu
cV3/mtoTGE3nyl+9eTUaIvqdgcedIvDrAqJ4Koj6JEFMTjHpJYBvWXWhR7QEuYZJ
3HUjcZozxh40zCOosu841uvoIGEDq75xHRKhFRC38RBo7PRhAjqqCYgfkt7AERmw
JBA1BF2EAPI5i5mjo2IPZzAJdByweVZoo5Wo3Ki3utF3oPXZRnuHmtLbphdJxZTD
9MXfaZLG6sfuzv+Og7O6AninawBmYFz60d8GwfaBOKi8ftbnheh04BGir+jgE02m
WNgdMWOBM9D0D3+kmZ2+m+rACQCT9D500EtMWZSn4ZBDQxUkLLbXrZJt5/fDRur7
QQIDAQAB
-----END PUBLIC KEY-----
|}
              |> X509.Public_key.decode_pem |> Result.get_ok
    and data = [ {|(request-target): post /2024-03-19/seppo.cgi/activitypub/inbox.jsa|} ;
                 {|host: mx250.darknet.mro.name|} ;
                 {|date: Wed, 02 Oct 2024 22:14:43 GMT|} ;
                 {|digest: SHA-256=DpWuW0JAXqss/tShNxYG7NmD+o18Ok7lNDvHRD0vbcU=|} ]
    in
    key |> X509.Public_key.key_type |> X509.Key_type.to_string |> check string __LOC__ "rsa";
    X509.Public_key.verify
      `SHA256
      ~scheme:`RSA_PKCS1
      ~signature
      key
      (`Message (data |> String.concat "\n"))
    |> Result.get_ok

  (* also
     https://datatracker.ietf.org/doc/id/draft-richanna-http-message-signatures-00.html#example-key-rsa-test
  *)
  let pub_key_richanna =
    {|-----BEGIN PUBLIC KEY-----
MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAhAKYdtoeoy8zcAcR874L
8cnZxKzAGwd7v36APp7Pv6Q2jdsPBRrwWEBnez6d0UDKDwGbc6nxfEXAy5mbhgaj
zrw3MOEt8uA5txSKobBpKDeBLOsdJKFqMGmXCQvEG7YemcxDTRPxAleIAgYYRjTS
d/QBwVW9OwNFhekro3RtlinV0a75jfZgkne/YiktSvLG34lw2zqXBDTC5NHROUqG
TlML4PlNZS5Ri2U4aCNx2rUPRcKIlE0PuKxI4T+HIaFpv8+rdV6eUgOrB2xeI1dS
FFn/nnv5OoZJEIB+VmuKn3DCUcCZSFlQPSXSfBDiUGhwOw76WuSSsf1D4b/vLoJ1
0wIDAQAB
-----END PUBLIC KEY-----
|}
    |> X509.Public_key.decode_pem |> Result.get_ok

  (* example from
     https://datatracker.ietf.org/doc/id/draft-richanna-http-message-signatures-00.html#name-hs2019-signature-over-minim
  *)
  let tc_verify_hs2019_richanna_minimal () =
    let signature = "e3y37nxAoeuXw2KbaIxE2d9jpE7Z9okgizg6QbD2Z7fUVUvog+ZTKKLRBnhNglVIY6fAaYlHwx7ZAXXdBVF8gjWBPL6U9zRrB4PFzjoLSxHaqsvS0ZK9FRxpenptgukaVQ1aeva3PE1aD6zZ93df2lFIFXGDefYCQ+M/SrDGQOFvaVykEkte5mO6zQZ/HpokjMKvilfSMJS+vbvC1GJItQpjs636Db+7zB2W1BurkGxtQdCLDXuIDg4S8pPSDihkch/dUzL2BpML3PXGKVXwHOUkVG6Q2ge07IYdzya6N1fIVA9eKI1Y47HT35QliVAxZgE0EZLo8mxq19ReIVvuFg=="
                    |> Base64.decode_exn
    and key = pub_key_richanna
    and data = [ {|(created): 1402170695|} ;
                 {|(request-target): post /foo?param=value&pet=dog|} ]
    in
    key |> X509.Public_key.key_type |> X509.Key_type.to_string |> check string __LOC__ "rsa";
    X509.Public_key.verify
      `SHA256
      ~scheme:`RSA_PKCS1
      ~signature
      key
      (`Message (data |> String.concat "\n"))
    |> Result.get_ok

  (* example from
     https://datatracker.ietf.org/doc/id/draft-richanna-http-message-signatures-00.html#name-create-the-signature-input
  *)
  let tc_verify_hs2019_richanna_nonn () =
    let signature = {|T1l3tWH2cSP31nfuvc3nVaHQ6IAu9YLEXg2pCeEOJETXnlWbgKtBTaXV6LNQWtf4O42V2DZwDZbmVZ8xW3TFW80RrfrY0+fyjD4OLN7/zV6L6d2v7uBpuWZ8QzKuHYFaRNVXgFBXN3VJnsIOUjv20pqZMKO3phLCKX2/zQzJLCBQvF/5UKtnJiMp1ACNhG8LF0Q0FPWfe86YZBBxqrQr5WfjMu0LOO52ZAxi9KTWSlceJ2U361gDb7S5Deub8MaDrjUEpluphQeo8xyvHBoNXsqeax/WaHyRYOgaW6krxEGVaBQAfA2czYZhEA05Tb38ahq/gwDQ1bagd9rGnCHtAg==|}
                    |> Base64.decode_exn
    and key = pub_key_richanna
    and data = {|(request-target): get /foo
(created): 1402170695
host: example.org
date: Tue, 07 Jun 2014 20:51:35 GMT
cache-control: max-age=60, must-revalidate
x-emptyheader: 
x-example: Example header with some whitespace.|}
    in
    key |> X509.Public_key.key_type |> X509.Key_type.to_string |> check string __LOC__ "rsa";
    X509.Public_key.verify
      `SHA256
      ~scheme:`RSA_PKCS1
      ~signature
      key
      (`Message data)
    |> Result.get_ok

  (* example from
     https://gts.superseriousbusiness.org/@dumpsterqueer/statuses/01J9BKYKR1W5X078ZESSAW10QS
  *)
  let tc_verify_hs2019_gotosocial () =
    let signature = {|G6X7IV+qHqOaZIrrwRxunzbRgRhzn84UoUJfsSNLveHdVBAiaY3ayoj2F4ZiDxVV6zG0CN3j+0pHbngWgHp4aMETkF/x3KB/l2ILHgBhUpIB+ZAb1MkC+yU+9BNmp8EmVZldzdjQ/MalStfeRc7rcMdL770TJbAW8cgPRPA6TB7P6m5tzEPkow56wR/W0MuYJqWQzE8id7Ri65p63fu8NFha7WgBVM5I+67hZ3sYZTBKdLQJJyS4K3nOZ20h+pUSZUGF7WdTNnxtzaryJgFVL4Or2ydBa/Jp0w8zspWFMlGCtG9A9cayQ7JHlCMiuf92f/hpLWtWCSftg9IzZVakiw==|}
                    |> Base64.decode_exn
    and key =
      "-----BEGIN PUBLIC KEY-----\nMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAy2/j9+2G7xrQvBtygrj4\naYHl8hTeZecDBnS+6IBjjEt+QWJ3z0Cv9lXSVMZw5i6DVTkVOGZrh2vZDu0BCTEV\n07dyASArE63Qe21WwjNObpkQ7YZbMxUkYjWCDYdqLMifAqElYzIK7xnY0pTWylmC\njm39qxmhk22PpzRkw+zofh9ykqyadmkA2/KrpZgGnjn6MiPqb2DeELV1tzmZ7mAz\n+k7pkkhxvBVqPhCZ104pyd1lc66obONSnIqxugRlrrUZbFv1e6xFsUmMUYrAGQTt\nZr4VeZwuaYj/MvFIeOZrmth/lg3QpYbKZYnJKVePyH+530jRSFerr2unbuGmEQAg\nvQIDAQAB\n-----END PUBLIC KEY-----\n"
      |> X509.Public_key.decode_pem |> Result.get_ok
    and data = {|(request-target): get /@mro/113244470620401979
host: digitalcourage.social
date: Fri, 04 Oct 2024 11:12:53 GMT|}
    in
    key |> X509.Public_key.key_type |> X509.Key_type.to_string |> check string __LOC__ "rsa";
    let `Msg m = X509.Public_key.verify
        `SHA256
        ~scheme:`RSA_PKCS1
        ~signature
        key
        (`Message data)
                 |> Result.get_error in
    m
    |> check string __LOC__ "bad signature"

  let tc_verify_masto430 () =
    (*

    Signature: keyId="https://bewegung.social/use
rs/mro#main-key",algorithm="rsa-sha256",headers="(request-target) host date digest content-type",signature="v2h3HUJg0vH6HyNfOHSE7hIg0O
i1E+iUEO8ahxDjI99F7jKuh9sVRSpqhsAEagI5WeWZkQyhWjRmDZZBsk4+acALo36CsRj/C/m5CiF4J0hd+x8VSPWDJEQTYclm0jCthfdmeXg1/DOZnlWInBVQdwZJZyoW7nTn
EEGZuE0w6LsYCJb2oVUTW32gn+fbHnJ2mkBwPjwBlJ7zckEx3MwnV99GPkjdA0hBX/O4xSD7a0MIn4d0CSOGmbnTGKChTm//AvKXP4L5H9L6ovZFBfaHkDCqYDbdfXGWeheLXd
gDJHubi0LFecP3PP5cwOeuFtGgkWsSeLrUEyWgSlEKjCFRhw=="

(request-target): post /2024-03-19/seppo.cgi/activitypub/inbox.jsa
(request-target): post /2024-03-19/seppo.cgi/activitypub/inbox.jsa
host: mx250.darknet.mro.name
date: Thu, 10 Oct 2024 10:12:10 GMT
digest: SHA-256=N0m+gyYe/GieNBzMEOStVqf7hq/qdmh7bqdWanZSE1o=
content-type: application/activity+json
*)
    ()


  let tc_sign_api () =
    (*
    sign != verify

    but has overlap

    constructing the signagee payload
      - keys
      - values
      - 

    signing ig

    verifying it
    *)
    (** @TODO *)
    let _list_header_get l (k : string) : string option = l |> List.assoc_opt k in
    let compute_verify_signature_payload fetcher : string =
      (match fetcher "signature" with
       | None -> Some "header not found: signature"
       | Some si ->
         match si |> Http.Signature.decode with
         | Error _ -> Some "error decoding signature"
         | Ok si ->
           match si |> List.assoc_opt "headers" with
           | None -> Some "signature field not found: headers"
           | Some v ->
             (* assert lowercase *)
             v
             |> Astring.String.cuts ~sep:" " |> List.rev |> List.fold_left 
               (fun init k -> match k |> fetcher with
                  | None -> init
                  | Some v -> (k,v) :: init) [] 
             |> Cohttp.Header.of_list
             |> Cohttp.Header.to_frames
             |> Astring.String.concat ~sep:"\n"
             |> Option.some )
      |> Option.value ~default:""
    in
    let r = {Cgi.Request.empty with 
             request_method = "POST";
             raw_string = (function
                 | "HTTP_HOST" -> Some "example.com"
                 | "HTTP_DATE" -> Some "tomorrow"
                 | "HTTP_SIGNATURE" -> Some {|keyId="Test",algorithm="rsa-sha256",headers="(request-target) host date",signature="qdx+H7PHHDZgy4y/Ahn9Tny9V3GP6YgBPyUXMmoxWtLbHpUnXS2mg2+SbrQDMCJypxBLSPQR2aAjn7ndmw2iicw3HMbe8VfEdKFYRqzic+efkb3nndiv/x1xSHDJWeSWkx3ButlYSuBskLu6kd9Fswtemr3lgdDEmn04swr2Os0="|}
                 | _ -> None)} in
    Cgi.Request.header_get r "SIGNATURE" |> Option.get
    |> Http.Signature.decode |> Result.get_ok
    |> List.assoc "headers"
    |> Astring.String.cuts ~sep:" "
    |> List.length
    |> Assrt.equals_int __LOC__ 3;
    (* typical for verify *)
    r
    |> Cgi.Request.header_get
    |> compute_verify_signature_payload
    |> Assrt.equals_string __LOC__ {|(request-target): post /
host: example.com
date: tomorrow|};
    ();
    ()
end

let () =
  run
    "seppo_suite" [
    __FILE__ , [
      "setup",                             `Quick, set_up;
      "tc_relpa",                          `Quick, tc_relpa;
      "tc_uri",                            `Quick, tc_uri;
      "tc_rel_cd",                         `Quick, tc_rel_cd;
      "tc_rx_script_name",                 `Quick, Request.tc_rx_script_name;
      "tc_uri",                            `Quick, Request.tc_uri;
      "tc_base",                           `Quick, Request.tc_base;
      "tc_query_string",                   `Quick, Request.tc_query_string;
      "tc_rfc1123",                        `Quick, Cookie.tc_rfc1123;
      "tc_to_string",                      `Quick, Cookie.tc_to_string;
      "tc_of_string",                      `Quick, Cookie.tc_of_string;
      "tc_headers",                        `Quick, Header.tc_headers;
      "tc_sig_encode",                     `Quick, Header.tc_sig_encode;
      "tc_signature",                      `Quick, Header.tc_signature;
      "tc_sign2",                          `Quick, Header.tc_sign2;
      "tc_to_sign_string_basic",           `Quick, Header.tc_to_sign_string_basic;
      "tc_sign_basic",                     `Quick, Header.tc_sign_basic;
      "tc_sign_all_headers",               `Quick, Header.tc_sign_all_headers;
      "tc_signed_headers",                 `Quick, Header.tc_signed_headers;
      "tc_parse_auth_params",              `Quick, Header.tc_parse_auth_params;
      "tc_parse_signature",                `Quick, Header.tc_parse_signature;
      "tc_verify_basic",                   `Quick, Header.tc_verify_basic;
      "tc_verify_hs2019_raw",              `Quick, Header.tc_verify_hs2019_raw;
      "tc_verify_hs2019",                  `Quick, Header.tc_verify_hs2019;
      "tc_verify_hs2019_b",                `Quick, Header.tc_verify_hs2019_b;
      "tc_verify_hs2019_richanna_minimal", `Quick, Header.tc_verify_hs2019_richanna_minimal;
      "tc_verify_hs2019_richanna_nonn",    `Quick, Header.tc_verify_hs2019_richanna_nonn;
      "tc_verify_hs2019_gotosocial",       `Quick, Header.tc_verify_hs2019_gotosocial;
      "tc_verify_masto430",                `Quick, Header.tc_verify_masto430;
      "tc_sign_api",                       `Quick, Header.tc_sign_api;
    ]
  ]