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")