forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Generate an Offer Ticket for every ticket, including project inbox item

Browse source 
CRITICAL: Due to the requirement that each new ticket points to its Offer
activity, ticket creation has been disabled! The next patches should implement
C2S submission of Offer Ticket, and then ticket creation will work again. Sorry
for that.
This commit is contained in:
fr33domlover 2019-06-14 17:45:37 +00:00
parent 0aaec575d9
commit 1fb1829f6e
5 changed files with 211 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
config/models
View file

@ -306,8 +306,10 @@ Ticket
TicketAuthorLocal
ticket TicketId
author PersonId
offer OutboxItemId
UniqueTicketAuthorLocal ticket
UniqueTicketAuthorLocalOffer offer
TicketAuthorRemote
ticket TicketId

84
migrations/2019_06_12.model Normal file
View file

@ -0,0 +1,84 @@
Sharer
ident ShrIdent
name Text Maybe
created UTCTime
UniqueSharer ident
Person
ident SharerId
login Text
passphraseHash ByteString
email Text
verified Bool
verifiedKey Text
verifiedKeyCreated UTCTime
resetPassKey Text
resetPassKeyCreated UTCTime
about Text
inbox InboxId
UniquePersonIdent ident
UniquePersonLogin login
UniquePersonEmail email
UniquePersonInbox inbox
OutboxItem
person PersonId
activity PersistActivity
published UTCTime
Inbox
InboxItem
unread Bool
InboxItemLocal
inbox InboxId
activity OutboxItemId
item InboxItemId
UniqueInboxItemLocal inbox activity
UniqueInboxItemLocalItem item
Project
ident PrjIdent
sharer SharerId
name Text Maybe
desc Text Maybe
workflow Int64
nextTicket Int
wiki Int64 Maybe
collabUser Int64 Maybe
collabAnon Int64 Maybe
inbox InboxId
followers Int64
UniqueProject ident sharer
UniqueProjectInbox inbox
UniqueProjectFollowers followers
Ticket
project ProjectId
number Int
created UTCTime
title Text
source Text -- Pandoc Markdown
description Text -- HTML
assignee PersonId Maybe
status Text
closed UTCTime
closer PersonId Maybe
discuss Int64
followers Int64
UniqueTicket project number
UniqueTicketDiscussion discuss
UniqueTicketFollowers followers
TicketAuthorLocal
ticket TicketId
author PersonId
offer OutboxItemId
UniqueTicketAuthorLocal ticket

2
src/Vervis/Handler/Ticket.hs
View file

