sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-27 01:04:50 +09:00
Code Issues Activity

Make the DB migrations not depend on current model

Browse source
This commit is contained in:
fr33domlover 2019-04-11 13:26:57 +00:00
parent b31c6fe0ef
commit 7dda068ba3
11 changed files with 108 additions and 68 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
config/models
View file

@ -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

17
migrations/2016_09_01_just_workflow.model
View file

@ -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

16
migrations/2016_09_01_just_workflow_prepare.model Normal file
View file

@ -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

9
migrations/2019_03_19.model
View file

@ -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

6
migrations/2019_03_30.model Normal file
View file

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

8
migrations/2019_03_30_follower_set.model Normal file
View file

@ -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

1
src/Vervis/Form/Ticket.hs
View file

@ -136,6 +136,7 @@ editTicketContentAForm ticket = Ticket
<*> pure (ticketClosed ticket)
<*> pure (ticketCloser ticket)
<*> pure (ticketDiscuss ticket)
<*> pure (ticketFollowers ticket)
tEditField
:: TicketTextParam

32
src/Vervis/Handler/Discussion.hs
View file

@ -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

2
src/Vervis/Handler/Ticket.hs
View file

@ -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

45
src/Vervis/Migration.hs
View file

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

16
src/Vervis/Migration/Model.hs
View file

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