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

src/Vervis/Handler/Inbox.hs

@@ -196,13 +196,16 @@ fedUriField = Field
     , fieldEnctype = UrlEncoded
     }
 
-activityForm :: Form (FedURI, Text)
-activityForm = renderDivs $ (,)
+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
@@ -257,7 +261,9 @@ postOutboxR = do
                     , activitySpecific = CreateActivity Create
                         { createObject = Note
                             { noteId        = appendPath actor "/fake-note"
-                            , noteReplyTo = Nothing
+                            , noteReplyTo   = mparent
+                            , noteContext   = mcontext
+                            , notePublished = Just now
                             , noteContent   = msg
                             }
                         }