@ -177,7 +177,7 @@ postTicketsR shar proj = do
, ticketFollowers = fsid
}
tid <- insert ticket
insert_ $ TicketAuthorLocal tid author
insert_ $ TicketAuthorLocal tid author $ error "TODO offer"
let mktparam (fid, v) = TicketParamText
{ ticketParamTextTicket = tid
, ticketParamTextField = fid

117
src/Vervis/Migration.hs
View file

@ -46,12 +46,15 @@ import Database.Persist.Schema (SchemaT, Migration)
import Database.Persist.Schema.Types hiding (Entity)
import Database.Persist.Schema.PostgreSQL (schemaBackend)
import Database.Persist.Sql (SqlBackend, toSqlKey)
import Text.Blaze.Html (toHtml)
import Text.Blaze.Html.Renderer.Text
--import Text.Email.QuasiQuotation (email
import Text.Email.Validate (unsafeEmailAddress)
import Web.Hashids
import Web.PathPieces (toPathPiece)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Database.Esqueleto as E
import qualified Database.Persist.Schema as S
@ -68,7 +71,7 @@ import Data.Either.Local
import Database.Persist.Local
import Vervis.Model.Ident
import Vervis.Foundation (Route (..))
import Vervis.Foundation (App, Route (..))
import Vervis.Migration.Model
import Yesod.RenderSource
@ -87,7 +90,7 @@ withPrepare (validate, apply) prepare = (validate, prepare >> apply)
--withPrePost :: Monad m => Apply m -> Mig m -> Apply m -> Mig m
--withPrePost pre (validate, apply) post = (validate, pre >> apply >> post)
changes :: MonadSite m => Text -> HashidsContext -> [Mig m]
changes :: (MonadSite m, SiteEnv m ~ App) => Text -> HashidsContext -> [Mig m]
changes hLocal ctx =
[ -- 1
addEntities model_2016_08_04
@ -355,10 +358,6 @@ changes hLocal ctx =
case mobid of
Just k -> return k
Nothing -> do
-- Figure out:
-- * aud
-- * uContext
-- * muParent
m <- getJust $ localMessage201905Rest lm
let did = message201905Root m
@ -669,10 +668,114 @@ changes hLocal ctx =
-- 113
, addUnique "TicketAuthorRemote" $
Unique "UniqueTicketAuthorRemoteOffer" ["offer"]
-- 114
, addFieldRefRequired''
"TicketAuthorLocal"
(do let user = "$$temp$$"
sid <-
insert $ Sharer20190612 (text2shr user) Nothing defaultTime
ibid <- insert Inbox20190612
pid <-
insert $
Person20190612
sid user "" "e@ma.il" False "" defaultTime ""
defaultTime "" ibid
let localUri = LocalURI "/x/y" ""
fedUri = l2f "x.y" localUri
doc = Doc "x.y" Activity
{ activityId = localUri
, activityActor = localUri
, activityAudience = Audience [] [] [] [] [] []
, activitySpecific = AcceptActivity $ Accept fedUri
}
insertEntity $ OutboxItem20190612 pid (PersistJSON doc) defaultTime
)
(Just $ \ (Entity obidTemp obTemp) -> do
ts <- selectList ([] :: [Filter Ticket20190612]) []
for_ ts $ \ (Entity tid ticket) -> do
let num = ticket20190612Number ticket
j <- getJust $ ticket20190612Project ticket
let prj = project20190612Ident j
ibidProject = project20190612Inbox j
sProject <- getJust $ project20190612Sharer j
let shrProject = sharer20190612Ident sProject
Entity talid tal <-
fromJust <$> getBy (UniqueTicketAuthorLocal20190612 tid)
let pidAuthor = ticketAuthorLocal20190612Author tal
pAuthor <- getJust pidAuthor
sAuthor <- getJust $ person20190612Ident pAuthor
let shrAuthor = sharer20190612Ident sAuthor
encodeRouteLocal <- getEncodeRouteLocal
encodeRouteHome <- getEncodeRouteHome
let recips = map encodeRouteHome
[ ProjectR shrProject prj
, ProjectTeamR shrProject prj
, ProjectFollowersR shrProject prj
]
author = encodeRouteLocal $ SharerR shrAuthor
ticketAP = Ticket
{ ticketLocal = Nothing
, ticketAttributedTo = author
, ticketPublished =
Just $ ticket20190612Created ticket
, ticketUpdated = Nothing
, ticketName = Just $ "#" <> T.pack (show num)
, ticketSummary =
TextHtml $ TL.toStrict $ renderHtml $ toHtml $
ticket20190612Title ticket
, ticketContent =
TextHtml $ ticket20190612Description ticket
, ticketSource =
TextPandocMarkdown $ ticket20190612Source ticket
, ticketAssignedTo = Nothing
, ticketIsResolved = False
, ticketDependsOn = []
, ticketDependedBy = []
}
doc luAct = Doc hLocal Activity
{ activityId = luAct
, activityActor = author
, activityAudience = Audience recips [] [] [] [] []
, activitySpecific = OfferActivity Offer
{ offerObject = ticketAP
, offerTarget =
encodeRouteHome $ ProjectR shrProject prj
}
}
tempUri = LocalURI "" ""
obidNew <- insert OutboxItem20190612
{ outboxItem20190612Person = pidAuthor
, outboxItem20190612Activity = PersistJSON $ doc tempUri
, outboxItem20190612Published =
ticket20190612Created ticket
}
obkhidNew <-
encodeKeyHashid $ E.toSqlKey $ E.fromSqlKey obidNew
let luAct = encodeRouteLocal $ OutboxItemR shrAuthor obkhidNew
act = doc luAct
update obidNew [OutboxItem20190612Activity =. PersistJSON act]
update talid [TicketAuthorLocal20190612Offer =. obidNew]
ibiid <- insert $ InboxItem20190612 False
insert_ $ InboxItemLocal20190612 ibidProject obidNew ibiid
delete obidTemp
let pidTemp = outboxItem20190612Person obTemp
pTemp <- getJust pidTemp
delete pidTemp
delete $ person20190612Ident pTemp
delete $ person20190612Inbox pTemp
)
"offer"
"OutboxItem"
-- 115
, addUnique "TicketAuthorLocal" $
Unique "UniqueTicketAuthorLocaleOffer" ["offer"]
]
migrateDB
:: MonadSite m
:: (MonadSite m, SiteEnv m ~ App)
=> Text -> HashidsContext -> ReaderT SqlBackend m (Either Text (Int, Int))
migrateDB hLocal ctx =
let f cs = fmap (, length cs) <$> runMigrations schemaBackend 1 cs

15
src/Vervis/Migration/Model.hs
View file

@ -81,6 +81,16 @@ module Vervis.Migration.Model
, RemoteMessage2019FillGeneric (..)
, FollowerSet20190610Generic (..)
, Project20190610
, Sharer20190612Generic (..)
, Person20190612Generic (..)
, OutboxItem20190612Generic (..)
, Inbox20190612Generic (..)
, InboxItem20190612Generic (..)
, InboxItemLocal20190612Generic (..)
, Project20190612Generic (..)
, Ticket20190612Generic (..)
, Ticket20190612
, TicketAuthorLocal20190612Generic (..)
)
where
@ -104,7 +114,7 @@ import Vervis.Model.Role
import Vervis.Model.TH (modelFile, makeEntitiesMigration)
import Vervis.Model.Workflow
-- For migration 77
-- For migrations 77, 114
import Data.Int
@ -188,3 +198,6 @@ makeEntitiesMigration "2019Fill"
makeEntitiesMigration "20190610"
$(modelFile "migrations/2019_06_10.model")
makeEntitiesMigration "20190612"
$(modelFile "migrations/2019_06_12.model")