Move postTicketsR to Vervis.Handler.Client & submit Follow activity on success
This commit is contained in:
fr33domlover
parent
72cba96958
commit
77678fc8f6
3 changed files with 114 additions and 96 deletions
|
|
@ -21,12 +21,14 @@ module Vervis.Client
|
|||
, followProject
|
||||
, followTicket
|
||||
, followRepo
|
||||
, offerTicket
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad.Trans.Except
|
||||
import Database.Persist
|
||||
import Data.Text (Text)
|
||||
import Text.Blaze.Html (preEscapedToHtml)
|
||||
import Text.Blaze.Html.Renderer.Text
|
||||
import Text.Hamlet
|
||||
import Yesod.Core
|
||||
|
|
@ -193,3 +195,50 @@ followRepo shrAuthor shrObject rpObject hide = do
|
|||
encodeRouteHome <- getEncodeRouteHome
|
||||
let uObject = encodeRouteHome $ RepoR shrObject rpObject
|
||||
follow shrAuthor uObject uObject hide
|
||||
|
||||
offerTicket
|
||||
:: (MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
|
||||
=> ShrIdent -> TextHtml -> TextPandocMarkdown -> ShrIdent -> PrjIdent -> m (Either Text (TextHtml, Audience URIMode, Offer URIMode))
|
||||
offerTicket shrAuthor (TextHtml title) (TextPandocMarkdown desc) shr prj = runExceptT $ do
|
||||
encodeRouteLocal <- getEncodeRouteLocal
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
descHtml <- ExceptT . pure $ renderPandocMarkdown desc
|
||||
summary <-
|
||||
TextHtml . TL.toStrict . renderHtml <$>
|
||||
withUrlRenderer
|
||||
[hamlet|
|
||||
<p>
|
||||
<a href=@{SharerR shrAuthor}>
|
||||
#{shr2text shrAuthor}
|
||||
\ offered a ticket to project #
|
||||
<a href=@{ProjectR shr prj}>
|
||||
./s/#{shr2text shr}/p/#{prj2text prj}
|
||||
: #{preEscapedToHtml title}.
|
||||
|]
|
||||
let recipsA = [ProjectR shr prj]
|
||||
recipsC = [ProjectTeamR shr prj, ProjectFollowersR shr prj]
|
||||
ticket = AP.Ticket
|
||||
{ AP.ticketLocal = Nothing
|
||||
, AP.ticketAttributedTo = encodeRouteLocal $ SharerR shrAuthor
|
||||
, AP.ticketPublished = Nothing
|
||||
, AP.ticketUpdated = Nothing
|
||||
, AP.ticketName = Nothing
|
||||
, AP.ticketSummary = TextHtml title
|
||||
, AP.ticketContent = TextHtml descHtml
|
||||
, AP.ticketSource = TextPandocMarkdown desc
|
||||
, AP.ticketAssignedTo = Nothing
|
||||
, AP.ticketIsResolved = False
|
||||
}
|
||||
offer = Offer
|
||||
{ offerObject = ticket
|
||||
, offerTarget = encodeRouteHome $ ProjectR shr prj
|
||||
}
|
||||
audience = Audience
|
||||
{ audienceTo = map encodeRouteHome $ recipsA ++ recipsC
|
||||
, audienceBto = []
|
||||
, audienceCc = []
|
||||
, audienceBcc = []
|
||||
, audienceGeneral = []
|
||||
, audienceNonActors = map encodeRouteHome recipsC
|
||||
}
|
||||
return (summary, audience, offer)
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
{- This file is part of Vervis.
|
||||
-
|
||||
- Written in 2019 by fr33domlover <fr33domlover@riseup.net>.
|
||||
- Written in 2016, 2018, 2019 by fr33domlover <fr33domlover@riseup.net>.
|
||||
-
|
||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||
-
|
||||
|
|
@ -22,6 +22,7 @@ module Vervis.Handler.Client
|
|||
, postRepoFollowR
|
||||
, getNotificationsR
|
||||
, postNotificationsR
|
||||
, postTicketsR
|
||||
)
|
||||
where
|
||||
|
||||
|
|
@ -68,6 +69,7 @@ import Vervis.ActivityPub
|
|||
import Vervis.API
|
||||
import Vervis.Client
|
||||
import Vervis.FedURI
|
||||
import Vervis.Form.Ticket
|
||||
import Vervis.Foundation
|
||||
import Vervis.Model
|
||||
import Vervis.Model.Ident
|
||||
|
|
@ -526,3 +528,65 @@ postNotificationsR shr = do
|
|||
case requireEither mx my of
|
||||
Left b -> liftIO $ throwIO $ userError $ if b then t else f
|
||||
Right exy -> return exy
|
||||
|
||||
postTicketsR :: ShrIdent -> PrjIdent -> Handler Html
|
||||
postTicketsR shr prj = do
|
||||
wid <- runDB $ do
|
||||
sid <- getKeyBy404 $ UniqueSharer shr
|
||||
j <- getValBy404 $ UniqueProject prj sid
|
||||
return $ projectWorkflow j
|
||||
((result, widget), enctype) <- runFormPost $ newTicketForm wid
|
||||
|
||||
shrAuthor <- do
|
||||
Entity _ p <- requireVerifiedAuth
|
||||
runDB $ sharerIdent <$> getJust (personIdent p)
|
||||
|
||||
enum <- runExceptT $ do
|
||||
NewTicket title desc tparams eparams <-
|
||||
case result of
|
||||
FormMissing -> throwE "Field(s) missing."
|
||||
FormFailure _l ->
|
||||
throwE "Ticket submission failed, see errors below."
|
||||
FormSuccess nt -> return nt
|
||||
unless (null tparams && null eparams) $
|
||||
throwE "Custom param support currently disabled"
|
||||
{-
|
||||
let mktparam (fid, v) = TicketParamText
|
||||
{ ticketParamTextTicket = tid
|
||||
, ticketParamTextField = fid
|
||||
, ticketParamTextValue = v
|
||||
}
|
||||
insertMany_ $ map mktparam $ ntTParams nt
|
||||
let mkeparam (fid, v) = TicketParamEnum
|
||||
{ ticketParamEnumTicket = tid
|
||||
, ticketParamEnumField = fid
|
||||
, ticketParamEnumValue = v
|
||||
}
|
||||
insertMany_ $ map mkeparam $ ntEParams nt
|
||||
-}
|
||||
(summary, audience, offer) <-
|
||||
ExceptT $ offerTicket shrAuthor (TextHtml title) (TextPandocMarkdown desc) shr prj
|
||||
obiid <- ExceptT $ offerTicketC shrAuthor summary audience offer
|
||||
ExceptT $ runDB $ do
|
||||
mtal <- getValBy $ UniqueTicketAuthorLocalOffer obiid
|
||||
case mtal of
|
||||
Nothing ->
|
||||
return $
|
||||
Left
|
||||
"Offer processed successfully but no ticket \
|
||||
\created"
|
||||
Just tal ->
|
||||
Right . ticketNumber <$>
|
||||
getJust (ticketAuthorLocalTicket tal)
|
||||
case enum of
|
||||
Left e -> do
|
||||
setMessage $ toHtml e
|
||||
defaultLayout $(widgetFile "ticket/new")
|
||||
Right num -> do
|
||||
eobiidFollow <- runExceptT $ do
|
||||
(summary, audience, follow) <- followTicket shrAuthor shr prj num False
|
||||
ExceptT $ followC shrAuthor summary audience follow
|
||||
case eobiidFollow of
|
||||
Left e -> setMessage $ toHtml $ "Ticket created, but following it failed: " <> e
|
||||
Right _ -> setMessage "Ticket created."
|
||||
redirect $ TicketR shr prj num
|
||||
|
|
|
|||
|
|
@ -15,7 +15,6 @@
|
|||
|
||||
module Vervis.Handler.Ticket
|
||||
( getTicketsR
|
||||
, postTicketsR
|
||||
, getTicketTreeR
|
||||
, getTicketNewR
|
||||
, getTicketR
|
||||
|
|
@ -144,100 +143,6 @@ getTicketsR shr prj = do
|
|||
jid
|
||||
defaultLayout $(widgetFile "ticket/list")
|
||||
|
||||
postTicketsR :: ShrIdent -> PrjIdent -> Handler Html
|
||||
postTicketsR shr prj = do
|
||||
wid <- runDB $ do
|
||||
sid <- getKeyBy404 $ UniqueSharer shr
|
||||
j <- getValBy404 $ UniqueProject prj sid
|
||||
return $ projectWorkflow j
|
||||
((result, widget), enctype) <- runFormPost $ newTicketForm wid
|
||||
enum <- runExceptT $ do
|
||||
NewTicket title desc tparams eparams <-
|
||||
case result of
|
||||
FormMissing -> throwE "Field(s) missing."
|
||||
FormFailure _l ->
|
||||
throwE "Ticket submission failed, see errors below."
|
||||
FormSuccess nt -> return nt
|
||||
unless (null tparams && null eparams) $
|
||||
throwE "Custom param support currently disabled"
|
||||
{-
|
||||
let mktparam (fid, v) = TicketParamText
|
||||
{ ticketParamTextTicket = tid
|
||||
, ticketParamTextField = fid
|
||||
, ticketParamTextValue = v
|
||||
}
|
||||
insertMany_ $ map mktparam $ ntTParams nt
|
||||
let mkeparam (fid, v) = TicketParamEnum
|
||||
{ ticketParamEnumTicket = tid
|
||||
, ticketParamEnumField = fid
|
||||
, ticketParamEnumValue = v
|
||||
}
|
||||
insertMany_ $ map mkeparam $ ntEParams nt
|
||||
-}
|
||||
encodeRouteLocal <- getEncodeRouteLocal
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
descHtml <- ExceptT . pure $ renderPandocMarkdown desc
|
||||
shrAuthor <- do
|
||||
Entity _ p <- requireVerifiedAuth
|
||||
lift $ runDB $ sharerIdent <$> getJust (personIdent p)
|
||||
summary <-
|
||||
TextHtml . TL.toStrict . renderHtml <$>
|
||||
withUrlRenderer
|
||||
[hamlet|
|
||||
<p>
|
||||
<a href=@{SharerR shrAuthor}>
|
||||
#{shr2text shrAuthor}
|
||||
\ offered a ticket to project #
|
||||
<a href=@{ProjectR shr prj}>
|
||||
./s/#{shr2text shr}/p/#{prj2text prj}
|
||||
: #{preEscapedToHtml title}.
|
||||
|]
|
||||
let recipsA = [ProjectR shr prj]
|
||||
recipsC = [ProjectTeamR shr prj, ProjectFollowersR shr prj]
|
||||
ticket = AP.Ticket
|
||||
{ AP.ticketLocal = Nothing
|
||||
, AP.ticketAttributedTo = encodeRouteLocal $ SharerR shrAuthor
|
||||
, AP.ticketPublished = Nothing
|
||||
, AP.ticketUpdated = Nothing
|
||||
, AP.ticketName = Nothing
|
||||
, AP.ticketSummary = TextHtml title
|
||||
, AP.ticketContent = TextHtml descHtml
|
||||
, AP.ticketSource = TextPandocMarkdown desc
|
||||
, AP.ticketAssignedTo = Nothing
|
||||
, AP.ticketIsResolved = False
|
||||
}
|
||||
offer = Offer
|
||||
{ offerObject = ticket
|
||||
, offerTarget = encodeRouteHome $ ProjectR shr prj
|
||||
}
|
||||
audience = Audience
|
||||
{ audienceTo = map encodeRouteHome $ recipsA ++ recipsC
|
||||
, audienceBto = []
|
||||
, audienceCc = []
|
||||
, audienceBcc = []
|
||||
, audienceGeneral = []
|
||||
, audienceNonActors = map encodeRouteHome recipsC
|
||||
}
|
||||
obiid <- ExceptT $ offerTicketC shrAuthor summary audience offer
|
||||
ExceptT $ runDB $ do
|
||||
mtal <- getValBy $ UniqueTicketAuthorLocalOffer obiid
|
||||
case mtal of
|
||||
Nothing ->
|
||||
return $
|
||||
Left
|
||||
"Offer processed successfully but no ticket \
|
||||
\created"
|
||||
Just tal ->
|
||||
Right . ticketNumber <$>
|
||||
getJust (ticketAuthorLocalTicket tal)
|
||||
case enum of
|
||||
Left e -> do
|
||||
setMessage $ toHtml e
|
||||
defaultLayout $(widgetFile "ticket/new")
|
||||
Right num -> do
|
||||
setMessage "Ticket created."
|
||||
redirect $ TicketR shr prj num
|
||||
|
||||
getTicketTreeR :: ShrIdent -> PrjIdent -> Handler Html
|
||||
getTicketTreeR shr prj = do
|
||||
(summaries, deps) <- runDB $ do
|
||||
|
|
|
|||
Loading…
Reference in a new issue