sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-29 00:24:51 +09:00
Code Issues Activity

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

Browse source
This commit is contained in:
fr33domlover 2019-03-21 23:56:47 +00:00
parent ad3a20d783
commit d40e1b8891
1 changed files with 16 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
src/Vervis/Handler/Inbox.hs
View file

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