From 1fb1829f6e4585b6acca67f86ae2c69d919a09ab Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Fri, 14 Jun 2019 17:45:37 +0000 Subject: [PATCH] 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. --- config/models | 2 + migrations/2019_06_12.model | 84 ++++++++++++++++++++++++ src/Vervis/Handler/Ticket.hs | 2 +- src/Vervis/Migration.hs | 117 ++++++++++++++++++++++++++++++++-- src/Vervis/Migration/Model.hs | 15 ++++- 5 files changed, 211 insertions(+), 9 deletions(-) create mode 100644 migrations/2019_06_12.model diff --git a/config/models b/config/models index ffded75..0544d83 100644 --- a/config/models +++ b/config/models @@ -306,8 +306,10 @@ Ticket TicketAuthorLocal ticket TicketId author PersonId + offer OutboxItemId UniqueTicketAuthorLocal ticket + UniqueTicketAuthorLocalOffer offer TicketAuthorRemote ticket TicketId diff --git a/migrations/2019_06_12.model b/migrations/2019_06_12.model new file mode 100644 index 0000000..ed3656a --- /dev/null +++ b/migrations/2019_06_12.model @@ -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 diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs index cb76842..cf5c052 100644 --- a/src/Vervis/Handler/Ticket.hs +++ b/src/Vervis/Handler/Ticket.hs @@ -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 diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs index 767782e..cde8e2c 100644 --- a/src/Vervis/Migration.hs +++ b/src/Vervis/Migration.hs @@ -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 diff --git a/src/Vervis/Migration/Model.hs b/src/Vervis/Migration/Model.hs index 9d61f72..13a5809 100644 --- a/src/Vervis/Migration/Model.hs +++ b/src/Vervis/Migration/Model.hs @@ -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")