test/t_http.ml

   1 (*
   2  *    _  _   ____                         _
   3  *  _| || |_/ ___|  ___ _ __  _ __   ___ | |
   4  * |_  ..  _\___ \ / _ \ '_ \| '_ \ / _ \| |
   5  * |_      _|___) |  __/ |_) | |_) | (_) |_|
   6  *   |_||_| |____/ \___| .__/| .__/ \___/(_)
   7  *                     |_|   |_|
   8  *
   9  * Personal Social Web.
  10  *
  11  * http_test.ml
  12  *
  13  * Copyright (C) The #Seppo contributors. All rights reserved.
  14  *
  15  * This program is free software: you can redistribute it and/or modify
  16  * it under the terms of the GNU General Public License as published by
  17  * the Free Software Foundation, either version 3 of the License, or
  18  * (at your option) any later version.
  19  *
  20  * This program is distributed in the hope that it will be useful,
  21  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  22  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23  * GNU General Public License for more details.
  24  *
  25  * You should have received a copy of the GNU General Public License
  26  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  27  *)
  28
  29 open Alcotest
  30 open Seppo_lib
  31
  32 let set_up () =
  33   Mirage_crypto_rng_lwt.initialize (module Mirage_crypto_rng.Fortuna);
  34   Unix.chdir "../../../test/"
  35
  36
  37 let tc_relpa () =
  38   Http.relpa "a/b/" "a/b/d/e" |> Assrt.equals_string __LOC__ "d/e";
  39   Http.relpa "a/B/" "a/b/d/e" |> Assrt.equals_string __LOC__ "";
  40   let base = Uri.of_string "a/b/" in
  41   Uri.resolve "" base (Uri.of_string "c/d/") |> Uri.to_string |> check string __LOC__ "a/b/c/d/";
  42   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/";
  43   ()
  44
  45 let tc_uri () =
  46   let base = "https://example.com:443/a/b/c?d=e#f" |> Uri.of_string in
  47
  48   base |> Uri.path
  49   |> Assrt.equals_string __LOC__ "/a/b/c";
  50
  51   "../i.j" |> Uri.of_string |> Http.reso ~base |> Uri.to_string
  52   |> Assrt.equals_string __LOC__ "https://example.com:443/a/i.j";
  53
  54   let re = "https://example.com:443/a/b/C/d.e#ff" |> Uri.of_string |> Http.abs_to_rel ~base in
  55   re |> Uri.to_string |> Assrt.equals_string __LOC__ "C/d.e#ff";
  56
  57   Uri.make ~path:"." () |> Http.reso ~base:Uri.empty |> Uri.to_string |> Assrt.equals_string __LOC__ "";
  58
  59   let a = Uri.of_string "https://example.com/path" in
  60   assert ("https://example.com/path" |> Uri.of_string |>  Uri.equal a);
  61   assert ("https://EXAMPLE.com/path" |> Uri.of_string |>  Uri.equal a);
  62   ()
  63
  64 let tc_rel_cd () =
  65   "/seppo.cgi" |> Cgi.cd_cgi_bin_twin_path |> Assrt.equals_string __LOC__ ".";
  66   "/sub/dir/seppo.cgi" |> Cgi.cd_cgi_bin_twin_path |> Assrt.equals_string __LOC__ ".";
  67   "/cgi-bin/seppo.cgi" |> Cgi.cd_cgi_bin_twin_path |> Assrt.equals_string __LOC__ "..";
  68   "/cgi-bin/sub/dir/seppo.cgi" |> Cgi. cd_cgi_bin_twin_path |> Assrt.equals_string __LOC__ "../../../sub/dir"
  69
  70 module Request = struct
  71   let tc_rx_script_name  () =
  72     let chk n fn =
  73       if Str.string_match Cgi.Request.rx_script_name fn 0
  74       then (
  75         fn |> Str.matched_group 5 |> Assrt.equals_string __LOC__ n;
  76         fn |> Str.matched_group 3 )
  77       else "no match"
  78     in
  79     "/seppo.cgi"             |> chk "seppo.cgi" |> Assrt.equals_string __LOC__ "/";
  80     "/cgi-bin/seppo.cgi"     |> chk "seppo.cgi" |> Assrt.equals_string __LOC__ "/";
  81     "/cgi-bin/uhu/seppo.cgi" |> chk "seppo.cgi" |> Assrt.equals_string __LOC__ "/uhu/";
  82     "/apchk.cgi"             |> chk "apchk.cgi" |> Assrt.equals_string __LOC__ "/";
  83     "/cgi-bin/uhu/apchk.cgi" |> chk "apchk.cgi" |> Assrt.equals_string __LOC__ "/uhu/";
  84     ()
  85
  86   let tc_uri () =
  87     let r : Cgi.Request.t = {
  88       content_type   = "text/plain";
  89       content_length = None;
  90       host           = "example.com";
  91       http_cookie    = "";
  92       path_info      = "/shaarli";
  93       query_string   = "post=uhu";
  94       request_method = "GET";
  95       remote_addr    = "127.0.0.1";
  96       scheme         = "https";
  97       script_name    = "/sub/seppo.cgi";
  98       server_port    = "443";
  99       raw_string     = Sys.getenv_opt
 100     } in
 101     r |> Cgi.Request.abs |> Uri.to_string |> Assrt.equals_string __LOC__ "https://example.com/sub/seppo.cgi/shaarli?post=uhu";
 102     r |> Cgi.Request.path_and_query |> Uri.to_string |> Assrt.equals_string __LOC__ "/sub/seppo.cgi/shaarli?post=uhu";
 103     "a" |> Assrt.equals_string __LOC__ "a";
 104     assert true
 105
 106   let tc_base () =
 107     Uri.make ~scheme:"https" ~host:"example.com" ()
 108     |> Cgi.Request.base' "/seppo.cgi"
 109     |> Uri.to_string
 110     |> Assrt.equals_string __LOC__ "https://example.com/";
 111     Uri.make ~scheme:"https" ~host:"example.com" ()
 112     |> Cgi.Request.base' "/a/b/seppo.cgi"
 113     |> Uri.to_string
 114     |> Assrt.equals_string __LOC__ "https://example.com/a/b/";
 115     let r : Cgi.Request.t = {
 116       content_type   = "text/plain";
 117       content_length = None;
 118       host           = "example.com";
 119       http_cookie    = "";
 120       path_info      = "/shaarli";
 121       query_string   = "post=uhu";
 122       request_method = "GET";
 123       remote_addr    = "127.0.0.1";
 124       scheme         = "https";
 125       script_name    = "/cgi-bin/sub/seppo.cgi";
 126       server_port    = "443";
 127       raw_string     = Sys.getenv_opt
 128     } in
 129     r |> Cgi.Request.base
 130     |> Uri.to_string
 131     |> Assrt.equals_string __LOC__ "https://example.com/sub/";
 132     {r with script_name = "/sib/seppo.cgi"}
 133     |> Cgi.Request.base
 134     |> Uri.to_string
 135     |> Assrt.equals_string __LOC__ "https://example.com/sib/";
 136     {r with script_name = "/seppo.cgi"}
 137     |> Cgi.Request.base
 138     |> Uri.to_string
 139     |> Assrt.equals_string __LOC__ "https://example.com/";
 140     ()
 141
 142   let tc_query_string () =
 143     match "" |> Uri.query_of_encoded with
 144     | [("",[])] -> ()
 145     | _ -> "no" |> Assrt.equals_string __LOC__ ""
 146 end
 147
 148 module Cookie = struct
 149   let tc_rfc1123 () =
 150     let s = "Thu, 01 Jan 1970 00:00:00 GMT" in
 151     Ptime.epoch |> Http.to_rfc1123 |> Assrt.equals_string __LOC__ s;
 152     assert true
 153
 154   let tc_to_string () =
 155     let http_only = Some true
 156     and path = Some "seppo.cgi"
 157     and same_site = Some `Strict
 158     and max_age = Some (30. *. 60.)
 159     and secure = Some true in
 160     Cookie.to_string ?path ?secure ?http_only ?same_site ("auth_until", "2022-04-08T22:30:07Z")
 161     |> Assrt.equals_string __LOC__
 162       "auth_until=2022-04-08T22:30:07Z; Path=seppo.cgi; Secure; HttpOnly; \
 163        SameSite=Strict";
 164     Cookie.to_string ?max_age ?path ?secure ?http_only ?same_site ("auth", "yes")
 165     |> Assrt.equals_string __LOC__
 166       "auth=yes; Max-Age=1800; Path=seppo.cgi; Secure; HttpOnly; \
 167        SameSite=Strict";
 168     assert true
 169
 170   let tc_of_string () =
 171     let c = Cookie.to_string ("#Seppo!", "foo") in
 172     c |> Assrt.equals_string __LOC__ "#Seppo!=foo";
 173     let v = match c |> Cookie.of_string with
 174       | ("#Seppo!", v) :: [] -> v
 175       | _ -> assert false
 176     in
 177     v |> Assrt.equals_string __LOC__ "foo";
 178     assert true
 179 end
 180
 181
 182 module Header = struct
 183   let tc_headers () =
 184     Logr.info (fun m -> m "http_test.test_headers");
 185     let h = [ ("A", "a"); ("B", "b") ] @ [ ("C", "c") ]
 186             |> Cohttp.Header.of_list in
 187     h |> Cohttp.Header.to_string
 188     |> Assrt.equals_string __LOC__ "A: a\r\nB: b\r\nC: c\r\n\r\n";
 189     h |> Cohttp.Header.to_frames
 190     |> String.concat "\n"
 191     |> Assrt.equals_string __LOC__ "A: a\nB: b\nC: c";
 192     Cohttp.Header.get h "a"
 193     |> Option.value ~default:"-"
 194     |> Assrt.equals_string __LOC__ "a";
 195     assert true
 196
 197   let tc_sig_encode () =
 198     [ "k1","v1";
 199       "k2","v2"; ] |> Http.Signature.encode
 200     |> check string __LOC__ {|k1="v1",k2="v2"|};
 201     `GET
 202     |> Cohttp.Code.string_of_method
 203     |> Astring.String.map Astring.Char.Ascii.lowercase
 204     |> check string __LOC__ "get"
 205
 206   let tc_signature () =
 207     Logr.info (fun m -> m "http_test.test_signature");
 208     let si = {|keyId="Test",algorithm="rsa-sha256",headers="(request-target) host date",signature="qdx+H7PHHDZgy4y/Ahn9Tny9V3GP6YgBPyUXMmoxWtLbHpUnXS2mg2+SbrQDMCJypxBLSPQR2aAjn7ndmw2iicw3HMbe8VfEdKFYRqzic+efkb3nndiv/x1xSHDJWeSWkx3ButlYSuBskLu6kd9Fswtemr3lgdDEmn04swr2Os0="|} in
 209     let si' = si
 210               |> Http.Signature.decode
 211               |> Result.get_ok in
 212     si' |> List.length |> Assrt.equals_int __LOC__ 4;
 213     si'
 214     |> Tyre.eval Http.Signature.P.list_auth_param
 215     |> check string __LOC__ si
 216
 217   let priv_key_cavage =
 218     {|-----BEGIN RSA PRIVATE KEY-----
 219 MIICXgIBAAKBgQDCFENGw33yGihy92pDjZQhl0C36rPJj+CvfSC8+q28hxA161QF
 220 NUd13wuCTUcq0Qd2qsBe/2hFyc2DCJJg0h1L78+6Z4UMR7EOcpfdUE9Hf3m/hs+F
 221 UR45uBJeDK1HSFHD8bHKD6kv8FPGfJTotc+2xjJwoYi+1hqp1fIekaxsyQIDAQAB
 222 AoGBAJR8ZkCUvx5kzv+utdl7T5MnordT1TvoXXJGXK7ZZ+UuvMNUCdN2QPc4sBiA
 223 QWvLw1cSKt5DsKZ8UETpYPy8pPYnnDEz2dDYiaew9+xEpubyeW2oH4Zx71wqBtOK
 224 kqwrXa/pzdpiucRRjk6vE6YY7EBBs/g7uanVpGibOVAEsqH1AkEA7DkjVH28WDUg
 225 f1nqvfn2Kj6CT7nIcE3jGJsZZ7zlZmBmHFDONMLUrXR/Zm3pR5m0tCmBqa5RK95u
 226 412jt1dPIwJBANJT3v8pnkth48bQo/fKel6uEYyboRtA5/uHuHkZ6FQF7OUkGogc
 227 mSJluOdc5t6hI1VsLn0QZEjQZMEOWr+wKSMCQQCC4kXJEsHAve77oP6HtG/IiEn7
 228 kpyUXRNvFsDE0czpJJBvL/aRFUJxuRK91jhjC68sA7NsKMGg5OXb5I5Jj36xAkEA
 229 gIT7aFOYBFwGgQAQkWNKLvySgKbAZRTeLBacpHMuQdl1DfdntvAyqpAZ0lY0RKmW
 230 G6aFKaqQfOXKCyWoUiVknQJAXrlgySFci/2ueKlIE1QqIiLSZ8V8OlpFLRnb1pzI
 231 7U1yQXnTAEFYM560yJlzUpOb1V4cScGd365tiSMvxLOvTA==
 232 -----END RSA PRIVATE KEY-----
 233 |}
 234     |> Cstruct.of_string
 235     |> X509.Private_key.decode_pem |> Result.get_ok
 236
 237   let pub_key_cavage =
 238     {|-----BEGIN PUBLIC KEY-----
 239 MIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQDCFENGw33yGihy92pDjZQhl0C3
 240 6rPJj+CvfSC8+q28hxA161QFNUd13wuCTUcq0Qd2qsBe/2hFyc2DCJJg0h1L78+6
 241 Z4UMR7EOcpfdUE9Hf3m/hs+FUR45uBJeDK1HSFHD8bHKD6kv8FPGfJTotc+2xjJw
 242 oYi+1hqp1fIekaxsyQIDAQAB
 243 -----END PUBLIC KEY-----
 244 |}
 245     |> Cstruct.of_string
 246     |> X509.Public_key.decode_pem |> Result.get_ok
 247
 248   let tc_sign2 () =
 249     `GET |> Cohttp.Code.string_of_method |> check string __LOC__ "GET";
 250     let n,s = ["date","today";
 251                "digest","SHA256=0815"]
 252               |> Http.Signature.to_sign_string
 253                 `GET
 254                 ("https://example.com/uhu?foo=bar#baz" |> Uri.of_string) in
 255     n |> check string __LOC__ "(request-target) host date digest";
 256     s |> check string __LOC__ "(request-target): get /uhu?foo=bar\nhost: example.com\ndate: today\ndigest: SHA256=0815";
 257     ["host","example.com";
 258      "date","today";
 259      "digest","SHA256=0815"]
 260     |> Http.Signature.add
 261       priv_key_cavage
 262       `GET
 263       ("https://example.com/uhu?foo=bar#baz" |> Uri.of_string)
 264     |> Result.get_ok
 265     |> Cohttp.Header.of_list
 266     |> Cohttp.Header.to_frames |> Astring.String.concat ~sep:"\n"
 267     |> check string __LOC__ {|host: example.com
 268 date: today
 269 digest: SHA256=0815
 270 signature: algorithm="rsa-sha256",headers="(request-target) host date digest",signature="AFq6XChsi63zuCVVzeVigx7BV/HzHnsg304i9uqJ44t2QufQ4WvYS1jDh2B539B3VyBQiuXoiNrSssMoShVORmZzA1y4dnnFlYncFdQRsRDRA//E2YB39ECSby0Fl6pBK+Ws/090RWcxFxTBFsD0H9JQuVASbBCDxy2lhHTFugg="|}
 271
 272   let tc_to_sign_string_basic () =
 273     let open Cohttp in
 274     let uri = Uri.of_string "/foo?param=value&pet=dog" in
 275     [
 276       "host", "example.com" ;
 277       "date", "Sun, 05 Jan 2014 21:31:40 GMT" ;
 278     ]
 279     |> Header.of_list
 280     |> Http.Signature.to_sign_string0 ~request:(Some (`POST,uri))
 281     |> Assrt.equals_string __LOC__
 282       {|(request-target): post /foo?param=value&pet=dog
 283 host: example.com
 284 date: Sun, 05 Jan 2014 21:31:40 GMT|};
 285     assert true
 286
 287 (*
 288  * https://datatracker.ietf.org/doc/html/draft-cavage-http-signatures-12#appendix-C.2
 289  *)
 290   let tc_sign_basic () =
 291     Logr.info (fun m -> m "http_test.test_sign_basic");
 292     let pk = priv_key_cavage in
 293     let open Cohttp in
 294     let sig_ = "qdx+H7PHHDZgy4y/Ahn9Tny9V3GP6YgBPyUXMmoxWtLbHpUnXS2mg2+SbrQDMCJypxBLSPQR2aAjn7ndmw2iicw3HMbe8VfEdKFYRqzic+efkb3nndiv/x1xSHDJWeSWkx3ButlYSuBskLu6kd9Fswtemr3lgdDEmn04swr2Os0="
 295     and uri = Uri.of_string "/foo?param=value&pet=dog"
 296     and h = [
 297       "host", "example.com" ;
 298       "date", "Sun, 05 Jan 2014 21:31:40 GMT" ;
 299     ] |> Header.of_list in
 300     let s = h |> Http.Signature.to_sign_string0 ~request:(Some (`POST,uri)) in
 301     s |> Assrt.equals_string __LOC__
 302       "(request-target): post /foo?param=value&pet=dog\n\
 303        host: example.com\n\
 304        date: Sun, 05 Jan 2014 21:31:40 GMT";
 305     let al,si = s |> Cstruct.of_string |> Ap.PubKeyPem.sign pk in
 306     al |> Assrt.equals_string __LOC__ "rsa-sha256";
 307     si |> Cstruct.to_string |> Base64.encode_exn |> Assrt.equals_string __LOC__ sig_;
 308
 309     Logr.info (fun m -> m "http_test.test_sign_basic II");
 310     let pub = pub_key_cavage in
 311     (match Ap.PubKeyPem.verify ~algo:"rsa-sha256" ~inbox:Uri.empty ~key:pub ~signature:si (s |> Cstruct.of_string) with
 312      | Error `Msg e -> e |> Assrt.equals_string __LOC__ ""
 313      | Ok _ -> "ha!" |> Assrt.equals_string __LOC__ "ha!");
 314     assert true
 315
 316 (*
 317  * https://datatracker.ietf.org/doc/html/draft-cavage-http-signatures-12#appendix-C.3
 318  *)
 319
 320   let tc_sign_all_headers () =
 321     Logr.info (fun m -> m "http_test.test_sign_all_headers");
 322     let open Cohttp in
 323     let h = [
 324       ("(request-target)", "post /foo?param=value&pet=dog");
 325       ("(created)", "1402170695");
 326       ("(expires)", "1402170699");
 327       ("host", "example.com");
 328       ("date", "Sun, 05 Jan 2014 21:31:40 GMT");
 329       ("content-type", "application/json");
 330       ("digest", "SHA-256=X48E9qOokqqrvdts8nOJRJN3OWDUoyWxBf7kbu9DBPE=");
 331       ("content-length", "18");
 332     ] |> Header.of_list in
 333     h
 334     |> Header.to_frames
 335     |> String.concat "\n"
 336     |> Assrt.equals_string __LOC__
 337       "(request-target): post /foo?param=value&pet=dog\n\
 338        (created): 1402170695\n\
 339        (expires): 1402170699\n\
 340        host: example.com\n\
 341        date: Sun, 05 Jan 2014 21:31:40 GMT\n\
 342        content-type: application/json\n\
 343        digest: SHA-256=X48E9qOokqqrvdts8nOJRJN3OWDUoyWxBf7kbu9DBPE=\n\
 344        content-length: 18"
 345     ;
 346     let pk = priv_key_cavage in
 347     let al,si = h
 348                 |> Header.to_frames
 349                 |> String.concat "\n"
 350                 |> Cstruct.of_string
 351                 |> Ap.PubKeyPem.sign pk
 352     in
 353     (*  |> Assrt.equals_string __LOC__
 354           "vSdrb+dS3EceC9bcwHSo4MlyKS59iFIrhgYkz8+oVLEEzmYZZvRs8rgOp+63LEM3v+MFHB32NfpB2bEKBIvB1q52LaEUHFv120V01IL+TAD48XaERZFukWgHoBTLMhYS2Gb51gWxpeIq8knRmPnYePbF5MOkR0Zkly4zKH7s1dE="
 355     *)
 356     al |> Assrt.equals_string __LOC__ "rsa-sha256";
 357     si |> Cstruct.to_string |> Base64.encode_exn |> Assrt.equals_string __LOC__
 358       "nAkCW0wg9AbbStQRLi8fsS1mPPnA6S5+/0alANcoDFG9hG0bJ8NnMRcB1Sz1eccNMzzLEke7nGXqoiJYZFfT81oaRqh/MNFwQVX4OZvTLZ5xVZQuchRkOSO7b2QX0aFWFOUq6dnwAyliHrp6w3FOxwkGGJPaerw2lOYLdC/Bejk="
 359
 360   let tc_signed_headers () =
 361     Logr.info (fun m -> m "http_test.test_signed_headers");
 362     let open Cohttp in
 363     (* values from
 364        https://datatracker.ietf.org/doc/html/draft-cavage-http-signatures-12#appendix-C.3
 365     *)
 366     let id = Uri.of_string "https://example.com/actor/"
 367     and dgst = Some "SHA-256=X48E9qOokqqrvdts8nOJRJN3OWDUoyWxBf7kbu9DBPE="
 368     and date,_,_ = Ptime.of_rfc3339 "2014-01-05T22:31:40+01:00" |> Result.get_ok
 369     and uri = Uri.of_string "https://example.com/foo?param=value&pet=dog" in
 370     let key_id = Uri.with_fragment id (Some "main-key")
 371     and pk = priv_key_cavage in
 372     Http.signed_headers (key_id,pk,date) dgst uri
 373     |> Header.to_frames
 374     |> String.concat "\n"
 375     |> Assrt.equals_string __LOC__
 376       "host: example.com\n\
 377        date: Sun, 05 Jan 2014 21:31:40 GMT\n\
 378        digest: SHA-256=X48E9qOokqqrvdts8nOJRJN3OWDUoyWxBf7kbu9DBPE=\n\
 379        signature: \
 380        keyId=\"https://example.com/actor/#main-key\",\
 381        algorithm=\"rsa-sha256\",\
 382        headers=\"(request-target) host date digest\",\
 383        signature=\"WC34OEWXgO0viIZAu5qnBcKj5nOMlgjs0ASxgJPYX9x1VtKrYRRhAosH7ixFnkJneSHGn8yY9lowNvbdBg+ZsINx6P0e1WyB0YJbwsREYKYpG1sjwS3R3iCXmXf3m+txiCNhFcbbvb0Grq3wbAWGB0VW7ymI6AHixDXFLD5IYl4=\""
 384
 385   (* https://datatracker.ietf.org/doc/html/rfc7235#appendix-C *)
 386
 387   let tc_parse_auth_params () =
 388     Logr.info (fun m -> m "http_test.test_parse_auth_param");
 389     let module P = Http.Signature.P in
 390     (match {|uhu|} |>  Tyre.exec (P.token |> Tyre.compile) with
 391      | Ok "uhu" -> "super"
 392      | _         -> "was anderes")
 393     |> Assrt.equals_string __LOC__ "super";
 394     (match {|"uhu"|} |>  Tyre.exec (P.quoted_string |> Tyre.compile) with
 395      | Ok "uhu" -> "super"
 396      | _     -> "was anderes")
 397     |> Assrt.equals_string __LOC__ "super";
 398     (match {|uhu="aha"|} |>  Tyre.exec (P.auth_param|> Tyre.compile) with
 399      | Ok ("uhu","aha") -> "super"
 400      | _     -> "was anderes")
 401     |> Assrt.equals_string __LOC__ "super";
 402     (match {|uhu="ah\"a"|} |>  Tyre.exec (P.auth_param|> Tyre.compile) with
 403      | Ok ("uhu",{|ah"a|}) -> "super"
 404      | _     -> "was anderes")
 405     |> Assrt.equals_string __LOC__ "super";
 406     (match {|a="A", b="B"|} |>  Tyre.exec (P.list_auth_param|> Tyre.compile) with
 407      | Ok [("a","A"); ("b","B")] -> "super"
 408      | _               -> "was anderes")
 409     |> Assrt.equals_string __LOC__ "super";
 410     (match {|a="A", nasty="na,s\"ty",b="B"|} |>  Tyre.exec (P.list_auth_param|> Tyre.compile) with
 411      | Ok [("a","A");
 412            ("nasty",{|na,s"ty|});
 413            ("b","B")] -> "super"
 414      | _               -> "was anderes")
 415     |> Assrt.equals_string __LOC__ "super";
 416     assert true
 417
 418   let tc_parse_signature () =
 419     Logr.info (fun m -> m "http_test.test_parse_signature");
 420     (* https://datatracker.ietf.org/doc/html/draft-cavage-http-signatures-12#section-4.1.1 *)
 421     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))"|}
 422                 |> Http.Signature.decode in
 423     let _sihe = {|keyId="hmac-key-1",algorithm="hs2019",created=1402170695,headers="(request-target) (created) host digest content-length",signature="Base64(HMAC-SHA512(signing string))"|}
 424                 |> Http.Signature.decode in
 425     (*
 426     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=="'
 427     *)
 428     let h = [
 429       ("date",{|Thu, 29 Jun 2023 09:51:37 GMT|});
 430       ("digest",{|SHA-256=rSBxGz18uv2ZvY9PxjkuKv6ZWR78M/5S2m+yOXrq+ik=|});
 431       ("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=="|});
 432     ] |> Cohttp.Header.of_list in
 433     let sh = "signature" |> Cohttp.Header.get h |> Option.value ~default:"-" in
 434     sh
 435     |> 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=="|};
 436     (match sh |> Http.Signature.decode
 437      (* Http.Signature.decode *) with
 438     | Ok sh ->
 439       sh |> List.length |> Assrt.equals_int __LOC__ 4;
 440       List.assoc_opt "keyId" sh |> Option.value ~default:"-"
 441       |> Assrt.equals_string __LOC__ "https://alpaka.social/users/traunstein#main-key";
 442       List.assoc_opt "algorithm" sh |> Option.value ~default:"-"
 443       |> Assrt.equals_string __LOC__ "rsa-sha256";
 444       List.assoc_opt "headers" sh |> Option.value ~default:"-"
 445       |> Assrt.equals_string __LOC__ "(request-target) host date digest content-type";
 446       List.assoc_opt "signature" sh |> Option.value ~default:"-"
 447       |> Assrt.equals_string __LOC__ "JIHBg3VahvgFweniUBfH0QSHOuilcYW313i7H6gptKT/uOSfs5QhADm7LKLZ6q7jZWtQLi4Ge8dhxVeYhGpdU5P3iABn665z3TvuUiwVUO0sGI6yAv+z9wVmFfPLFsTYOB09Fy+yht+E4Z9GOF6C/U79eb/y8QOuj1OJB3L+427IQpnJMuPh5e22LBM1E/eXLbvWyshKqX0n8WZj4qPezzsH21Afn+dUnd2jc2XqUbOpzeFkz45ut0okZAF3686/sQ0sBcloSFfvdB+EuLqZLJSYcnMe3Qe8dUpibgm5+v0XfgLZYPL2P7VpuMXkQB9neRbSCdTWojcABBwUGWV0DA=="
 448     | _ -> "fail" |> Assrt.equals_string __LOC__ "");
 449     assert true
 450
 451   let tc_verify_basic () =
 452     Logr.info (fun m -> m "http_test.test_verify_basic");
 453     let pub = pub_key_cavage in
 454     let h = [
 455       ("some", "bogus");
 456       ("date", {|Sun, 05 Jan 2014 21:31:40 GMT|});
 457       ("signature", {|keyId="Test",algorithm="rsa-sha256",headers="(request-target) host date",signature="qdx+H7PHHDZgy4y/Ahn9Tny9V3GP6YgBPyUXMmoxWtLbHpUnXS2mg2+SbrQDMCJypxBLSPQR2aAjn7ndmw2iicw3HMbe8VfEdKFYRqzic+efkb3nndiv/x1xSHDJWeSWkx3ButlYSuBskLu6kd9Fswtemr3lgdDEmn04swr2Os0="|});
 458       ("more", "bogus");
 459       ("host", {|example.com|});
 460     ] |> Cohttp.Header.of_list in
 461     (* fetch http header values and map from lowercase plus the special name (request-target) *)
 462     let hdr = Cohttp.Header.get h in
 463     (* take a list of header names and fetch them incl. values. *)
 464     let hdrs =
 465       List.fold_left
 466         (fun init k ->
 467            (match hdr k with
 468             | None   -> init
 469             | Some v -> Cohttp.Header.add init k v)
 470         )
 471         (Cohttp.Header.init ()) in
 472     let foo () =
 473       Logr.debug (fun m -> m "%s.%s get & parse the signature header" "Ap.Inbox" "post");
 474       let ( let* ) = Result.bind in
 475       let* si_v = "signature" |> hdr |> Option.to_result ~none:Http.s502' in
 476       let* si_v = si_v
 477                   |> Http.Signature.decode
 478                   |> Result.map_error
 479                     (function
 480                       | `NoMatch _
 481                       | `ConverterFailure _ ->
 482                         Logr.debug (fun m -> m "%s.%s Signature parsing failure" "Ap.Inbox" "post");
 483                         Http.s502') in
 484       let* algo = si_v |> List.assoc_opt "algorithm" |> Option.to_result ~none:Http.s502' in
 485       let* heads = si_v |> List.assoc_opt "headers" |> Option.to_result ~none:Http.s502' in
 486       let  heads = heads |> String.split_on_char ' ' in
 487       let* keyid = si_v |> List.assoc_opt "keyId" |> Option.to_result ~none:Http.s502' in
 488       let  _keyid = keyid |> Uri.of_string in
 489       let* sign = si_v |> List.assoc_opt "signature" |> Option.to_result ~none:Http.s502' in
 490       let sign = sign |> Base64.decode_exn |> Cstruct.of_string in
 491
 492       Logr.debug (fun m -> m "%s.%s fetch the remote actor profile & key" "Ap.Inbox" "post");
 493
 494       Logr.debug (fun m -> m "%s.%s get the verified header values, signature algorithm %s" "Ap.Inbox" "post" algo);
 495       let heads = heads |> hdrs in
 496       let* _ = heads
 497                |> Http.Signature.to_sign_string0 ~request:(Some (`POST,Uri.of_string "/foo?param=value&pet=dog"))
 498                |> Cstruct.of_string
 499                |> Ap.PubKeyPem.verify ~algo ~inbox:Uri.empty ~key:pub ~signature:sign
 500                |> Result.map_error (fun (`Msg e) ->
 501                    Logr.warn (fun m -> m "%s.%s %s" "Ap.Inbox" "post" e);
 502                    Http.s502') in
 503       Ok heads
 504     in
 505     let v l n = Cohttp.Header.get l n |> Option.value ~default:"?" in
 506     (match foo () with
 507      | Error _ -> "aua" |> Assrt.equals_string __LOC__ "-"
 508      | Ok h->
 509        h |> Cohttp.Header.to_list |> List.length |> Assrt.equals_int __LOC__ 2;
 510        "date" |> v h |> Assrt.equals_string __LOC__ "Sun, 05 Jan 2014 21:31:40 GMT";
 511        "host" |> v h |> Assrt.equals_string __LOC__ "example.com");
 512     assert true
 513
 514   let tc_verify_hs2019_raw () =
 515       (*
 516 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=="
 517 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
 518 host: dev.seppo.social
 519 date: Mon, 16 Sep 2024 12:26:45 GMT
 520 digest: SHA-256=bcLAcfJg/048pSOMeA29j/PqW2iQJw96mT+egmjF+Zk='
 521       *)
 522     let h = [
 523       ("host", {|dev.seppo.social|});
 524       ("date", {|Mon, 16 Sep 2024 12:26:45 GMT|});
 525       ("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=="|});
 526       ("digest", {|SHA-256=bcLAcfJg/048pSOMeA29j/PqW2iQJw96mT+egmjF+Zk=|});
 527     ] |> Cohttp.Header.of_list in
 528     let pay =  h |> Http.Signature.to_sign_string0
 529                  ~request:(Some (`POST,
 530                                  "https://dev.seppo.social/2024-03-19/seppo.cgi/activitypub/inbox.jsa" |> Uri.of_string)) in
 531     pay |> Assrt.equals_string __LOC__ {|(request-target): post /2024-03-19/seppo.cgi/activitypub/inbox.jsa
 532 host: dev.seppo.social
 533 date: Mon, 16 Sep 2024 12:26:45 GMT
 534 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=="
 535 digest: SHA-256=bcLAcfJg/048pSOMeA29j/PqW2iQJw96mT+egmjF+Zk=|};
 536     let signature = "signature"
 537                     |> Cohttp.Header.get h
 538                     |> Option.value ~default:"ouch"
 539                     |> Http.Signature.decode
 540                     |> Result.get_ok
 541                     |> List.assoc "signature" in
 542     signature |> check string __LOC__ {|MG9tIV9rWJHDFKEFGsjakYoBtPjZbyk/ddTn6Xr2xHkmTVZDmkJmGcD4yDfWfQ4m8BYS+jd4lnb8O5fdm/pFwpFDGU70IDLsg6INGxZJQKuWbQB7dFEBJt22h8GcjOIlXvw4cKsgc3KvplIjTrFlnYiQQVvcSy+uQRXJTJTm2Y6vxOQzFvSJa0S8lXz5+x/CqpqXJtj1cSztEHZEFdBla2M30smV1uJvQcfa+lIRPwXdwtL0COsg8J00hAYBoFXPo+4N/jytArkYOFz6MasUrRODURuAE2fR6JI2aAerBy0WFE17TyWuXjWlnYt6t9aO5Wzo/qc/3DgMWHQr8NZGVg==|};
 543     let signature = signature
 544                     |> Base64.decode_exn
 545                     |> Cstruct.of_string in
 546     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"}|}
 547              |> Ezjsonm.from_string
 548              |> As2_vocab.Decode.person
 549              |> Result.get_ok in
 550     let pub = pe.public_key.pem |> Ap.PubKeyPem.of_pem |> Result.get_ok in
 551     let `Msg e = X509.Public_key.verify
 552         `SHA256
 553         ~scheme:`RSA_PKCS1
 554         ~signature
 555         pub
 556         (`Message (pay |> Cstruct.of_string))
 557                  |> Result.get_error in
 558     e |> check string __LOC__ "bad signature"
 559
 560   let tc_verify_hs2019 () =
 561       (*
 562 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=="
 563 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
 564 host: dev.seppo.social
 565 date: Mon, 16 Sep 2024 12:26:45 GMT
 566 digest: SHA-256=bcLAcfJg/048pSOMeA29j/PqW2iQJw96mT+egmjF+Zk='
 567       *)
 568     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
 569     let pe = act |> Ezjsonm.from_string |> As2_vocab.Decode.person |> Result.get_ok in
 570     let pub = pe.public_key.pem |> Ap.PubKeyPem.of_pem |> Result.get_ok in
 571     let h = [
 572       ("host", {|dev.seppo.social|});
 573       ("date", {|Mon, 16 Sep 2024 12:26:45 GMT|});
 574       ("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=="|});
 575       ("digest", {|SHA-256=bcLAcfJg/048pSOMeA29j/PqW2iQJw96mT+egmjF+Zk=|});
 576     ] |> Cohttp.Header.of_list in
 577     h |> Http.Signature.to_sign_string0 ~request:(Some (`POST,"/" |> Uri.of_string))
 578     |> Assrt.equals_string __LOC__ {|(request-target): post /
 579 host: dev.seppo.social
 580 date: Mon, 16 Sep 2024 12:26:45 GMT
 581 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=="
 582 digest: SHA-256=bcLAcfJg/048pSOMeA29j/PqW2iQJw96mT+egmjF+Zk=|};
 583     let si = "signature"
 584              |> Cohttp.Header.get h |> Option.value ~default:"ouch"
 585              |> Http.Signature.decode
 586              |> Result.get_ok in
 587     si |> List.length |> check int __LOC__ 4;
 588     si |> List.assoc "keyId" |> check string __LOC__ "https://gotosocial.dev.seppo.social/users/demo/main-key";
 589     si |> List.assoc "algorithm" |> check string __LOC__ "hs2019";
 590     let sign = si |> List.assoc "signature"  |> Base64.decode_exn |> Cstruct.of_string in
 591     let inbox = "/" |> Uri.of_string in
 592     let `Msg m = h
 593                  |> Http.Signature.to_sign_string0 ~request:(Some (`GET,Uri.empty))
 594                  |> Cstruct.of_string
 595                  |> Ap.PubKeyPem.verify ~algo:"hs2019" ~inbox ~key:pub ~signature:sign
 596                  |> Result.get_error in
 597     m |> check string __LOC__ "bad signature"
 598
 599   (* also https://datatracker.ietf.org/doc/id/draft-richanna-http-message-signatures-00.html#section-a.3
 600
 601      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=="
 602      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
 603      host: mx250.darknet.mro.name
 604      date: Wed, 02 Oct 2024 22:14:43 GMT
 605      digest: SHA-256=DpWuW0JAXqss/tShNxYG7NmD+o18Ok7lNDvHRD0vbcU='
 606   *)
 607   let tc_verify_hs2019_b () =
 608     let signature = {|HCnGYTDX+xfmuUysOGBN//mqInBv//55S/1NRZ+vEqMZxIgu7QsmUB/I7MfeM3PyF1oZDZ5cngsLPmuSjBVnQkAOJIebybNsh9HyLT5Ln4UDyiY30AZVuX+tNz0K5eGmnxS9LFPyfihvrnYZN+2Irny5mCPkB61u8TTmjYKG/WTLKrVhf49fwNt6U11zq7xkVkB8NT6VllH4tftx/GpfqvdCl+FA+UrtKu6GyHBQMmsEz7ybcVXhF04K8z95X2nM/I/pfmQ/b2ySpzX3YwL0UlVrFI44fq7zXIvpkKT3ntg66z3xluuhBL3y2amzty6Ciz/evcJcq6JpaVJ2jTNO5Q==|}
 609                     |> Base64.decode_exn |> Cstruct.of_string
 610     and key = {|-----BEGIN PUBLIC KEY-----
 611 MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAxaVct4ctlG5ssph8+Qiu
 612 cV3/mtoTGE3nyl+9eTUaIvqdgcedIvDrAqJ4Koj6JEFMTjHpJYBvWXWhR7QEuYZJ
 613 3HUjcZozxh40zCOosu841uvoIGEDq75xHRKhFRC38RBo7PRhAjqqCYgfkt7AERmw
 614 JBA1BF2EAPI5i5mjo2IPZzAJdByweVZoo5Wo3Ki3utF3oPXZRnuHmtLbphdJxZTD
 615 9MXfaZLG6sfuzv+Og7O6AninawBmYFz60d8GwfaBOKi8ftbnheh04BGir+jgE02m
 616 WNgdMWOBM9D0D3+kmZ2+m+rACQCT9D500EtMWZSn4ZBDQxUkLLbXrZJt5/fDRur7
 617 QQIDAQAB
 618 -----END PUBLIC KEY-----
 619 |} |> Cstruct.of_string
 620               |> X509.Public_key.decode_pem |> Result.get_ok
 621     and data = [ {|(request-target): post /2024-03-19/seppo.cgi/activitypub/inbox.jsa|} ;
 622                  {|host: mx250.darknet.mro.name|} ;
 623                  {|date: Wed, 02 Oct 2024 22:14:43 GMT|} ;
 624                  {|digest: SHA-256=DpWuW0JAXqss/tShNxYG7NmD+o18Ok7lNDvHRD0vbcU=|} ]
 625     in
 626     key |> X509.Public_key.key_type |> X509.Key_type.to_string |> check string __LOC__ "rsa";
 627     X509.Public_key.verify
 628       `SHA256
 629       ~scheme:`RSA_PKCS1
 630       ~signature
 631       key
 632       (`Message (data |> String.concat "\n" |> Cstruct.of_string))
 633     |> Result.get_ok
 634
 635   (* also
 636      https://datatracker.ietf.org/doc/id/draft-richanna-http-message-signatures-00.html#example-key-rsa-test
 637   *)
 638   let pub_key_richanna =
 639     {|-----BEGIN PUBLIC KEY-----
 640 MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAhAKYdtoeoy8zcAcR874L
 641 8cnZxKzAGwd7v36APp7Pv6Q2jdsPBRrwWEBnez6d0UDKDwGbc6nxfEXAy5mbhgaj
 642 zrw3MOEt8uA5txSKobBpKDeBLOsdJKFqMGmXCQvEG7YemcxDTRPxAleIAgYYRjTS
 643 d/QBwVW9OwNFhekro3RtlinV0a75jfZgkne/YiktSvLG34lw2zqXBDTC5NHROUqG
 644 TlML4PlNZS5Ri2U4aCNx2rUPRcKIlE0PuKxI4T+HIaFpv8+rdV6eUgOrB2xeI1dS
 645 FFn/nnv5OoZJEIB+VmuKn3DCUcCZSFlQPSXSfBDiUGhwOw76WuSSsf1D4b/vLoJ1
 646 0wIDAQAB
 647 -----END PUBLIC KEY-----
 648 |}
 649     |> Cstruct.of_string |> X509.Public_key.decode_pem |> Result.get_ok
 650
 651   (* example from
 652      https://datatracker.ietf.org/doc/id/draft-richanna-http-message-signatures-00.html#name-hs2019-signature-over-minim
 653   *)
 654   let tc_verify_hs2019_richanna_minimal () =
 655     let signature = "e3y37nxAoeuXw2KbaIxE2d9jpE7Z9okgizg6QbD2Z7fUVUvog+ZTKKLRBnhNglVIY6fAaYlHwx7ZAXXdBVF8gjWBPL6U9zRrB4PFzjoLSxHaqsvS0ZK9FRxpenptgukaVQ1aeva3PE1aD6zZ93df2lFIFXGDefYCQ+M/SrDGQOFvaVykEkte5mO6zQZ/HpokjMKvilfSMJS+vbvC1GJItQpjs636Db+7zB2W1BurkGxtQdCLDXuIDg4S8pPSDihkch/dUzL2BpML3PXGKVXwHOUkVG6Q2ge07IYdzya6N1fIVA9eKI1Y47HT35QliVAxZgE0EZLo8mxq19ReIVvuFg=="
 656                     |> Base64.decode_exn |> Cstruct.of_string
 657     and key = pub_key_richanna
 658     and data = [ {|(created): 1402170695|} ;
 659                  {|(request-target): post /foo?param=value&pet=dog|} ]
 660     in
 661     key |> X509.Public_key.key_type |> X509.Key_type.to_string |> check string __LOC__ "rsa";
 662     X509.Public_key.verify
 663       `SHA256
 664       ~scheme:`RSA_PKCS1
 665       ~signature
 666       key
 667       (`Message (data |> String.concat "\n" |> Cstruct.of_string))
 668     |> Result.get_ok
 669
 670   (* example from
 671      https://datatracker.ietf.org/doc/id/draft-richanna-http-message-signatures-00.html#name-create-the-signature-input
 672   *)
 673   let tc_verify_hs2019_richanna_nonn () =
 674     let signature = {|T1l3tWH2cSP31nfuvc3nVaHQ6IAu9YLEXg2pCeEOJETXnlWbgKtBTaXV6LNQWtf4O42V2DZwDZbmVZ8xW3TFW80RrfrY0+fyjD4OLN7/zV6L6d2v7uBpuWZ8QzKuHYFaRNVXgFBXN3VJnsIOUjv20pqZMKO3phLCKX2/zQzJLCBQvF/5UKtnJiMp1ACNhG8LF0Q0FPWfe86YZBBxqrQr5WfjMu0LOO52ZAxi9KTWSlceJ2U361gDb7S5Deub8MaDrjUEpluphQeo8xyvHBoNXsqeax/WaHyRYOgaW6krxEGVaBQAfA2czYZhEA05Tb38ahq/gwDQ1bagd9rGnCHtAg==|}
 675                     |> Base64.decode_exn |> Cstruct.of_string
 676     and key = pub_key_richanna
 677     and data = {|(request-target): get /foo
 678 (created): 1402170695
 679 host: example.org
 680 date: Tue, 07 Jun 2014 20:51:35 GMT
 681 cache-control: max-age=60, must-revalidate
 682 x-emptyheader:
 683 x-example: Example header with some whitespace.|}
 684     in
 685     key |> X509.Public_key.key_type |> X509.Key_type.to_string |> check string __LOC__ "rsa";
 686     X509.Public_key.verify
 687       `SHA256
 688       ~scheme:`RSA_PKCS1
 689       ~signature
 690       key
 691       (`Message (data |> Cstruct.of_string))
 692     |> Result.get_ok
 693
 694   (* example from
 695      https://gts.superseriousbusiness.org/@dumpsterqueer/statuses/01J9BKYKR1W5X078ZESSAW10QS
 696   *)
 697   let tc_verify_hs2019_gotosocial () =
 698     let signature = {|G6X7IV+qHqOaZIrrwRxunzbRgRhzn84UoUJfsSNLveHdVBAiaY3ayoj2F4ZiDxVV6zG0CN3j+0pHbngWgHp4aMETkF/x3KB/l2ILHgBhUpIB+ZAb1MkC+yU+9BNmp8EmVZldzdjQ/MalStfeRc7rcMdL770TJbAW8cgPRPA6TB7P6m5tzEPkow56wR/W0MuYJqWQzE8id7Ri65p63fu8NFha7WgBVM5I+67hZ3sYZTBKdLQJJyS4K3nOZ20h+pUSZUGF7WdTNnxtzaryJgFVL4Or2ydBa/Jp0w8zspWFMlGCtG9A9cayQ7JHlCMiuf92f/hpLWtWCSftg9IzZVakiw==|}
 699                     |> Base64.decode_exn |> Cstruct.of_string
 700     and key =
 701       "-----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"
 702       |> Cstruct.of_string |> X509.Public_key.decode_pem |> Result.get_ok
 703     and data = {|(request-target): get /@mro/113244470620401979
 704 host: digitalcourage.social
 705 date: Fri, 04 Oct 2024 11:12:53 GMT|}
 706     in
 707     key |> X509.Public_key.key_type |> X509.Key_type.to_string |> check string __LOC__ "rsa";
 708     let `Msg m = X509.Public_key.verify
 709         `SHA256
 710         ~scheme:`RSA_PKCS1
 711         ~signature
 712         key
 713         (`Message (data |> Cstruct.of_string))
 714                  |> Result.get_error in
 715     m
 716     |> check string __LOC__ "bad signature"
 717
 718   let tc_verify_masto430 () =
 719     (*
 720
 721     Signature: keyId="https://bewegung.social/use
 722 rs/mro#main-key",algorithm="rsa-sha256",headers="(request-target) host date digest content-type",signature="v2h3HUJg0vH6HyNfOHSE7hIg0O
 723 i1E+iUEO8ahxDjI99F7jKuh9sVRSpqhsAEagI5WeWZkQyhWjRmDZZBsk4+acALo36CsRj/C/m5CiF4J0hd+x8VSPWDJEQTYclm0jCthfdmeXg1/DOZnlWInBVQdwZJZyoW7nTn
 724 EEGZuE0w6LsYCJb2oVUTW32gn+fbHnJ2mkBwPjwBlJ7zckEx3MwnV99GPkjdA0hBX/O4xSD7a0MIn4d0CSOGmbnTGKChTm//AvKXP4L5H9L6ovZFBfaHkDCqYDbdfXGWeheLXd
 725 gDJHubi0LFecP3PP5cwOeuFtGgkWsSeLrUEyWgSlEKjCFRhw=="
 726
 727 (request-target): post /2024-03-19/seppo.cgi/activitypub/inbox.jsa
 728 (request-target): post /2024-03-19/seppo.cgi/activitypub/inbox.jsa
 729 host: mx250.darknet.mro.name
 730 date: Thu, 10 Oct 2024 10:12:10 GMT
 731 digest: SHA-256=N0m+gyYe/GieNBzMEOStVqf7hq/qdmh7bqdWanZSE1o=
 732 content-type: application/activity+json
 733 *)
 734     ()
 735
 736
 737   let tc_sign_api () =
 738     (*
 739     sign != verify
 740
 741     but has overlap
 742
 743     constructing the signagee payload
 744       - keys
 745       - values
 746       -
 747
 748     signing ig
 749
 750     verifying it
 751     *)
 752     (** @TODO *)
 753     let _list_header_get l (k : string) : string option = l |> List.assoc_opt k in
 754     let compute_verify_signature_payload fetcher : string =
 755       (match fetcher "signature" with
 756        | None -> Some "header not found: signature"
 757        | Some si ->
 758          match si |> Http.Signature.decode with
 759          | Error _ -> Some "error decoding signature"
 760          | Ok si ->
 761            match si |> List.assoc_opt "headers" with
 762            | None -> Some "signature field not found: headers"
 763            | Some v ->
 764              (* assert lowercase *)
 765              v
 766              |> Astring.String.cuts ~sep:" " |> List.rev |> List.fold_left
 767                (fun init k -> match k |> fetcher with
 768                   | None -> init
 769                   | Some v -> (k,v) :: init) []
 770              |> Cohttp.Header.of_list
 771              |> Cohttp.Header.to_frames
 772              |> Astring.String.concat ~sep:"\n"
 773              |> Option.some )
 774       |> Option.value ~default:""
 775     in
 776     let r = {Cgi.Request.empty with
 777              request_method = "POST";
 778              raw_string = (function
 779                  | "HTTP_HOST" -> Some "example.com"
 780                  | "HTTP_DATE" -> Some "tomorrow"
 781                  | "HTTP_SIGNATURE" -> Some {|keyId="Test",algorithm="rsa-sha256",headers="(request-target) host date",signature="qdx+H7PHHDZgy4y/Ahn9Tny9V3GP6YgBPyUXMmoxWtLbHpUnXS2mg2+SbrQDMCJypxBLSPQR2aAjn7ndmw2iicw3HMbe8VfEdKFYRqzic+efkb3nndiv/x1xSHDJWeSWkx3ButlYSuBskLu6kd9Fswtemr3lgdDEmn04swr2Os0="|}
 782                  | _ -> None)} in
 783     Cgi.Request.header_get r "SIGNATURE" |> Option.get
 784     |> Http.Signature.decode |> Result.get_ok
 785     |> List.assoc "headers"
 786     |> Astring.String.cuts ~sep:" "
 787     |> List.length
 788     |> Assrt.equals_int __LOC__ 3;
 789     (* typical for verify *)
 790     r
 791     |> Cgi.Request.header_get
 792     |> compute_verify_signature_payload
 793     |> Assrt.equals_string __LOC__ {|(request-target): post /
 794 host: example.com
 795 date: tomorrow|};
 796     ();
 797     ()
 798 end
 799
 800 let () =
 801   run
 802     "seppo_suite" [
 803     __FILE__ , [
 804       "setup",                             `Quick, set_up;
 805       "tc_relpa",                          `Quick, tc_relpa;
 806       "tc_uri",                            `Quick, tc_uri;
 807       "tc_rel_cd",                         `Quick, tc_rel_cd;
 808       "tc_rx_script_name",                 `Quick, Request.tc_rx_script_name;
 809       "tc_uri",                            `Quick, Request.tc_uri;
 810       "tc_base",                           `Quick, Request.tc_base;
 811       "tc_query_string",                   `Quick, Request.tc_query_string;
 812       "tc_rfc1123",                        `Quick, Cookie.tc_rfc1123;
 813       "tc_to_string",                      `Quick, Cookie.tc_to_string;
 814       "tc_of_string",                      `Quick, Cookie.tc_of_string;
 815       "tc_headers",                        `Quick, Header.tc_headers;
 816       "tc_sig_encode",                     `Quick, Header.tc_sig_encode;
 817       "tc_signature",                      `Quick, Header.tc_signature;
 818       "tc_sign2",                          `Quick, Header.tc_sign2;
 819       "tc_to_sign_string_basic",           `Quick, Header.tc_to_sign_string_basic;
 820       "tc_sign_basic",                     `Quick, Header.tc_sign_basic;
 821       "tc_sign_all_headers",               `Quick, Header.tc_sign_all_headers;
 822       "tc_signed_headers",                 `Quick, Header.tc_signed_headers;
 823       "tc_parse_auth_params",              `Quick, Header.tc_parse_auth_params;
 824       "tc_parse_signature",                `Quick, Header.tc_parse_signature;
 825       "tc_verify_basic",                   `Quick, Header.tc_verify_basic;
 826       "tc_verify_hs2019_raw",              `Quick, Header.tc_verify_hs2019_raw;
 827       "tc_verify_hs2019",                  `Quick, Header.tc_verify_hs2019;
 828       "tc_verify_hs2019_b",                `Quick, Header.tc_verify_hs2019_b;
 829       "tc_verify_hs2019_richanna_minimal", `Quick, Header.tc_verify_hs2019_richanna_minimal;
 830       "tc_verify_hs2019_richanna_nonn",    `Quick, Header.tc_verify_hs2019_richanna_nonn;
 831       "tc_verify_hs2019_gotosocial",       `Quick, Header.tc_verify_hs2019_gotosocial;
 832       "tc_verify_masto430",                `Quick, Header.tc_verify_masto430;
 833       "tc_sign_api",                       `Quick, Header.tc_sign_api;
 834     ]
 835   ]