{- 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 Prelude import Control.Monad (unless) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Trans.Class (lift) 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.Maybe (fromMaybe, listToMaybe) import Data.Proxy import Data.Text (Text) import Data.Text.Encoding (encodeUtf8) import Data.Time.Calendar (Day (..)) import Data.Time.Clock (UTCTime (..)) import Database.Persist import Database.Persist.BackendDataType (backendDataType, PersistDefault (..)) import Database.Persist.Migration import Database.Persist.Schema (SchemaT, Migration) import Database.Persist.Schema.Types import Database.Persist.Schema.PostgreSQL (schemaBackend) import Database.Persist.Sql (SqlBackend, toSqlKey) --import Text.Email.QuasiQuotation (email import Text.Email.Validate (unsafeEmailAddress) import Web.PathPieces (toPathPiece) 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 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) changes :: MonadIO m => [Mig m] changes = [ -- 1 addEntities model_2016_08_04 -- 2 , unchecked $ U.unsetFieldDefault "Sharer" "created" -- 3 , unchecked $ U.unsetFieldDefault "Project" "nextTicket" -- 4 , unchecked $ U.unsetFieldDefault "Repo" "vcs" -- 5 , unchecked $ U.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 Project] 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 -- 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 (VerifKeySharedUsage2019Generic SqlBackend)]) deleteWhere ([] :: [Filter (VerifKey2019Generic SqlBackend)]) -- 43 , removeUnique "Message" "UniqueMessage" -- 44 , removeField "Message" "number" -- 45 , removeField "Discussion" "nextMessage" ] migrateDB :: MonadIO m => ReaderT SqlBackend m (Either Text (Int, Int)) migrateDB = let f cs = fmap (, length cs) <$> runMigrations schemaBackend 1 cs in f changes