1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-29 00:34:54 +09:00

In outbox post form, provide parent and context, and default to ticket comment

This commit is contained in:
fr33domlover 2019-03-21 23:56:47 +00:00
parent ad3a20d783
commit d40e1b8891

View file

@ -196,13 +196,16 @@ fedUriField = Field
, fieldEnctype = UrlEncoded
}
activityForm :: Form (FedURI, Text)
activityForm = renderDivs $ (,)
<$> areq fedUriField "To" (Just defto)
<*> areq textField "Message" (Just defmsg)
activityForm :: Form (FedURI, Maybe FedURI, Maybe FedURI, Text)
activityForm = renderDivs $ (,,,)
<$> areq fedUriField "To" (Just defto)
<*> aopt fedUriField "Replying on" (Just $ Just defctx)
<*> aopt fedUriField "Context" (Just $ Just defctx)
<*> areq textField "Message" (Just defmsg)
where
defto = FedURI "forge.angeley.es" "/s/fr33" ""
defmsg = "Hi! Nice to meet you :)"
defto = FedURI "forge.angeley.es" "/s/fr33/p/sandbox" ""
defctx = FedURI "forge.angeley.es" "/s/fr33/p/sandbox/t/1" ""
defmsg = "Hi! I'm testing federation. Can you see my message? :)"
activityWidget :: Widget -> Enctype -> Widget
activityWidget widget enctype =
@ -234,12 +237,13 @@ postOutboxR = do
case result of
FormMissing -> setMessage "Field(s) missing"
FormFailure _l -> setMessage "Invalid input, see below"
FormSuccess (to, msg) -> do
FormSuccess (to, mparent, mcontext, msg) -> do
shr <- do
Entity _pid person <- requireVerifiedAuth
sharer <- runDB $ get404 $ personIdent person
return $ sharerIdent sharer
renderUrl <- getUrlRender
now <- liftIO getCurrentTime
let route2uri = route2uri' renderUrl
(h, actor) = f2l $ route2uri $ SharerR shr
actorID = renderUrl $ SharerR shr
@ -256,9 +260,11 @@ postOutboxR = do
}
, activitySpecific = CreateActivity Create
{ createObject = Note
{ noteId = appendPath actor "/fake-note"
, noteReplyTo = Nothing
, noteContent = msg
{ noteId = appendPath actor "/fake-note"
, noteReplyTo = mparent
, noteContext = mcontext
, notePublished = Just now
, noteContent = msg
}
}
}