diff --git a/src/Vervis/Client.hs b/src/Vervis/Client.hs index 885d37d..8f579ba 100644 --- a/src/Vervis/Client.hs +++ b/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) diff --git a/src/Vervis/Handler/Client.hs b/src/Vervis/Handler/Client.hs index 09f3499..637f00c 100644 --- a/src/Vervis/Handler/Client.hs +++ b/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|

Publish a ticket comment
@@ -294,6 +296,11 @@ activityWidget ^{widget7} + +

Submit a patch (via Offer) + + ^{widget8} + |] 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