Make the DB migrations not depend on current model

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
 
     UniqueRemoteDiscussionIdent instance ident
     UniqueRemoteDiscussion discuss

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
 

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

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
 

migrations/2019_03_30.model

@@ -0,0 +1,6 @@
+OutboxItem
+    person    PersonId
+    activity  PersistJSONValue
+    published UTCTime
+
+FollowerSet

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

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

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
+                return $ route2fed $ TicketR shr prj $ ticketNumber t
-                    ( route2fed $ ProjectR shr prj
-                    , route2fed $ TicketR shr prj $ ticketNumber t
-                    )
             (Nothing, Just rd) -> do
-                let iid = remoteDiscussionInstance rd
+                i <- getJust $ remoteDiscussionInstance rd
-                i <- getJust iid
+                return $ l2f (instanceHost i) (remoteDiscussionIdent rd)
-                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)
-                    )
     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

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

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]
+                        selectKeysList [] [Asc Sharer2016Id, LimitTo 1]
-                    for_ msid $ \ sid -> do
+                    for_ msid $ \ sid ->
-                        let ident = text2wfl "dummy"
+                        insertKey key $
-                            w = Workflow2016 sid ident Nothing Nothing
+                            Workflow2016 sid "dummy" Nothing Nothing
-                        insertKey key w
       -- 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))

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