Generate an Offer Ticket for every ticket, including project inbox item
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:
parent
0aaec575d9
commit
1fb1829f6e
5 changed files with 211 additions and 9 deletions
|
@ -306,8 +306,10 @@ Ticket
|
||||||
TicketAuthorLocal
|
TicketAuthorLocal
|
||||||
ticket TicketId
|
ticket TicketId
|
||||||
author PersonId
|
author PersonId
|
||||||
|
offer OutboxItemId
|
||||||
|
|
||||||
UniqueTicketAuthorLocal ticket
|
UniqueTicketAuthorLocal ticket
|
||||||
|
UniqueTicketAuthorLocalOffer offer
|
||||||
|
|
||||||
TicketAuthorRemote
|
TicketAuthorRemote
|
||||||
ticket TicketId
|
ticket TicketId
|
||||||
|
|
84
migrations/2019_06_12.model
Normal file
84
migrations/2019_06_12.model
Normal 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
|
|
@ -177,7 +177,7 @@ postTicketsR shar proj = do
|
||||||
, ticketFollowers = fsid
|
, ticketFollowers = fsid
|
||||||
}
|
}
|
||||||
tid <- insert ticket
|
tid <- insert ticket
|
||||||
insert_ $ TicketAuthorLocal tid author
|
insert_ $ TicketAuthorLocal tid author $ error "TODO offer"
|
||||||
let mktparam (fid, v) = TicketParamText
|
let mktparam (fid, v) = TicketParamText
|
||||||
{ ticketParamTextTicket = tid
|
{ ticketParamTextTicket = tid
|
||||||
, ticketParamTextField = fid
|
, ticketParamTextField = fid
|
||||||
|
|
|
@ -46,12 +46,15 @@ import Database.Persist.Schema (SchemaT, Migration)
|
||||||
import Database.Persist.Schema.Types hiding (Entity)
|
import Database.Persist.Schema.Types hiding (Entity)
|
||||||
import Database.Persist.Schema.PostgreSQL (schemaBackend)
|
import Database.Persist.Schema.PostgreSQL (schemaBackend)
|
||||||
import Database.Persist.Sql (SqlBackend, toSqlKey)
|
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.QuasiQuotation (email
|
||||||
import Text.Email.Validate (unsafeEmailAddress)
|
import Text.Email.Validate (unsafeEmailAddress)
|
||||||
import Web.Hashids
|
import Web.Hashids
|
||||||
import Web.PathPieces (toPathPiece)
|
import Web.PathPieces (toPathPiece)
|
||||||
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
import qualified Data.Text.Lazy as TL
|
||||||
import qualified Database.Esqueleto as E
|
import qualified Database.Esqueleto as E
|
||||||
|
|
||||||
import qualified Database.Persist.Schema as S
|
import qualified Database.Persist.Schema as S
|
||||||
|
@ -68,7 +71,7 @@ import Data.Either.Local
|
||||||
import Database.Persist.Local
|
import Database.Persist.Local
|
||||||
|
|
||||||
import Vervis.Model.Ident
|
import Vervis.Model.Ident
|
||||||
import Vervis.Foundation (Route (..))
|
import Vervis.Foundation (App, Route (..))
|
||||||
import Vervis.Migration.Model
|
import Vervis.Migration.Model
|
||||||
import Yesod.RenderSource
|
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 :: Monad m => Apply m -> Mig m -> Apply m -> Mig m
|
||||||
--withPrePost pre (validate, apply) post = (validate, pre >> apply >> post)
|
--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 =
|
changes hLocal ctx =
|
||||||
[ -- 1
|
[ -- 1
|
||||||
addEntities model_2016_08_04
|
addEntities model_2016_08_04
|
||||||
|
@ -355,10 +358,6 @@ changes hLocal ctx =
|
||||||
case mobid of
|
case mobid of
|
||||||
Just k -> return k
|
Just k -> return k
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
-- Figure out:
|
|
||||||
-- * aud
|
|
||||||
-- * uContext
|
|
||||||
-- * muParent
|
|
||||||
m <- getJust $ localMessage201905Rest lm
|
m <- getJust $ localMessage201905Rest lm
|
||||||
|
|
||||||
let did = message201905Root m
|
let did = message201905Root m
|
||||||
|
@ -669,10 +668,114 @@ changes hLocal ctx =
|
||||||
-- 113
|
-- 113
|
||||||
, addUnique "TicketAuthorRemote" $
|
, addUnique "TicketAuthorRemote" $
|
||||||
Unique "UniqueTicketAuthorRemoteOffer" ["offer"]
|
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
|
migrateDB
|
||||||
:: MonadSite m
|
:: (MonadSite m, SiteEnv m ~ App)
|
||||||
=> Text -> HashidsContext -> ReaderT SqlBackend m (Either Text (Int, Int))
|
=> Text -> HashidsContext -> ReaderT SqlBackend m (Either Text (Int, Int))
|
||||||
migrateDB hLocal ctx =
|
migrateDB hLocal ctx =
|
||||||
let f cs = fmap (, length cs) <$> runMigrations schemaBackend 1 cs
|
let f cs = fmap (, length cs) <$> runMigrations schemaBackend 1 cs
|
||||||
|
|
|
@ -81,6 +81,16 @@ module Vervis.Migration.Model
|
||||||
, RemoteMessage2019FillGeneric (..)
|
, RemoteMessage2019FillGeneric (..)
|
||||||
, FollowerSet20190610Generic (..)
|
, FollowerSet20190610Generic (..)
|
||||||
, Project20190610
|
, Project20190610
|
||||||
|
, Sharer20190612Generic (..)
|
||||||
|
, Person20190612Generic (..)
|
||||||
|
, OutboxItem20190612Generic (..)
|
||||||
|
, Inbox20190612Generic (..)
|
||||||
|
, InboxItem20190612Generic (..)
|
||||||
|
, InboxItemLocal20190612Generic (..)
|
||||||
|
, Project20190612Generic (..)
|
||||||
|
, Ticket20190612Generic (..)
|
||||||
|
, Ticket20190612
|
||||||
|
, TicketAuthorLocal20190612Generic (..)
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
@ -104,7 +114,7 @@ import Vervis.Model.Role
|
||||||
import Vervis.Model.TH (modelFile, makeEntitiesMigration)
|
import Vervis.Model.TH (modelFile, makeEntitiesMigration)
|
||||||
import Vervis.Model.Workflow
|
import Vervis.Model.Workflow
|
||||||
|
|
||||||
-- For migration 77
|
-- For migrations 77, 114
|
||||||
|
|
||||||
import Data.Int
|
import Data.Int
|
||||||
|
|
||||||
|
@ -188,3 +198,6 @@ makeEntitiesMigration "2019Fill"
|
||||||
|
|
||||||
makeEntitiesMigration "20190610"
|
makeEntitiesMigration "20190610"
|
||||||
$(modelFile "migrations/2019_06_10.model")
|
$(modelFile "migrations/2019_06_10.model")
|
||||||
|
|
||||||
|
makeEntitiesMigration "20190612"
|
||||||
|
$(modelFile "migrations/2019_06_12.model")
|
||||||
|
|
Loading…
Reference in a new issue