diff --git a/config/routes b/config/routes index 89b69d2..1a76223 100644 --- a/config/routes +++ b/config/routes @@ -32,7 +32,7 @@ -- Federation -- ---------------------------------------------------------------------------- -/publish PublishR GET +/publish PublishR GET POST /inbox InboxR GET /akey1 ActorKey1R GET /akey2 ActorKey2R GET diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index 4a0d510..9c7f864 100644 --- a/src/Vervis/Foundation.hs +++ b/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 diff --git a/src/Vervis/Handler/Client.hs b/src/Vervis/Handler/Client.hs index 5f1c7cf..c3994a6 100644 --- a/src/Vervis/Handler/Client.hs +++ b/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|

Publish a ticket comment -
+ ^{widget1}

Open a new ticket - + ^{widget2}

Follow a person, a projet or a repo - + ^{widget3} |] @@ -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