{- This file is part of Vervis. - - Written in 2016, 2018, 2019 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - - The author(s) have dedicated all copyright and related and neighboring - rights to this software to the public domain worldwide. This software is - distributed without any warranty. - - You should have received a copy of the CC0 Public Domain Dedication along - with this software. If not, see - . -} module Vervis.Migration ( migrateDB ) where import Control.Applicative import Control.Exception import Control.Monad (unless) import Control.Monad.IO.Class import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Maybe import Control.Monad.Trans.Reader (ReaderT, runReaderT) import Data.ByteString (ByteString) import Data.Default.Class import Data.Default.Instances.ByteString () import Data.Foldable (traverse_, for_) import Data.List (nub) import Data.Maybe import Data.Proxy import Data.Text (Text) import Data.Text.Encoding (encodeUtf8) import Data.Time.Calendar (Day (..)) import Data.Time.Clock import Data.Traversable import Database.Persist import Database.Persist.BackendDataType (backendDataType, PersistDefault (..)) import Database.Persist.Migration 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 Text.Hamlet 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 import qualified Database.Persist.Schema.Types as ST import Network.FedURI import Database.Persist.JSON import Web.ActivityPub import Yesod.FedURI import Yesod.Hashids import Yesod.MonadSite import Data.Either.Local import Database.Persist.Local import Vervis.Model.Ident import Vervis.Foundation (App, Route (..)) import Vervis.Migration.Model import Yesod.RenderSource instance PersistDefault ByteString where pdef = def type Apply m = SchemaT SqlBackend m () type Mig m = Migration SqlBackend m defaultTime :: UTCTime 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 :: (MonadSite m, SiteEnv m ~ App) => Text -> HashidsContext -> [Mig m] changes hLocal ctx = [ -- 1 addEntities model_2016_08_04 -- 2 , unchecked $ S.unsetFieldDefault "Sharer" "created" -- 3 , unchecked $ S.unsetFieldDefault "Project" "nextTicket" -- 4 , unchecked $ S.unsetFieldDefault "Repo" "vcs" -- 5 , unchecked $ S.unsetFieldDefault "Repo" "mainBranch" -- 6 , removeField "Ticket" "done" -- 7 , addFieldPrimRequired "Ticket" ("TSNew" :: Text) "status" -- 8 , addEntities model_2016_09_01_just_workflow -- 9 , addEntities model_2016_09_01_rest -- 10 , let key = fromBackendKey defaultBackendKey :: Key Workflow2016 in withPrepare (addFieldRefRequired "Project" (toBackendKey key) "workflow" "Workflow" ) $ do noProjects <- lift $ null <$> selectKeysList [] [LimitTo 1 :: SelectOpt Project2016] unless noProjects $ lift $ do msid <- listToMaybe <$> selectKeysList [] [Asc Sharer2016Id, LimitTo 1] for_ msid $ \ sid -> insertKey key $ Workflow2016 sid "dummy" Nothing Nothing -- 11 , addFieldPrimRequired "Workflow" ("WSSharer" :: Text) "scope" -- 12 , unsetFieldPrimMaybe "Person" "hash" ("" :: Text) -- 13 , changeFieldTypePrimRequiredFreeHs "Person" "hash" encodeUtf8 -- 14 --, unsetFieldPrimMaybe "Person" "email" [email|noreply@no.such.email|] , unsetFieldPrimMaybe "Person" "email" $ unsafeEmailAddress "noreply" "no.such.email" -- 15 , addFieldPrimRequired "Person" True "verified" -- 16 , addFieldPrimRequired "Person" ("" :: Text) "verifiedKey" -- 17 , addFieldPrimRequired "Person" ("" :: Text) "resetPassphraseKey" -- 18 , renameField "Person" "hash" "passphraseHash" -- 19 , renameField "Person" "resetPassphraseKey" "resetPassKey" -- 20 , addFieldPrimRequired "Person" defaultTime "verifiedKeyCreated" -- 21 , addFieldPrimRequired "Person" defaultTime "resetPassKeyCreated" -- 22 , addUnique "Person" $ Unique "UniquePersonEmail" ["email"] -- 23 , renameField "ProjectCollabAnon" "repo" "project" -- 24 , renameField "ProjectCollabUser" "repo" "project" -- 25 , addFieldPrimRequired "Person" ("" :: Text) "about" -- 26 , setFieldMaybe "ProjectCollab" "role" -- 27 , removeField "RepoCollab" "role" -- 28 , addFieldRefOptional "RepoCollab" Nothing "role" "ProjectRole" -- 29 , removeEntity "RepoCollabAnon" -- 30 , removeEntity "RepoCollabUser" -- 31 , addFieldRefOptional "Repo" Nothing "collabUser" "ProjectRole" -- 32 , addFieldRefOptional "Repo" Nothing "collabAnon" "ProjectRole" -- 33 , addFieldRefOptional "Project" Nothing "collabUser" "ProjectRole" -- 34 , addFieldRefOptional "Project" Nothing "collabAnon" "ProjectRole" -- 35 , unchecked $ lift $ do l <- E.select $ E.from $ \ (j `E.LeftOuterJoin` jcu `E.LeftOuterJoin` jca) -> do E.on $ E.just (j E.^. Project2018Id) E.==. jca E.?. ProjectCollabAnon2018Project E.on $ E.just (j E.^. Project2018Id) E.==. jcu E.?. ProjectCollabUser2018Project E.where_ $ E.not_ $ E.isNothing (jcu E.?. ProjectCollabUser2018Project) E.&&. E.isNothing (jca E.?. ProjectCollabAnon2018Project) return ( j E.^. Project2018Id , jca E.?. ProjectCollabAnon2018Role , jcu E.?. ProjectCollabUser2018Role ) for_ l $ \ (E.Value jid, E.Value malid, E.Value mulid) -> update jid [ Project2018CollabAnon =. malid , Project2018CollabUser =. mulid ] -- 36 , removeEntity "ProjectCollabAnon" -- 37 , removeEntity "ProjectCollabUser" -- 38 , removeEntity "RepoAccess" -- 39 , removeEntity "RepoRoleInherit" -- 40 , removeEntity "RepoRole" -- 41 , addEntities model_2019_02_03_verifkey -- 42 , unchecked $ lift $ do deleteWhere ([] :: [Filter VerifKeySharedUsage2019]) deleteWhere ([] :: [Filter VerifKey2019]) -- 43 , removeUnique "Message" "UniqueMessage" -- 44 , removeField "Message" "number" -- 45 , removeField "Discussion" "nextMessage" -- 46 , addEntities model_2019_03_19 -- 47 , unchecked $ lift $ do msgs <- selectList ([] :: [Filter Message2019]) [] let mklocal (Entity mid m) = LocalMessage2019 (message2019Author m) mid insertMany_ $ map mklocal msgs -- 48 , removeField "Message" "author" -- 49 , addUnique "Ticket" $ Unique "UniqueTicketDiscussion" ["discuss"] -- 50 , addEntities model_2019_03_30 -- 51 , addFieldRefRequired' "Ticket" FollowerSet2019 (Just $ do tids <- selectKeysList ([] :: [Filter Ticket2019]) [] for_ tids $ \ tid -> do fsid <- insert FollowerSet2019 update tid [Ticket2019Followers =. fsid] ) "followers" "FollowerSet" -- 52 , addUnique "Ticket" $ Unique "UniqueTicketFollowers" ["followers"] -- 53 , removeField "RemoteDiscussion" "sharer" -- 54 , addFieldPrimOptional "LocalMessage" (Nothing :: Maybe Text) "unlinkedParent" -- 55 , addEntities model_2019_04_11 -- 56 , renameEntity "RemoteSharer" "RemoteActor" -- 57 , renameUnique "RemoteActor" "UniqueRemoteSharer" "UniqueRemoteActor" -- 58 , addFieldPrimOptional "RemoteActor" (Nothing :: Maybe UTCTime) "errorSince" -- 59 , addEntities model_2019_04_12 -- 60 , addEntities model_2019_04_22 -- 61 , addFieldRefRequiredEmpty "RemoteMessage" "create" "RemoteActivity" -- 62 , removeField "RemoteMessage" "raw" -- 63 , removeEntity "RemoteRawObject" -- 64 , addFieldPrimRequired "UnlinkedDelivery" True "forwarding" -- 65 , addFieldPrimRequired "Delivery" True "forwarding" -- 66 , addEntities model_2019_05_03 -- 67 , addFieldPrimRequired "Follow" False "manual" -- 68 , addFieldPrimRequired "RemoteFollow" False "manual" -- 69 , addEntity $ ST.Entity "InboxItem" [] [] -- 70 , addFieldRefRequiredEmpty "InboxItemLocal" "item" "InboxItem" -- 71 , addFieldRefRequiredEmpty "InboxItemRemote" "item" "InboxItem" -- 72 , addUnique "InboxItemLocal" $ Unique "UniqueInboxItemLocalItem" ["item"] -- 73 , addUnique "InboxItemRemote" $ Unique "UniqueInboxItemRemoteItem" ["item"] -- 74 , addEntities model_2019_05_17 -- 75 , addFieldPrimOptional "RemoteActor" (Nothing :: Maybe Text) "name" -- 76 , addFieldPrimRequired "InboxItem" False "unread" -- 77 , addFieldRefRequired'' "LocalMessage" (do let user = "$$temp$$" sid <- insert $ Sharer201905 (text2shr user) Nothing defaultTime pid <- insert $ Person201905 sid user "" "e@ma.il" False "" defaultTime "" defaultTime "" let localUri = LocalURI "/x/y" "" fedUri = l2f "x.y" localUri doc = Doc "x.y" Activity { activityId = localUri , activityActor = localUri , activitySummary = Nothing , activityAudience = Audience [] [] [] [] [] [] , activitySpecific = AcceptActivity $ Accept fedUri } insertEntity $ OutboxItem201905 pid (PersistJSON doc) defaultTime ) (Just $ \ (Entity obid ob) -> do let actNoteId (Activity _ _ _ _ (CreateActivity (Create note))) = noteId note actNoteId _ = Nothing obNoteId (Entity i o) = if i == obid then Nothing else (,i) <$> actNoteId (docValue $ persistJSONValue $ outboxItem201905Activity o) obs <- mapMaybe obNoteId <$> selectList ([] :: [Filter OutboxItem201905]) [] lms <- selectList ([] :: [Filter LocalMessage201905]) [] for_ lms $ \ (Entity lmid lm) -> do let pid = localMessage201905Author lm p <- getJust pid s <- getJust $ person201905Ident p let shr = sharer201905Ident s route = MessageR shr (encodeKeyHashidPure ctx $ E.toSqlKey $ E.fromSqlKey lmid) match (luNote, obid') = case decodeRouteLocal luNote of Just r@(MessageR _ _) -> if r == route then Just obid' else Nothing _ -> error "Invalid local luNote" mobid = case mapMaybe match obs of [] -> Nothing [k] -> Just k _ -> error "Multiple outbox IDs!" obidNew <- case mobid of Just k -> return k Nothing -> do m <- getJust $ localMessage201905Rest lm let did = message201905Root m mcontext <- runMaybeT $ Left <$> MaybeT (getValBy $ UniqueTicketDiscussion201905 did) <|> Right <$> MaybeT (getValBy $ UniqueRemoteDiscussion201905 did) let context = case mcontext of Nothing -> error "DiscussionId not used" Just c -> c (uContext, recips) <- case context of Left t -> do j <- getJust $ ticket201905Project t let tprj = project201905Ident j s <- getJust $ project201905Sharer j let tshr = sharer201905Ident s jPath = T.concat [ "/s/", shr2text tshr , "/p/", prj2text tprj ] tPath = T.concat [ jPath , "/t/", T.pack $ show $ ticket201905Number t ] return ( FedURI hLocal tPath "" , map (l2f hLocal . flip LocalURI "") [ jPath , tPath <> "/participants" , tPath <> "/team" ] ) Right rd -> do i <- getJust $ remoteDiscussion201905Instance rd return ( l2f (instance201905Host i) (remoteDiscussion201905Ident rd) , [] ) -- parent muParent <- case Left <$> localMessage201905UnlinkedParent lm <|> Right <$> message201905Parent m of Nothing -> return Nothing Just (Left fu) -> return $ Just fu Just (Right midParent) -> Just <$> do mparent <- runMaybeT $ Left <$> MaybeT (getBy $ UniqueLocalMessage201905 midParent) <|> Right <$> MaybeT (getValBy $ UniqueRemoteMessage201905 midParent) case fromJust mparent of Left (Entity lmidP lmP) -> do p <- getJust $ localMessage201905Author lmP s <- getJust $ person201905Ident p let path = T.concat [ "/s/", shr2text $ sharer201905Ident s , "/m/", toPathPiece $ encodeKeyHashidPure ctx lmidP ] return $ FedURI hLocal path "" Right rmP -> do i <- getJust $ remoteMessage201905Instance rmP return $ l2f (instance201905Host i) (remoteMessage201905Ident rmP) let msg = T.filter (/= '\r') $ message201905Content m contentHtml <- case renderPandocMarkdown msg of Left e -> error $ T.unpack e Right t -> return t let aud = Audience recips [] [] [] [] [] luAttrib = LocalURI ("/s/" <> shr2text shr) "" activity luAct luNote = Doc hLocal Activity { activityId = luAct , activityActor = luAttrib , activitySummary = Nothing , activityAudience = aud , activitySpecific = CreateActivity Create { createObject = Note { noteId = Just luNote , noteAttrib = luAttrib , noteAudience = aud , noteReplyTo = Just $ fromMaybe uContext muParent , noteContext = Just uContext , notePublished = Just $ message201905Created m , noteSource = msg , noteContent = contentHtml } } } tempUri = LocalURI "" "" newObid <- insert OutboxItem201905 { outboxItem201905Person = pid , outboxItem201905Activity = PersistJSON $ activity tempUri tempUri , outboxItem201905Published = message201905Created m } let notePath = T.concat [ "/s/", shr2text shr , "/m/", toPathPiece $ encodeKeyHashidPure ctx lmid ] obPath = T.concat [ "/s/", shr2text shr , "/outbox/", toPathPiece $ encodeKeyHashidPure ctx newObid ] luAct = LocalURI obPath "" luNote = LocalURI notePath "" doc = activity luAct luNote update newObid [OutboxItem201905Activity =. PersistJSON doc] return newObid update lmid [LocalMessage201905Create =. obidNew] delete obid let pid = outboxItem201905Person ob p <- getJust pid delete pid delete $ person201905Ident p ) "create" "OutboxItem" -- 78 , addUnique "LocalMessage" $ Unique "UniqueLocalMessageCreate" ["create"] -- 79 , renameEntity "ProjectRole" "Role" -- 80 , renameUnique "Role" "UniqueProjectRole" "UniqueRole" -- 81 , renameEntity "ProjectRoleInherit" "RoleInherit" -- 82 , renameUnique "RoleInherit" "UniqueProjectRoleInherit" "UniqueRoleInherit" -- 83 , renameEntity "ProjectAccess" "RoleAccess" -- 84 , renameUnique "RoleAccess" "UniqueProjectAccess" "UniqueRoleAccess" -- 85 , renameField "Message" "content" "source" -- 86 , addFieldPrimRequired "Message" ("" :: Text) "content" -- 87 , unchecked $ lift $ do msgs <- selectList ([] :: [Filter Message201906]) [] for_ msgs $ \ (Entity mid m) -> let source = T.filter (/= '\r') $ message201906Source m in case renderPandocMarkdown source of Left err -> liftIO $ throwIO $ userError $ T.unpack err Right content -> update mid [ Message201906Source =. source , Message201906Content =. content ] -- 88 , renameField "Ticket" "desc" "source" -- 89 , addFieldPrimRequired "Ticket" ("" :: Text) "description" -- 90 , unchecked $ lift $ do tickets <- selectList ([] :: [Filter Ticket201906]) [] for_ tickets $ \ (Entity tid t) -> let source = T.filter (/= '\r') $ ticket201906Source t in case renderPandocMarkdown source of Left err -> liftIO $ throwIO $ userError $ T.unpack err Right content -> update tid [ Ticket201906Source =. source , Ticket201906Description =. content ] -- 91 , addEntities model_2019_06_06 -- 92 , unchecked $ lift $ do tickets <- selectList ([] :: [Filter Ticket20190606]) [] let mklocal (Entity tid t) = TicketAuthorLocal20190606 tid $ ticket20190606Creator t insertMany_ $ map mklocal tickets -- 93 , setFieldMaybe "Ticket" "closer" -- 94 , removeField "Ticket" "creator" -- 95 , addEntity $ ST.Entity "Inbox" [] [] -- 96 , addFieldRefRequired' "Person" Inbox20190607 (Just $ do pids <- selectKeysList ([] :: [Filter Person20190607]) [] for_ pids $ \ pid -> do ibid <- insert Inbox20190607 update pid [Person20190607Inbox =. ibid] ) "inbox" "Inbox" -- 97 , addFieldRefRequired' "InboxItemLocal" Inbox20190607 (Just $ do ibils <- selectList ([] :: [Filter InboxItemLocal20190607]) [] for_ ibils $ \ (Entity ibilid ibil) -> do person <- getJust $ inboxItemLocal20190607Person ibil let ibid = person20190607Inbox person update ibilid [InboxItemLocal20190607Inbox =. ibid] ) "inbox" "Inbox" -- 98 , addFieldRefRequired' "InboxItemRemote" Inbox20190607 (Just $ do ibirs <- selectList ([] :: [Filter InboxItemRemote20190607]) [] for_ ibirs $ \ (Entity ibirid ibir) -> do person <- getJust $ inboxItemRemote20190607Person ibir let ibid = person20190607Inbox person update ibirid [InboxItemRemote20190607Inbox =. ibid] ) "inbox" "Inbox" -- 99 , removeUnique "InboxItemLocal" "UniqueInboxItemLocal" -- 100 , removeField "InboxItemLocal" "person" -- 101 , addUnique "InboxItemLocal" $ Unique "UniqueInboxItemLocal" ["inbox", "activity"] -- 102 , removeUnique "InboxItemRemote" "UniqueInboxItemRemote" -- 103 , removeField "InboxItemRemote" "person" -- 104 , addUnique "InboxItemRemote" $ Unique "UniqueInboxItemRemote" ["inbox", "activity"] -- 105 , addUnique "Person" $ Unique "UniquePersonInbox" ["inbox"] -- 106 , addFieldRefRequired' "Project" Inbox20190609 (Just $ do jids <- selectKeysList ([] :: [Filter Project20190609]) [] for_ jids $ \ jid -> do ibid <- insert Inbox20190609 update jid [Project20190609Inbox =. ibid] ) "inbox" "Inbox" -- 107 , addUnique "Project" $ Unique "UniqueProjectInbox" ["inbox"] -- 108 , addUnique "RemoteMessage" $ Unique "UniqueRemoteMessageCreate" ["create"] -- 109 , unchecked $ lift $ do ibiids <- selectKeysList ([] :: [Filter InboxItem2019Fill]) [] activities <- for ibiids $ \ ibiid -> requireEitherAlt (fmap inboxItemLocal2019FillActivity <$> getValBy (UniqueInboxItemLocalItem2019Fill ibiid) ) (fmap inboxItemRemote2019FillActivity <$> getValBy (UniqueInboxItemRemoteItem2019Fill ibiid) ) "InboxItem neither remote nor local" "InboxItem both remote and local" let getValByJust = fmap fromJust . getValBy for_ (nub activities) $ \ activity -> do mid <- case activity of Left obid -> localMessage2019FillRest <$> getValByJust (UniqueLocalMessageCreate2019Fill obid) Right ractid -> remoteMessage2019FillRest <$> getValByJust (UniqueRemoteMessageCreate2019Fill ractid) did <- message2019FillRoot <$> getJust mid mt <- getValBy $ UniqueTicketDiscussion2019Fill did for_ mt $ \ t -> do ibid <- project2019FillInbox <$> getJust (ticket2019FillProject t) ibiid <- insert $ InboxItem2019Fill False case activity of Left obid -> insert_ $ InboxItemLocal2019Fill ibid obid ibiid Right ractid -> insert_ $ InboxItemRemote2019Fill ibid ractid ibiid -- 110 , addFieldRefRequired' "Project" FollowerSet20190610 (Just $ do jids <- selectKeysList ([] :: [Filter Project20190610]) [] for_ jids $ \ jid -> do fsid <- insert FollowerSet20190610 update jid [Project20190610Followers =. fsid] ) "followers" "FollowerSet" -- 111 , addUnique "Project" $ Unique "UniqueProjectFollowers" ["followers"] -- 112 , addFieldRefRequiredEmpty "TicketAuthorRemote" "offer" "RemoteActivity" -- 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 , activitySummary = Nothing , 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 renderUrl <- askUrlRenderParams 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 = [] } summary = [hamlet|

#{shr2text shrAuthor} \ offered a ticket to project # ./s/#{shr2text shrProject}/p/#{prj2text prj} : #{ticket20190612Title ticket}. |] doc luAct = Doc hLocal Activity { activityId = luAct , activityActor = author , activitySummary = Just $ TextHtml $ TL.toStrict $ renderHtml $ summary renderUrl , 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 $ SharerOutboxItemR 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"] -- 116 , addEntity $ ST.Entity "Outbox" [] [] -- 117 , addFieldRefRequired' "Person" Outbox20190615 (Just $ do pids <- selectKeysList ([] :: [Filter Person20190615]) [] for_ pids $ \ pid -> do obid <- insert Outbox20190615 update pid [Person20190615Outbox =. obid] ) "outbox" "Outbox" -- 118 , addUnique "Person" $ Unique "UniquePersonOutbox" ["outbox"] -- 119 , addFieldRefRequired' "OutboxItem" Outbox20190615 (Just $ do obiids <- selectList ([] :: [Filter OutboxItem20190615]) [] for_ obiids $ \ (Entity obiid obi) -> do person <- getJust $ outboxItem20190615Person obi let obid = person20190615Outbox person update obiid [OutboxItem20190615Outbox =. obid] ) "outbox" "Outbox" -- 120 , removeField "OutboxItem" "person" -- 121 , addFieldRefRequired' "Project" Outbox20190616 (Just $ do jids <- selectKeysList ([] :: [Filter Project20190616]) [] for_ jids $ \ jid -> do obid <- insert Outbox20190616 update jid [Project20190616Outbox =. obid] ) "outbox" "Outbox" -- 122 , addUnique "Project" $ Unique "UniqueProjectOutbox" ["outbox"] -- 123 , unchecked $ lift $ do ts <- selectList ([] :: [Filter Ticket20190612]) [] for_ ts $ \ (Entity tid t) -> let title = TL.toStrict $ renderHtml $ toHtml $ ticket20190612Title t in update tid [Ticket20190612Title =. title] ] migrateDB :: (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 in f $ changes hLocal ctx