C2S: Process the HTML forms in postPublishR, not postSharerOutboxR

config/routes

@@ -32,7 +32,7 @@
 -- Federation
 -- ----------------------------------------------------------------------------
 
-/publish                                     PublishR          GET
+/publish                                     PublishR          GET POST
 /inbox                                       InboxR            GET
 /akey1                                       ActorKey1R        GET
 /akey2                                       ActorKey2R        GET

src/Vervis/Foundation.hs

@@ -298,6 +298,8 @@ instance Yesod App where
             | a == resendVerifyR           -> personFromResendForm
         (AuthR (PluginR "account" ["verify", u, _]), False) -> personUnver u
 
+        (PublishR                  , True) -> personAny
+
         (SharerInboxR shr          , False) -> person shr
         (NotificationsR shr        , _   ) -> person shr
         (SharerOutboxR shr         , True) -> person shr

src/Vervis/Handler/Client.hs

@@ -16,6 +16,7 @@
 module Vervis.Handler.Client
     ( getPublishR
     , postSharerOutboxR
+    , postPublishR
 
     , postSharerFollowR
     , postProjectFollowR
@@ -184,25 +185,24 @@ followForm = renderDivs $ (,)
     deft = ObjURI (Authority "forge.angeley.es" Nothing) $ LocalURI "/s/fr33"
 
 activityWidget
-    :: ShrIdent
-    -> Widget -> Enctype
+    :: Widget -> Enctype
     -> Widget -> Enctype
     -> Widget -> Enctype
     -> Widget
-activityWidget shr widget1 enctype1 widget2 enctype2 widget3 enctype3 =
+activityWidget widget1 enctype1 widget2 enctype2 widget3 enctype3 =
     [whamlet|
         <h1>Publish a ticket comment
-        <form method=POST action=@{SharerOutboxR shr} enctype=#{enctype1}>
+        <form method=POST action=@{PublishR} enctype=#{enctype1}>
           ^{widget1}
           <input type=submit>
 
         <h1>Open a new ticket
-        <form method=POST action=@{SharerOutboxR shr} enctype=#{enctype2}>
+        <form method=POST action=@{PublishR} enctype=#{enctype2}>
           ^{widget2}
           <input type=submit>
 
         <h1>Follow a person, a projet or a repo
-        <form method=POST action=@{SharerOutboxR shr} enctype=#{enctype3}>
+        <form method=POST action=@{PublishR} enctype=#{enctype3}>
           ^{widget3}
           <input type=submit>
     |]
@@ -218,7 +218,6 @@ getUserShrIdent = fst <$> getUser
 
 getPublishR :: Handler Html
 getPublishR = do
-    shr <- getUserShrIdent
     ((_result1, widget1), enctype1) <-
         runFormPost $ identifyForm "f1" publishCommentForm
     ((_result2, widget2), enctype2) <-
@@ -226,10 +225,19 @@ getPublishR = do
     ((_result3, widget3), enctype3) <-
         runFormPost $ identifyForm "f3" followForm
     defaultLayout $
-        activityWidget shr widget1 enctype1 widget2 enctype2 widget3 enctype3
+        activityWidget widget1 enctype1 widget2 enctype2 widget3 enctype3
 
 postSharerOutboxR :: ShrIdent -> Handler Html
-postSharerOutboxR shrAuthor = do
+postSharerOutboxR _shrAuthor = do
+    federation <- getsYesod $ appFederation . appSettings
+    unless federation badMethod
+
+    error
+        "ActivityPub C2S outbox POST not implemented yet, but you can public \
+        \activities via the /publish page"
+
+postPublishR :: Handler Html
+postPublishR = do
     federation <- getsYesod $ appFederation . appSettings
     unless federation badMethod
 
@@ -244,13 +252,15 @@ postSharerOutboxR shrAuthor = do
             <|> Right . Left <$> result2
             <|> Right . Right <$> result3
 
+    shrAuthor <- getUserShrIdent
+
     eid <- runExceptT $ do
         input <-
             case result of
                 FormMissing -> throwE "Field(s) missing"
                 FormFailure _l -> throwE "Invalid input, see below"
                 FormSuccess r -> return r
-        bitraverse publishComment (bitraverse openTicket follow) input
+        bitraverse (publishComment shrAuthor) (bitraverse (openTicket shrAuthor) (follow shrAuthor)) input
     case eid of
         Left err -> setMessage $ toHtml err
         Right id_ ->
@@ -266,12 +276,11 @@ postSharerOutboxR shrAuthor = do
                     setMessage "Follow request published!"
     defaultLayout $
         activityWidget
-            shrAuthor
             widget1 enctype1
             widget2 enctype2
             widget3 enctype3
     where
-    publishComment ((hTicket, shrTicket, prj, num), muParent, msg) = do
+    publishComment shrAuthor ((hTicket, shrTicket, prj, num), muParent, msg) = do
         encodeRouteFed <- getEncodeRouteHome
         encodeRouteLocal <- getEncodeRouteLocal
         let msg' = T.filter (/= '\r') msg
@@ -303,7 +312,7 @@ postSharerOutboxR shrAuthor = do
                 , noteContent   = contentHtml
                 }
         ExceptT $ createNoteC hLocal note
-    openTicket ((h, shr, prj), TextHtml title, TextPandocMarkdown desc) = do
+    openTicket shrAuthor ((h, shr, prj), TextHtml title, TextPandocMarkdown desc) = do
         encodeRouteLocal <- getEncodeRouteLocal
         encodeRouteFed <- getEncodeRouteFed
         local <- hostIsLocal h
@@ -352,7 +361,7 @@ postSharerOutboxR shrAuthor = do
                 , audienceNonActors = map (encodeRouteFed h) recipsC
                 }
         ExceptT $ offerTicketC shrAuthor summary audience offer
-    follow (uObject@(ObjURI hObject luObject), uRecip) = do
+    follow shrAuthor (uObject@(ObjURI hObject luObject), uRecip) = do
         (summary, audience, followAP) <-
             C.follow shrAuthor uObject uRecip False
         ExceptT $ followC shrAuthor summary audience followAP