Client: Add form to submit a patch via Offer activity

src/Vervis/Client.hs

@@ -30,6 +30,7 @@ module Vervis.Client
     , undoFollowRepo
     , unresolve
     , createMR
+    , offerMR
     )
 where
 
@@ -615,8 +616,69 @@ createMR shrAuthor title desc uContext muBranch typ diff = runExceptT $ do
                     }
                 )
             }
-        create = Create
-            { createObject = CreateTicket ticket
-            , createTarget = Just uTarget
-            }
     return (Nothing, Audience recips [] [] [] [] [], ticket, Just uTarget)
+
+offerMR
+    :: (MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
+    => ShrIdent
+    -> TextHtml
+    -> TextPandocMarkdown
+    -> FedURI
+    -> Maybe FedURI
+    -> PatchMediaType
+    -> Text
+    -> m (Either Text (Maybe TextHtml, Audience URIMode, AP.Ticket URIMode))
+offerMR shrAuthor title desc uContext muBranch typ diff = runExceptT $ do
+    encodeRouteLocal <- getEncodeRouteLocal
+    encodeRouteHome <- getEncodeRouteHome
+    manager <- asksSite appHttpManager
+    hLocal <- asksSite siteInstanceHost
+
+    context <- parseTicketContext uContext
+    descHtml <-
+        ExceptT . pure $ renderPandocMarkdown $ unTextPandocMarkdown desc
+    context' <- bitraverse pure (getRemoteContextHttp "Context") context
+
+    let audAuthor =
+            AudLocal
+                []
+                [LocalPersonCollectionSharerFollowers shrAuthor]
+        audContext = contextAudience context'
+
+        (_, _, _, audLocal, audRemote) =
+            collectAudience $ audAuthor : audContext
+
+        recips = map encodeRouteHome audLocal ++ audRemote
+        ObjURI hBranch luBranch = fromMaybe uContext muBranch
+        luAuthor = encodeRouteLocal $ SharerR shrAuthor
+
+        ticket = AP.Ticket
+            { AP.ticketLocal        = Nothing
+            , AP.ticketAttributedTo = luAuthor
+            , AP.ticketPublished    = Nothing
+            , AP.ticketUpdated      = Nothing
+            , AP.ticketContext      = Nothing
+            , AP.ticketSummary      = title
+            , AP.ticketContent      = TextHtml descHtml
+            , AP.ticketSource       = desc
+            , AP.ticketAssignedTo   = Nothing
+            , AP.ticketResolved     = Nothing
+            , AP.ticketAttachment   = Just
+                ( hBranch
+                , MergeRequest
+                    { mrOrigin = Nothing
+                    , mrTarget = luBranch
+                    , mrBundle = Right
+                        ( hLocal
+                        , BundleOffer Nothing $ pure AP.Patch
+                            { AP.patchLocal        = Nothing
+                            , AP.patchAttributedTo = luAuthor
+                            , AP.patchPublished    = Nothing
+                            , AP.patchType         = typ
+                            , AP.patchContent      = diff
+                            }
+                        )
+                    }
+                )
+            }
+    return (Nothing, Audience recips [] [] [] [] [], ticket)

src/Vervis/Handler/Client.hs

@@ -250,6 +250,7 @@ activityWidget
     -> Widget -> Enctype
     -> Widget -> Enctype
     -> Widget -> Enctype
+    -> Widget -> Enctype
     -> Widget
 activityWidget
     widget1 enctype1
@@ -258,7 +259,8 @@ activityWidget
     widget4 enctype4
     widget5 enctype5
     widget6 enctype6
-    widget7 enctype7 =
+    widget7 enctype7
+    widget8 enctype8 =
         [whamlet|
             <h1>Publish a ticket comment
             <form method=POST action=@{PublishR} enctype=#{enctype1}>
@@ -294,6 +296,11 @@ activityWidget
             <form method=POST action=@{PublishR} enctype=#{enctype7}>
               ^{widget7}
               <input type=submit>
+
+            <h1>Submit a patch (via Offer)
+            <form method=POST action=@{PublishR} enctype=#{enctype8}>
+              ^{widget8}
+              <input type=submit>
         |]
 
 getUser :: Handler (ShrIdent, PersonId)
@@ -327,6 +334,8 @@ getPublishR = do
         runFormPost $ identifyForm "f6" unresolveForm
     ((_result7, widget7), enctype7) <-
         runFormPost $ identifyForm "f7" createMergeRequestForm
+    ((_result8, widget8), enctype8) <-
+        runFormPost $ identifyForm "f8" createMergeRequestForm
     defaultLayout $
         activityWidget
             widget1 enctype1
@@ -336,6 +345,7 @@ getPublishR = do
             widget5 enctype5
             widget6 enctype6
             widget7 enctype7
+            widget8 enctype8
 
 postSharerOutboxR :: ShrIdent -> Handler Text
 postSharerOutboxR shr = do
@@ -395,6 +405,7 @@ data Result
     | ResultResolve FedURI
     | ResultUnresolve FedURI
     | ResultCreateMR (FedURI, Maybe FedURI, TextHtml, TextPandocMarkdown, PatchMediaType, FileInfo)
+    | ResultOfferMR (FedURI, Maybe FedURI, TextHtml, TextPandocMarkdown, PatchMediaType, FileInfo)
 
 postPublishR :: Handler Html
 postPublishR = do
@@ -415,6 +426,8 @@ postPublishR = do
         runFormPost $ identifyForm "f6" unresolveForm
     ((result7, widget7), enctype7) <-
         runFormPost $ identifyForm "f7" createMergeRequestForm
+    ((result8, widget8), enctype8) <-
+        runFormPost $ identifyForm "f8" createMergeRequestForm
     let result
             =   ResultPublishComment <$> result1
             <|> ResultCreateTicket <$> result2
@@ -423,6 +436,7 @@ postPublishR = do
             <|> ResultResolve <$> result5
             <|> ResultUnresolve <$> result6
             <|> ResultCreateMR <$> result7
+            <|> ResultOfferMR <$> result8
 
     ep@(Entity _ p) <- requireVerifiedAuth
     s <- runDB $ getJust $ personIdent p
@@ -450,6 +464,11 @@ postPublishR = do
                 (summary, audience, ticket, muTarget) <-
                     ExceptT $ createMR shrAuthor title desc uCtx muBranch typ diff
                 createTicketC ep s summary audience ticket muTarget
+            ResultOfferMR (uCtx, muBranch, title, desc, typ, file) -> do
+                diff <- TE.decodeUtf8 <$> fileSourceByteString file
+                (summary, audience, ticket) <-
+                    ExceptT $ offerMR shrAuthor title desc uCtx muBranch typ diff
+                offerTicketC ep s summary audience ticket uCtx
     case eid of
         Left err -> setMessage $ toHtml err
         Right _obiid -> setMessage "Activity published"
@@ -462,6 +481,7 @@ postPublishR = do
             widget5 enctype5
             widget6 enctype6
             widget7 enctype7
+            widget8 enctype8
     where
     publishComment eperson sharer ((hTicket, shrTicket, prj, num), muParent, msg) = do
         encodeRouteFed <- getEncodeRouteHome