diff --git a/config/models b/config/models index 3b253c4..f86b1e3 100644 --- a/config/models +++ b/config/models @@ -75,6 +75,20 @@ Instance UniqueInstance host +FollowerSet + +Follow + person PersonId + target FollowerSetId + + UniqueFollow person target + +RemoteFollow + actor RemoteSharerId + target FollowerSetId + + UniqueRemoteFollow actor target + SshKey ident KyIdent person PersonId @@ -209,9 +223,11 @@ Ticket closed UTCTime closer PersonId discuss DiscussionId + followers FollowerSetId UniqueTicket project number UniqueTicketDiscussion discuss + UniqueTicketFollowers followers TicketDependency parent TicketId @@ -230,11 +246,9 @@ TicketClaimRequest Discussion RemoteDiscussion - actor RemoteSharerId Maybe - instance InstanceId - ident LocalURI - discuss DiscussionId - unlinkedActor FedURI Maybe + instance InstanceId + ident LocalURI + discuss DiscussionId UniqueRemoteDiscussionIdent instance ident UniqueRemoteDiscussion discuss diff --git a/migrations/2016_09_01_just_workflow.model b/migrations/2016_09_01_just_workflow.model index a7b55ed..c93edcd 100644 --- a/migrations/2016_09_01_just_workflow.model +++ b/migrations/2016_09_01_just_workflow.model @@ -1,21 +1,6 @@ --- This is in a separate file from the rest of the entities added on the same --- day because it is used for creating a dummy public workflow for DB --- migrations. Since each project is required to have a workflow, and initially --- there's none, we make a dummy one. --- --- Since the 'Sharer' entity isn't defined here, using the Workflow entity --- below with the @persistent@ model parser will probably create an 'EntityDef' --- in which the sharer field does NOT have a foreign key constraint into the --- 'Sharer' table, because the parser won't recognize that 'SharerId' is an --- entity ID and not just some other existing type. --- --- However that is okay because we're just using this entity for insertion --- once, where we make sure to use a real existing sharer ID, and we also of --- course use it for adding the entity to the database schema, but that --- mechanism has its own way to detect the foreign keys. Workflow sharer SharerId - ident WflIdent + ident Text name Text Maybe desc Text Maybe diff --git a/migrations/2016_09_01_just_workflow_prepare.model b/migrations/2016_09_01_just_workflow_prepare.model new file mode 100644 index 0000000..7ae4cb5 --- /dev/null +++ b/migrations/2016_09_01_just_workflow_prepare.model @@ -0,0 +1,16 @@ +-- This is in a separate file from the rest of the entities added on the same +-- day because it is used for creating a dummy public workflow for DB +-- migrations. Since each project is required to have a workflow, and initially +-- there's none, we make a dummy one. + +Sharer + +Project + +Workflow + sharer SharerId + ident Text + name Text Maybe + desc Text Maybe + + UniqueWorkflow sharer ident diff --git a/migrations/2019_03_19.model b/migrations/2019_03_19.model index 7eef8a3..069f589 100644 --- a/migrations/2019_03_19.model +++ b/migrations/2019_03_19.model @@ -2,17 +2,11 @@ RemoteRawObject content PersistJSONValue received UTCTime -OutboxItem - person PersonId - activity PersistJSONValue - published UTCTime - RemoteDiscussion - actor RemoteSharerId Maybe + sharer RemoteSharerId instance InstanceId ident Text discuss DiscussionId - unlinkedActor Text Maybe UniqueRemoteDiscussionIdent instance ident UniqueRemoteDiscussion discuss @@ -20,7 +14,6 @@ RemoteDiscussion LocalMessage author PersonId rest MessageId - unlinkedParent Text Maybe UniqueLocalMessage rest diff --git a/migrations/2019_03_30.model b/migrations/2019_03_30.model new file mode 100644 index 0000000..5521eca --- /dev/null +++ b/migrations/2019_03_30.model @@ -0,0 +1,6 @@ +OutboxItem + person PersonId + activity PersistJSONValue + published UTCTime + +FollowerSet diff --git a/migrations/2019_03_30_follower_set.model b/migrations/2019_03_30_follower_set.model new file mode 100644 index 0000000..25736a6 --- /dev/null +++ b/migrations/2019_03_30_follower_set.model @@ -0,0 +1,8 @@ +-- This file is used only for adding the ticketFollowers field, initially +-- inserting a single temporary FollowerSet, and later creating unique ones, +-- and finally deleting the temporary one. + +FollowerSet + +Ticket + followers FollowerSetId diff --git a/src/Vervis/Form/Ticket.hs b/src/Vervis/Form/Ticket.hs index 74e36b9..5cf861c 100644 --- a/src/Vervis/Form/Ticket.hs +++ b/src/Vervis/Form/Ticket.hs @@ -136,6 +136,7 @@ editTicketContentAForm ticket = Ticket <*> pure (ticketClosed ticket) <*> pure (ticketCloser ticket) <*> pure (ticketDiscuss ticket) + <*> pure (ticketFollowers ticket) tEditField :: TicketTextParam diff --git a/src/Vervis/Handler/Discussion.hs b/src/Vervis/Handler/Discussion.hs index 9eac968..7f35b68 100644 --- a/src/Vervis/Handler/Discussion.hs +++ b/src/Vervis/Handler/Discussion.hs @@ -106,7 +106,7 @@ getDiscussionMessage shr lmid = selectRep $ provideAP $ runDB $ do unless (localMessageAuthor lm == pid) notFound m <- getJust $ localMessageRest lm route2fed <- getEncodeRouteFed - (uRecip, uContext) <- do + uContext <- do let did = messageRoot m mt <- getValBy $ UniqueTicketDiscussion did mrd <- getValBy $ UniqueRemoteDiscussion did @@ -118,32 +118,10 @@ getDiscussionMessage shr lmid = selectRep $ provideAP $ runDB $ do s <- getJust $ projectSharer j let shr = sharerIdent s prj = projectIdent j - return - ( route2fed $ ProjectR shr prj - , route2fed $ TicketR shr prj $ ticketNumber t - ) + return $ route2fed $ TicketR shr prj $ ticketNumber t (Nothing, Just rd) -> do - let iid = remoteDiscussionInstance rd - i <- getJust iid - let hInstance = instanceHost i - mrs <- traverse getJust $ remoteDiscussionActor rd - let muActor = f2l <$> remoteDiscussionUnlinkedActor rd - luActor <- - case (mrs, muActor) of - (Nothing, Nothing) -> fail "RemoteDiscussion actor and unlinkedActor both unset" - (Just _, Just _) -> fail "RemoteDiscussion actor and unlinkedActor both set" - (Just rs, Nothing) -> do - unless (iid == remoteSharerInstance rs) $ - fail "RemoteDiscussion and its actor on different hosts" - return $ remoteSharerIdent rs - (Nothing, Just (h, lu)) -> do - unless (hInstance == h) $ - fail "RemoteDiscussion and its unlinked actor on different hosts" - return lu - return - ( l2f hInstance luActor - , l2f hInstance (remoteDiscussionIdent rd) - ) + i <- getJust $ remoteDiscussionInstance rd + return $ l2f (instanceHost i) (remoteDiscussionIdent rd) muParent <- for (messageParent m) $ \ midParent -> do mlocal <- getBy $ UniqueLocalMessage midParent mremote <- getValBy $ UniqueRemoteMessage midParent @@ -166,7 +144,7 @@ getDiscussionMessage shr lmid = selectRep $ provideAP $ runDB $ do return $ Doc host Note { noteId = Just $ route2local $ MessageR shr lmhid , noteAttrib = route2local $ SharerR shr - , noteAudience = deliverTo uRecip + , noteAudience = error "TODO noteAudience" , noteReplyTo = Just $ fromMaybe uContext muParent , noteContext = Just uContext , notePublished = Just $ messageCreated m diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs index ef87c9b..149601d 100644 --- a/src/Vervis/Handler/Ticket.hs +++ b/src/Vervis/Handler/Ticket.hs @@ -137,6 +137,7 @@ postTicketsR shar proj = do tnum <- runDB $ do update pid [ProjectNextTicket +=. 1] did <- insert Discussion + fsid <- insert FollowerSet let ticket = Ticket { ticketProject = pid , ticketNumber = projectNextTicket project @@ -149,6 +150,7 @@ postTicketsR shar proj = do , ticketClosed = UTCTime (ModifiedJulianDay 0) 0 , ticketCloser = author , ticketDiscuss = did + , ticketFollowers = fsid } tid <- insert ticket let mktparam (fid, v) = TicketParamText diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs index 468c49c..821a22d 100644 --- a/src/Vervis/Migration.hs +++ b/src/Vervis/Migration.hs @@ -49,9 +49,6 @@ import qualified Database.Esqueleto as E import qualified Database.Persist.Schema as U (addEntity, unsetFieldDefault) import Vervis.Migration.Model -import Vervis.Model -import Vervis.Model.Ident -import Vervis.Model.Workflow instance PersistDefault ByteString where pdef = def @@ -65,6 +62,9 @@ defaultTime = UTCTime (ModifiedJulianDay 0) 0 withPrepare :: Monad m => Mig m -> Apply m -> Mig m 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 :: MonadIO m => [Mig m] changes = [ -- 1 @@ -94,15 +94,14 @@ changes = "Workflow" ) $ do noProjects <- lift $ - null <$> selectKeysList [] [LimitTo 1 :: SelectOpt Project] + null <$> selectKeysList [] [LimitTo 1 :: SelectOpt Project2016] unless noProjects $ lift $ do msid <- listToMaybe <$> - selectKeysList [] [Asc SharerId, LimitTo 1] - for_ msid $ \ sid -> do - let ident = text2wfl "dummy" - w = Workflow2016 sid ident Nothing Nothing - insertKey key w + selectKeysList [] [Asc Sharer2016Id, LimitTo 1] + for_ msid $ \ sid -> + insertKey key $ + Workflow2016 sid "dummy" Nothing Nothing -- 11 , addFieldPrimRequired "Workflow" ("WSSharer" :: Text) "scope" -- 12 @@ -210,6 +209,34 @@ changes = , removeField "Message" "author" -- 49 , addUnique "Ticket" $ Unique "UniqueTicketDiscussion" ["discuss"] + -- 50 + , addEntities model_2019_03_30 + -- 51 + , let fsidTemp = fromBackendKey defaultBackendKey :: Key FollowerSet2019 + in withPrePost + (lift $ insertKey fsidTemp FollowerSet2019) + (addFieldRefRequired + "Ticket" + (toBackendKey fsidTemp) + "followers" + "FollowerSet" + ) + (lift $ do + tids <- selectKeysList ([] :: [Filter Ticket2019]) [] + for_ tids $ \ tid -> do + fsid <- insert FollowerSet2019 + update tid [Ticket2019Followers =. fsid] + delete fsidTemp + ) + -- 52 + , addUnique "Ticket" $ Unique "UniqueTicketFollowers" ["followers"] + -- 53 + , removeField "RemoteDiscussion" "sharer" + -- 54 + , addFieldPrimOptional + "LocalMessage" + (Nothing :: Maybe Text) + "unlinkedParent" ] migrateDB :: MonadIO m => ReaderT SqlBackend m (Either Text (Int, Int)) diff --git a/src/Vervis/Migration/Model.hs b/src/Vervis/Migration/Model.hs index 3dfd014..b67ff14 100644 --- a/src/Vervis/Migration/Model.hs +++ b/src/Vervis/Migration/Model.hs @@ -17,6 +17,8 @@ module Vervis.Migration.Model ( EntityField (..) , model_2016_08_04 , model_2016_09_01_just_workflow + , Sharer2016 + , Project2016 , Workflow2016Generic (..) , Workflow2016 , model_2016_09_01_rest @@ -30,12 +32,15 @@ module Vervis.Migration.Model , LocalMessage2019Generic (..) , LocalMessage2019 , model_2019_03_19 + , model_2019_03_30 + , FollowerSet2019Generic (..) + , FollowerSet2019 + , Ticket2019 ) where import Prelude -import Data.Aeson (Value) import Data.ByteString (ByteString) import Data.Text (Text) import Data.Time (UTCTime) @@ -52,7 +57,6 @@ import Vervis.Model.Ident import Vervis.Model.Repo import Vervis.Model.Role import Vervis.Model.TH (modelFile, makeEntitiesMigration) -import Vervis.Model.Ticket import Vervis.Model.Workflow model_2016_08_04 :: [Entity SqlBackend] @@ -62,7 +66,7 @@ model_2016_09_01_just_workflow :: [Entity SqlBackend] model_2016_09_01_just_workflow = $(schema "2016_09_01_just_workflow") makeEntitiesMigration "2016" - $(modelFile "migrations/2016_09_01_just_workflow.model") + $(modelFile "migrations/2016_09_01_just_workflow_prepare.model") model_2016_09_01_rest :: [Entity SqlBackend] model_2016_09_01_rest = $(schema "2016_09_01_rest") @@ -81,3 +85,9 @@ makeEntitiesMigration "2019" model_2019_03_19 :: [Entity SqlBackend] model_2019_03_19 = $(schema "2019_03_19") + +model_2019_03_30 :: [Entity SqlBackend] +model_2019_03_30 = $(schema "2019_03_30") + +makeEntitiesMigration "2019" + $(modelFile "migrations/2019_03_30_follower_set.model")