From d40e1b8891391ff6686a683037b44fbd80a09881 Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Thu, 21 Mar 2019 23:56:47 +0000
Subject: [PATCH] In outbox post form, provide parent and context, and default
to ticket comment
---
src/Vervis/Handler/Inbox.hs | 26 ++++++++++++++++----------
1 file changed, 16 insertions(+), 10 deletions(-)
diff --git a/src/Vervis/Handler/Inbox.hs b/src/Vervis/Handler/Inbox.hs
index 06578da..84a2519 100644
--- a/src/Vervis/Handler/Inbox.hs
+++ b/src/Vervis/Handler/Inbox.hs
@@ -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
}
}
}