lib/http.ml

@@ -549,21 +549,23 @@ let get_jsonv
     | sta -> err "Gateway error: %s" (sta |> Cohttp.Code.string_of_status)
              |> Lwt.return
 
-(** Extract one required parameters from a get query
+
+let err400 k =
+  (`Bad_request,  [ H.ct_plain ], ("required input missing: " ^ k) |> R.body)
+
+(** Extract one required parameter from a get query
 
     pq: typically Cgi.Request.path_and_query *)
-let par1 pq k0 =
-  let ee k = (`Bad_request,  [ H.ct_plain ], ("required get parameter missing: " ^ k) |> R.body) in
-  let* v0 = k0 |> Uri.get_query_param pq |> Option.to_result ~none:(ee k0) in
+let par1 ?(err = err400) pq k0 =
+  let* v0 = k0 |> Uri.get_query_param pq |> Option.to_result ~none:(err k0) in
   Ok v0
 
 (** Extract two required parameters from a get query
 
     pq: typically Cgi.Request.path_and_query *)
-let par2 pq (k0,k1) =
-  let ee k = (`Bad_request,  [ H.ct_plain ], ("required get parameter missing: " ^ k) |> R.body) in
-  let* v0 = k0 |> Uri.get_query_param pq |> Option.to_result ~none:(ee k0) in
-  let* v1 = k1 |> Uri.get_query_param pq |> Option.to_result ~none:(ee k1) in
+let par2 ?(err = err400) pq (k0,k1) =
+  let* v0 = k0 |> Uri.get_query_param pq |> Option.to_result ~none:(err k0) in
+  let* v1 = k1 |> Uri.get_query_param pq |> Option.to_result ~none:(err k1) in
   Ok (v0,v1)
 
 (** run a value through a function *)

lib/iweb.ml

@@ -103,17 +103,14 @@ module Token = struct
     else err
 
   (** load, destroy and validate CSRF token. *)
-  let check fn ((v : Html.Form.t), vv) =
+  let check fn ((query : Html.Form.t), vv) =
     Logr.debug (fun m -> m "%s.%s" "Iweb.Token" "check");
     try
       match fn |> File.in_channel Csexp.input with
       | Ok Csexp.Atom exp ->
         Unix.unlink fn; (* @TODO maybe this should only happen in case of success, could enable DOS? *)
-        (match Uri.get_query_param (Uri.make ~query:v ()) "token" with
-         | None ->
-           Logr.warn (fun m -> m "%s.%s: no token in form: %s" "Iweb.Token" "check" (Uri.encoded_of_query v));
-           Http.s400
-         | Some tok -> validate ~ok:(tok, (v,vv)) ~err:Http.s403 exp tok )
+        let* tok = "token" |> Http.par1 (Uri.make ~query ()) in
+        validate ~ok:(tok, (query,vv)) ~err:Http.s403 exp tok
       | _ -> Http.s400
     with
     | Sys_error msg -> Error (Http.err500 E.e1038 msg)
@@ -275,8 +272,8 @@ module Login = struct
   (** Handler for HTTP GET *)
   let get _uuid (tok, (r : Cgi.Request.t)) =
     Logr.debug (fun m -> m "%s.%s" "Iweb.Login" "get");
-    let ur = r |> Cgi.Request.path_and_query in
     Ok (`OK, [Http.H.ct_xml], (fun oc ->
+        let ur = Uri.make ~query:(r.query_string |> Uri.query_of_encoded) () in
         [
           n i_tok tok;
           n i_ret ("returnurl" |> Uri.get_query_param ur |> Option.value ~default:"");
@@ -486,6 +483,8 @@ let uid_redir x : (Auth.uid * Cgi.Request.t, Cgi.Response.t) result =
       Ok (Auth.dummy, r))
     else r302 Passwd.path
 
+let (let*%) = Http.(let*%)
+
 (** HTTP endpoint for Profile documents and (un)follow/(un)block. *)
 module Actor = struct
   let path = "/activitypub/actor.xml"
@@ -496,87 +495,72 @@ module Actor = struct
 
       Returns RDF (xml) with xsl transformation to view in the browser. *)
   let get ~base uuid (token, (Auth.Uid _uid, (r : Cgi.Request.t))) =
-    match Ap.PubKeyPem.(private_of_pem pk_pem) with
-    | Error e ->
-      Logr.warn (fun m -> m "%s.%s %s" "Iweb.Actor" "get" e);
-      Lwt.return Http.s500
-    | Ok pk ->
-      let query = r.query_string |> Uri.query_of_encoded in
-      let u = Uri.make ~query () in
-      Logr.debug (fun m -> m "%s.%s %a %a" "Iweb.Actor" "get" Uuidm.pp uuid Uri.pp_hum u);
-      try%lwt
-        match Uri.get_query_param u "id" with
-        | None   ->
-          (match Uri.get_query_param u "resource" with
-           | None   ->
-             (* static, public profile of myself *)
-             Http.s302 ("../../" ^ Ap.prox) |> Lwt.return
-           | Some rfc7565 ->
-             (* resolve webfinger profile and redirect here to fetch actor profile url *)
-             match rfc7565 |> String.trim |> Rfc7565.of_string with
-             | Error e ->
-               Logr.warn (fun m -> m "%s.%s %s" "Iweb.Actor" "get" e);
-               Error (`Bad_request, [Http.H.ct_plain], Cgi.Response.body e)
-               |> Lwt.return
-             | Ok o ->
-               let wk = o |> Webfinger.well_known_uri in
-               let key = None in (* sign the get request for remote actor profile for calckey? *)
-               let%lwt fi = wk |> Webfinger.Client.http_get ~key in
-               (match fi with
-                | Error e  ->
-                  Logr.warn (fun m -> m "%s.%s %s" "Iweb.Actor" "get" e);
-                  Http.s502 ~body:(e |> Cgi.Response.body ~ee:E.e1040)
-                | Ok v     ->
-                  match v.links |> As2_vocab.Types.Webfinger.self_link with
-                  | None   -> Http.s502 ~body:("no activitypub actor url found in jrd" |> Cgi.Response.body ~ee:E.e1041)
-                  | Some u ->
-                    let path = "actor.xml" in
-                    let query = [("id", [u |> Uri.to_string])] in
-                    Uri.make ~path ~query ()
-                    |> Uri.to_string
-                    |> Http.s302
-               ) |> Lwt.return
-          )
-        | Some u -> (* dynamic, uncached remote actor profile converted to rdf *)
-          let date = Ptime_clock.now () in
-          let base = base () in
-          let key_id = Uri.make ~path:Ap.proj () |> Http.reso ~base |> Ap.Person.my_key_id in
-          let key = Some (Http.Signature.mkey key_id pk date) in
-          let%lwt act = u
-                        |> Uri.of_string
-                        |> Ap.Actor.http_get ~key in
-          Logr.err (fun m -> m "%s.%s a1" "Iweb.Actor" "get");
-          match act with
-          | Error s ->
-            Logr.warn (fun m -> m "%s.%s %a %s" "Actor" "get" Uuidm.pp uuid s);
-            Http.s502 ~body:(s |> Cgi.Response.body ~ee:E.e1042) |> Lwt.return
-          | Ok p ->
-            assert (p.id |> Uri.user |> Option.is_none);
-            let toc ?(indent = None) oc doc =
-              (* similar St.to_chan *)
-              let o = Xmlm.make_output ~decl:false (`Channel oc) ~nl:true ~indent in
-              let id x = x in
-              Xmlm.output_doc_tree id o (None, doc)
-            in
-            Ok (`OK, [Http.H.ct_xml], (fun oc ->
-                Xml.pi oc "xml" ["version","1.0"];
-                Xml.pi oc "xml-stylesheet" ["type","text/xsl"; "href","../../themes/current/" ^ "actor.xsl"];
-                p
-                |> Ap.Person.flatten
-                |> Ap.Person.Rdf.encode
-                  ~token:(Some token)
-                  ~is_in_subscribers:(Some (Ap.Followers.is_in_subscribers p.id))
-                  ~am_subscribed_to:(Some (Ap.Following.am_subscribed_to p.id))
-                  ~blocked:(Some (Ap.Following.is_blocked p.id))
-                  ~base
-                  ~context:None
-                |> toc oc))
-            |> Lwt.return
-      with
-      | exn ->
-        let s = exn |> Printexc.to_string in
-        Logr.err (fun m -> m "%s.%s %s" "Iweb.Actor" "get" s);
-        Lwt.return (Http.s502 ~body:(s |> Cgi.Response.body ~ee:E.e1049))
+    let*% pk = Ap.PubKeyPem.(private_of_pem pk_pem)
+               |> Result.map_error (fun e -> (`Bad_gateway, [Http.H.ct_plain], (e |> Cgi.Response.body) ) ) in
+    let u = Uri.make ~query:(r.query_string |> Uri.query_of_encoded) () in
+    Logr.debug (fun m -> m "%s.%s %a %a" "Iweb.Actor" "get" Uuidm.pp uuid Uri.pp_hum u);
+    try%lwt
+      match Uri.get_query_param u "id" with
+      | None   ->
+        let*% rfc7565 = "resource" |> Http.par1 ~err:(fun _ -> Http.(`Found, [ H.ct_plain; H.location ("../../" ^ Ap.prox) ], R.nobody) ) u in
+        let*% o =
+          rfc7565
+          |> String.trim
+          |> Rfc7565.of_string
+          |> Result.map_error (fun e -> `Bad_request, [Http.H.ct_plain], Cgi.Response.body e)
+        in
+        (* resolve webfinger profile and redirect here to fetch actor profile url *)
+        let wk = o |> Webfinger.well_known_uri in
+        let key = None in (* sign the get request for remote actor profile for calckey? *)
+        let%lwt fi = wk |> Webfinger.Client.http_get ~key in
+        let*% v = fi
+                  |> Result.map_error (fun e -> (`Bad_gateway, [Http.H.ct_plain], (e |> Cgi.Response.body ~ee:E.e1040) ) ) in
+        let*% u = v.links
+                  |> As2_vocab.Types.Webfinger.self_link
+                  |> Option.to_result ~none:(`Bad_gateway, [Http.H.ct_plain], "no activitypub actor url found in jrd" |> Cgi.Response.body ~ee:E.e1041 ) in
+        let path = "actor.xml" in
+        let query = [ "id", [u |> Uri.to_string] ] in
+        Uri.make ~path ~query ()
+        |> Uri.to_string
+        |> Http.s302
+        |> Lwt.return
+      | Some u -> (* dynamic, uncached remote actor profile converted to rdf *)
+        let date = Ptime_clock.now () in
+        let base = base () in
+        let key_id = Uri.make ~path:Ap.proj () |> Http.reso ~base |> Ap.Person.my_key_id in
+        let key = Some (Http.Signature.mkey key_id pk date) in
+        let%lwt act = u
+                      |> Uri.of_string
+                      |> Ap.Actor.http_get ~key in
+        Logr.err (fun m -> m "%s.%s a1" "Iweb.Actor" "get");
+        let*% p = act
+                  |> Result.map_error (fun e -> `Bad_gateway, [Http.H.ct_plain], e |> Cgi.Response.body ~ee:E.e1042 ) in
+        assert (p.id |> Uri.user |> Option.is_none);
+        let toc ?(indent = None) oc doc =
+          (* similar St.to_chan *)
+          let o = Xmlm.make_output ~decl:false (`Channel oc) ~nl:true ~indent in
+          let id x = x in
+          Xmlm.output_doc_tree id o (None, doc)
+        in
+        Ok (`OK, [Http.H.ct_xml], (fun oc ->
+            Xml.pi oc "xml" ["version","1.0"];
+            Xml.pi oc "xml-stylesheet" ["type","text/xsl"; "href","../../themes/current/" ^ "actor.xsl"];
+            p
+            |> Ap.Person.flatten
+            |> Ap.Person.Rdf.encode
+              ~token:(Some token)
+              ~is_in_subscribers:(Some (Ap.Followers.is_in_subscribers p.id))
+              ~am_subscribed_to:(Some (Ap.Following.am_subscribed_to p.id))
+              ~blocked:(Some (Ap.Following.is_blocked p.id))
+              ~base
+              ~context:None
+            |> toc oc))
+        |> Lwt.return
+    with
+    | exn ->
+      let s = exn |> Printexc.to_string in
+      Logr.err (fun m -> m "%s.%s %s" "Iweb.Actor" "get" s);
+      Lwt.return (Http.s502 ~body:(s |> Cgi.Response.body ~ee:E.e1049))
 
   (** how to react on form post data concerning subscribe/block *)
   let command uuid frm =
@@ -798,42 +782,40 @@ module Http_ = struct
     let query = r.query_string |> Uri.query_of_encoded in
     let u = Uri.make ~query () in
     Logr.debug (fun m -> m "%s.%s %a %a" "Iweb.Http_" "get" Uuidm.pp uuid Uri.pp_hum u);
-    match Uri.get_query_param u "get" with
-    | None   -> Http.s400 |> Lwt.return
-    | Some u ->
-      let base  = base () in
-      let me    = Uri.make ~path:Ap.proj () |> Http.reso ~base in
-      let keyid = me |> Ap.Person.my_key_id in
-      let (let*%) = Http.(let*%) in
-      let*% pk = Ap.PubKeyPem.(private_of_pem pk_pem) |> Result.map_error (fun s ->
-          Logr.err (fun m -> m "%s %s.%s %s" E.e1009 "Iweb.Http_" "get" s);
-          Http.s500') in
-      Logr.debug (fun m -> m "%s.%s my keyid %a" "Iweb.Http_" "get" Uri.pp_hum keyid);
-      let key = Some (Http.Signature.mkey keyid pk now) in
-
-      let headers = [ Http.H.acc_app_jlda ] |> Cohttp.Header.of_list in
-      let%lwt p = u
-                  |> Uri.of_string
-                  |> Http.get ~key ~headers in
-      match p with
-      | Error e ->
-        Logr.warn (fun m -> m "%s.%s %a responded %s" "Iweb.Http_" "get" Uuidm.pp uuid e);
-        Http.s422 |> Lwt.return
-      | Ok (r,b) ->
-        match r.status with
-        | #Cohttp.Code.success_status ->
-          let ct = "content-type"
-                   |> Cohttp.Header.get r.headers
-                   |> Option.value ~default:Http.Mime.text_plain
-                   |> Http.H.content_type in
-          let%lwt b = b |> Cohttp_lwt.Body.to_string in
-          Ok (`OK, [ct], Cgi.Response.body b)
-          |> Lwt.return
-        | s ->
-          let s = s |> Cohttp.Code.string_of_status in
-          Logr.warn (fun m -> m "%s.%s %a responded %a" "Iweb.Http_" "get" Uuidm.pp uuid Http.pp_status r.status);
-          Http.s502 ~body:(s |> Cgi.Response.body ~ee:E.e1044)
-          |> Lwt.return
+    let (let*%) = Http.(let*%) in
+    let*% u = "get" |> Http.par1 u in
+    let base  = base () in
+    let me    = Uri.make ~path:Ap.proj () |> Http.reso ~base in
+    let keyid = me |> Ap.Person.my_key_id in
+    let*% pk = Ap.PubKeyPem.(private_of_pem pk_pem) |> Result.map_error (fun s ->
+        Logr.err (fun m -> m "%s %s.%s %s" E.e1009 "Iweb.Http_" "get" s);
+        Http.s500') in
+    Logr.debug (fun m -> m "%s.%s my keyid %a" "Iweb.Http_" "get" Uri.pp_hum keyid);
+    let key = Some (Http.Signature.mkey keyid pk now) in
+
+    let headers = [ Http.H.acc_app_jlda ] |> Cohttp.Header.of_list in
+    let%lwt p = u
+                |> Uri.of_string
+                |> Http.get ~key ~headers in
+    match p with
+    | Error e ->
+      Logr.warn (fun m -> m "%s.%s %a responded %s" "Iweb.Http_" "get" Uuidm.pp uuid e);
+      Http.s422 |> Lwt.return
+    | Ok (r,b) ->
+      match r.status with
+      | #Cohttp.Code.success_status ->
+        let ct = "content-type"
+                 |> Cohttp.Header.get r.headers
+                 |> Option.value ~default:Http.Mime.text_plain
+                 |> Http.H.content_type in
+        let%lwt b = b |> Cohttp_lwt.Body.to_string in
+        Ok (`OK, [ct], Cgi.Response.body b)
+        |> Lwt.return
+      | s ->
+        let s = s |> Cohttp.Code.string_of_status in
+        Logr.warn (fun m -> m "%s.%s %a responded %a" "Iweb.Http_" "get" Uuidm.pp uuid Http.pp_status r.status);
+        Http.s502 ~body:(s |> Cgi.Response.body ~ee:E.e1044)
+        |> Lwt.return
 end
 
 (*
@@ -994,7 +976,8 @@ module Announce = struct
                  As2_vocab.Encode.(undo ~base (announce ~context:None ~base))
     in
     (* param names must match usage in posts.xsl *)
-    let* (id,inbox) = ("id","inbox") |> Http.par2 ( req |> Cgi.Request.path_and_query ) >>= Http.f2 in
+    let pq = Uri.make ~query:(req.query_string |> Uri.query_of_encoded) () in
+    let* (id,inbox) = ("id","inbox") |> Http.par2 pq >>= Http.f2 in
     Logr.debug (fun m -> m "%s.%s %a id: %a inbox: %a" "Iweb.Announce" "get" Uuidm.pp uuid Uri.pp id Uri.pp inbox);
     let json = id |> build_json ~base ~me in
     match cdb |> Ap.Followers.(fold_left (State.ibox' (Main.fldbl_notify ~due:tnow ~que id json))) (Ok ()) with
@@ -1036,7 +1019,8 @@ module Like = struct
                  As2_vocab.Encode.(undo ~base (like ~context:None ~base))
     in
     (* param names must match usage in posts.xsl *)
-    let* (id,inbox) = ("id","inbox") |> Http.par2 ( req |> Cgi.Request.path_and_query ) >>= Http.f2 in
+    let pq = Uri.make ~query:(req.query_string |> Uri.query_of_encoded) () in
+    let* (id,inbox) = ("id","inbox") |> Http.par2 pq >>= Http.f2 in
     Logr.debug (fun m -> m "%s.%s %a id: %a inbox: %a" "Iweb.Like" "get" Uuidm.pp uuid Uri.pp id Uri.pp inbox);
     match id
           |> build_json ~base ~me
@@ -1286,11 +1270,11 @@ module Post = struct
       let now      = Ptime_clock.now () in
       let* profile = Result.map_error eee Cfg.Profile.(from_file fn) in
       let lang     = profile.language in
-      let auth_u    = Uri.make ~userinfo:uid ~host:(Uri.host base |> Option.value ~default:"example.com") () in
-      let author    = {Rfc4287.Person.empty with
-                       name = profile.title;
-                       uri  = Some auth_u; } in
-      let* _pk = Ap.PubKeyPem.(private_of_pem pk_pem) |> Result.map_error (fun ( s) ->
+      let auth_u   = Uri.make ~userinfo:uid ~host:(Uri.host base |> Option.value ~default:"example.com") () in
+      let author   = {Rfc4287.Person.empty with
+                      name = profile.title;
+                      uri  = Some auth_u; } in
+      let* _pk = Ap.PubKeyPem.(private_of_pem pk_pem) |> Result.map_error (fun s ->
           Logr.err (fun m -> m "%s %s.%s invalid private key: %s" E.e1026 "Ap" "post" s);
           Http.s500') in
       let r = frm |> List.fold_left sift_post empty in
@@ -1303,6 +1287,9 @@ module Post = struct
         |> Uri.of_string
         |> Http.abs_to_rel ~base in
       match r.sav with
+      | None ->
+        Logr.err (fun m -> m "%s.%s %s" "Iweb.Post" "post" "None");
+        Http.s500
       | Some Cancel ->
         Logr.debug (fun m -> m "%s.%s %s" "Iweb.Post" "post" "Cancel");
         Http.s302 "../"
@@ -1315,13 +1302,12 @@ module Post = struct
                   |> Main.Note.Delete.delete
               >>= Main.Note.Delete.notify_subscribers ~due:now ~base
             with
-            | Ok r ->
-              Logr.info (fun m -> m "TODO %s.%s Delete refresh affected files. %a" "Iweb.Post" "post" Uri.pp r.id);
-              Http.s302 "../"
             | Error e ->
               Logr.warn (fun m -> m "%s.%s Delete %s" "Iweb.Post" "post" e);
-              Http.s500)
-         | None
+              Http.s500
+            | Ok r ->
+              Logr.info (fun m -> m "TODO %s.%s Delete refresh affected files. %a" "Iweb.Post" "post" Uri.pp r.id);
+              Http.s302 "../" )
          | _ -> Http.s500)
       | Some Save ->
         let del_prev ~tz ~now (r : Rfc4287.Entry.t)  =
@@ -1352,12 +1338,9 @@ module Post = struct
            >>= Main.Note.publish ~base ~author ~profile
            >>= Main.Note.Create.notify_subscribers ~due:now ~base
          with
+         | Error e -> Error e
          | Ok _ ->
-           Http.s302 "../"
-         | Error e -> Error e)
-      | None ->
-        Logr.err (fun m -> m "%s.%s %s" "Iweb.Post" "post" "None");
-        Http.s500
+           Http.s302 "../" )
     in
     let r = f () in
     let%lwt _ = Main.Queue.ping_and_forget ~base ~run_delay_s:60 in
@@ -1386,29 +1369,22 @@ module Notifyme = struct
     match r.query_string |> Uri.query_of_encoded with
     | ["resource",[acct]; "rel",["http://ostatus.org/schema/1.0/subscribe"]] ->
       (Logr.debug (fun m -> m "%s.%s %a %s" "Iweb.Notifyme" "get" Uuidm.pp uuid acct);
-       match acct |> Rfc7565.of_string with
-       | Error _ -> Http.s400
-                    |> Lwt.return
-       | Ok o  ->
-         let wk = o |> Webfinger.well_known_uri in
-         Logr.debug (fun m -> m "%s.%s %a webfinger: %a" "Iweb.Notifyme" "get" Uuidm.pp uuid Uri.pp wk);
-         let%lwt wf = wk |> Webfinger.Client.http_get in
-         match wf with
-         | Error _ -> Http.s500
-                      |> Lwt.return
-         | Ok wf ->
-           match wf.links |> As2_vocab.Types.Webfinger.ostatus_subscribe with
-           | None -> Http.s502 ~body:("no ostatus subscribe url found in jrd" |> Cgi.Response.body ~ee:E.e1045)
-                     |> Lwt.return
-           | Some tpl ->
-             Logr.debug (fun m -> m "%s.%s %a got template %s" "Iweb.Notifyme" "get" Uuidm.pp uuid tpl);
-             let rx = Str.regexp_string "{uri}" in
-             let uri = Http.reso ~base:(base()) (Uri.make ~path:Ap.proj ())
-                       |> Uri.to_string in
-             tpl
-             |> Str.replace_first rx uri
-             |> Http.s302
-             |> Lwt.return )
+       let*% o = acct |> Rfc7565.of_string
+                 |> Result.map_error (fun _ -> Http.s400') in
+       let wk = o |> Webfinger.well_known_uri in
+       Logr.debug (fun m -> m "%s.%s %a webfinger: %a" "Iweb.Notifyme" "get" Uuidm.pp uuid Uri.pp wk);
+       let%lwt wf = wk |> Webfinger.Client.http_get in
+       let*% wf = wf |> Result.map_error (fun _ -> Http.s500') in
+       let*% tpl = wf.links |> As2_vocab.Types.Webfinger.ostatus_subscribe 
+                   |> Option.to_result ~none:(Http.s502' ~body:("no ostatus subscribe url found in jrd" |> Cgi.Response.body ~ee:E.e1045)) in
+       Logr.debug (fun m -> m "%s.%s %a got template %s" "Iweb.Notifyme" "get" Uuidm.pp uuid tpl);
+       let rx = Str.regexp_string "{uri}" in
+       let uri = Http.reso ~base:(base()) (Uri.make ~path:Ap.proj ())
+                 |> Uri.to_string in
+       tpl
+       |> Str.replace_first rx uri
+       |> Http.s302
+       |> Lwt.return )
     | _ -> Http.s400
            |> Lwt.return
 end
@@ -1444,32 +1420,25 @@ module Webfing = struct
   let get uuid (r : Cgi.Request.t) =
     Logr.debug (fun m -> m "%s.%s %a" "Iweb.Webfing" "get" Uuidm.pp uuid);
     let ur = r |> Cgi.Request.path_and_query in
-    match "resource"
-          |> Uri.get_query_param ur
-          |> Option.value ~default:""
-          |> Rfc7565.of_string with
-    | Error e ->
-      Logr.warn (fun m -> m "%s.%s %s" "Iweb.Webfing" "get" e);
-      Error (`Bad_request, [Http.H.ct_plain], Cgi.Response.body e)
-      |> Lwt.return
-    | Ok o ->
-      let wk = o |> Webfinger.well_known_uri in
-      let key = None in (* sign the get request for remote actor profile for calckey? *)
-      let%lwt fi = wk |> Webfinger.Client.http_get ~key in
-      (match fi with
-       | Error e  ->
-         Logr.warn (fun m -> m "%s.%s %s" "Iweb.Webfing" "get" e);
-         Http.s502 ~body:(e |> Cgi.Response.body ~ee:E.e1046)
-       | Ok v     ->
-         match v.links |> As2_vocab.Types.Webfinger.self_link with
-         | None   -> Http.s502 ~body:("no activitypub actor url found in jrd" |> Cgi.Response.body ~ee:E.e1047)
-         | Some u ->
-           let path = r.script_name ^ Actor.path in
-           let query = [("id", [u |> Uri.to_string])] in
-           Uri.make ~path ~query ()
-           |> Uri.to_string
-           |> Http.s302
-      ) |> Lwt.return
+    let*% o = "resource"
+              |> Uri.get_query_param ur
+              |> Option.value ~default:""
+              |> Rfc7565.of_string
+              |> Result.map_error (fun e -> `Bad_request, [Http.H.ct_plain], Cgi.Response.body e ) in
+    let wk = o |> Webfinger.well_known_uri in
+    let key = None in (* sign the get request for remote actor profile for calckey? *)
+    let%lwt fi = wk |> Webfinger.Client.http_get ~key in
+    let*% v = fi |> Result.map_error (fun e ->
+        Logr.warn (fun m -> m "%s.%s %s" "Iweb.Webfing" "get" e);
+        Http.s502' ~body:(e |> Cgi.Response.body ~ee:E.e1046) ) in
+    let*% u =  v.links |> As2_vocab.Types.Webfinger.self_link
+               |> Option.to_result ~none:( Http.s502' ~body:("no activitypub actor url found in jrd" |> Cgi.Response.body ~ee:E.e1047) ) in
+    let path = r.script_name ^ Actor.path in
+    let query = [("id", [u |> Uri.to_string])] in
+    Uri.make ~path ~query ()
+    |> Uri.to_string
+    |> Http.s302
+    |> Lwt.return
 end
 
 let flt_page ~pagesize n i _ =
@@ -1523,57 +1492,57 @@ module Timeline = struct
       |> Uri.of_string in
     let p0 = (path ^ "p-%/") |> Make.Jig.make in
     match r.path_info |> Make.Jig.cut p0 with
-    | Some [pag'] -> (match pag' |> int_of_string_opt with
-        | Some pag ->
-          let l = l
-                  |> List.sort (fun (t0,_n0) (t1,_n1) -> Float.compare t0 t1)
-                  |> List.filteri (flt_page ~pagesize pag)
-                  |> List.filter_map (fun (_mtime,fn) ->
-                      match fn |> File.in_channel Ezjsonm.from_channel_result  with
+    | Some [pag'] -> (
+        let* pag = pag' |> int_of_string_opt
+                   |> Option.to_result ~none:Http.(`Not_found, [ H.ct_plain ], R.nobody) in
+        let l = l
+                |> List.sort (fun (t0,_n0) (t1,_n1) -> Float.compare t0 t1)
+                |> List.filteri (flt_page ~pagesize pag)
+                |> List.filter_map (fun (_mtime,fn) ->
+                    match fn |> File.in_channel Ezjsonm.from_channel_result  with
+                    | Error e ->
+                      Logr.warn (fun m -> m "%s.%s ignored json error in %s: %a" "Iweb.Timeline" "get" fn St.pp_json_err e);
+                      None
+                    | Ok bo ->
+                      match bo |> As2_vocab.Activitypub.Decode.obj with
                       | Error e ->
-                        Logr.warn (fun m -> m "%s.%s ignored json error in %s: %a" "Iweb.Timeline" "get" fn St.pp_json_err e);
+                        Logr.warn (fun m -> m "%s.%s ignored error in %s: %a" "Iweb.Timeline" "get" fn Decoders_ezjsonm.Decode.pp_error e);
+                        None
+                      | Ok ( `Update { obj = `Note obj; _ } )
+                      | Ok ( `Create { obj = `Note obj; _ } ) ->
+                        Some (obj |> Ap.Note.to_rfc4287 ~tz ~now)
+                      | Ok (_ : As2_vocab.Types.obj)  ->
+                        Logr.warn (fun m -> m "%s.%s ignored object in %s" "Iweb.Timeline" "get" fn);
                         None
-                      | Ok bo ->
-                        match bo |> As2_vocab.Activitypub.Decode.obj with
-                        | Error e ->
-                          Logr.warn (fun m -> m "%s.%s ignored error in %s: %a" "Iweb.Timeline" "get" fn Decoders_ezjsonm.Decode.pp_error e);
-                          None
-                        | Ok ( `Update { obj = `Note obj; _ } )
-                        | Ok ( `Create { obj = `Note obj; _ } ) ->
-                          Some (obj |> Ap.Note.to_rfc4287 ~tz ~now)
-                        | Ok (_ : As2_vocab.Types.obj)  ->
-                          Logr.warn (fun m -> m "%s.%s ignored object in %s" "Iweb.Timeline" "get" fn);
-                          None
-                    ) in
-          let p_url' p =
-            if 0 <= p && p < pagecount
-            then Some (p_url p)
-            else None
-          in
-          let nu = l |> List.length in
-          let first = pagecount |> pred |> p_url
-          and prev  = pag |> succ |> p_url'
-          and next  = pag |> pred |> p_url'
-          and last  = 0 |> p_url
-          and self  = pag |> p_url
-          and title = Printf.sprintf "Timeline %i/%i" (succ pag) pagecount
-          in
-          let x = l |> Rfc4287.Feed.to_atom
-                    ~base
-                    ~self
-                    ~prev
-                    ~next
-                    ~first
-                    ~last
-                    ~title
-                    ~updated:Rfc3339.epoch
-                    ~lang:(Rfc4287.Rfc4646 "nl")
-                    ~author:Rfc4287.Person.empty in
-          let xsl = "timeline.xsl" in
-          let xsl = Some ("../../../themes/current/" ^ xsl) in
-          Logr.debug (fun m -> m "%s.%s dt=%fs page %i/%i %i items" "Iweb.Timeline" "get" (Sys.time () -. t0) pag pagecount nu);
-          Ok (`OK, [Http.H.ct_xml], Xml.to_chan ~xsl x)
-        | _ -> Http.s404)
+                  ) in
+        let p_url' p =
+          if 0 <= p && p < pagecount
+          then Some (p_url p)
+          else None
+        in
+        let nu = l |> List.length in
+        let first = pagecount |> pred |> p_url
+        and prev  = pag |> succ |> p_url'
+        and next  = pag |> pred |> p_url'
+        and last  = 0 |> p_url
+        and self  = pag |> p_url
+        and title = Printf.sprintf "Timeline %i/%i" (succ pag) pagecount
+        in
+        let x = l |> Rfc4287.Feed.to_atom
+                  ~base
+                  ~self
+                  ~prev
+                  ~next
+                  ~first
+                  ~last
+                  ~title
+                  ~updated:Rfc3339.epoch
+                  ~lang:(Rfc4287.Rfc4646 "nl")
+                  ~author:Rfc4287.Person.empty in
+        let xsl = "timeline.xsl" in
+        let xsl = Some ("../../../themes/current/" ^ xsl) in
+        Logr.debug (fun m -> m "%s.%s dt=%fs page %i/%i %i items" "Iweb.Timeline" "get" (Sys.time () -. t0) pag pagecount nu);
+        Ok (`OK, [Http.H.ct_xml], Xml.to_chan ~xsl x) )
     | _ -> pagecount
            |> pred
            |> p_url