Skip to content

Commit 99bbb23

Browse files
smattingsmatting
committed
Add spar-migrate-data executable (#1400)
1 parent 9699010 commit 99bbb23

File tree

17 files changed

+563
-368
lines changed

17 files changed

+563
-368
lines changed

‎tools/db/migrate-external-ids/src/Main.hs renamed to ‎services/spar/migrate-data/src/Main.hs

Lines changed: 3 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,3 @@
1-
{-# LANGUAGE OverloadedStrings #-}
2-
31
-- This file is part of the Wire Server implementation.
42
--
53
-- Copyright (C) 2020 Wire Swiss GmbH <[email protected]>
@@ -17,13 +15,10 @@
1715
-- You should have received a copy of the GNU Affero General Public License along
1816
-- with this program. If not, see <https://www.gnu.org/licenses/>.
1917

20-
module Main
21-
( main,
22-
)
23-
where
18+
module Main where
2419

2520
import Imports
26-
import qualified Work
21+
import qualified Spar.DataMigration.Run as Run
2722

2823
main :: IO ()
29-
main = Work.main
24+
main = Run.main

‎tools/db/migrate-external-ids/src/Options.hs renamed to ‎services/spar/migrate-data/src/Spar/DataMigration/Options.hs

Lines changed: 2 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,3 @@
1-
{-# LANGUAGE OverloadedStrings #-}
2-
{-# LANGUAGE TemplateHaskell #-}
3-
41
-- This file is part of the Wire Server implementation.
52
--
63
-- Copyright (C) 2020 Wire Swiss GmbH <[email protected]>
@@ -18,7 +15,7 @@
1815
-- You should have received a copy of the GNU Affero General Public License along
1916
-- with this program. If not, see <https://www.gnu.org/licenses/>.
2017

21-
module Options
18+
module Spar.DataMigration.Options
2219
( setCasSpar,
2320
setCasBrig,
2421
setDebug,
@@ -28,8 +25,6 @@ module Options
2825
cPort,
2926
cKeyspace,
3027
settingsParser,
31-
Debug (..),
32-
DryRun (..),
3328
)
3429
where
3530

@@ -38,32 +33,7 @@ import Control.Lens
3833
import Data.Text.Strict.Lens
3934
import Imports
4035
import Options.Applicative
41-
42-
data MigratorSettings = MigratorSettings
43-
{ _setCasSpar :: !CassandraSettings,
44-
_setCasBrig :: !CassandraSettings,
45-
_setDebug :: Debug,
46-
_setDryRun :: DryRun,
47-
_setPageSize :: Int32
48-
}
49-
deriving (Show)
50-
51-
data CassandraSettings = CassandraSettings
52-
{ _cHosts :: !String,
53-
_cPort :: !Word16,
54-
_cKeyspace :: !C.Keyspace
55-
}
56-
deriving (Show)
57-
58-
data Debug = Debug | NoDebug
59-
deriving (Show)
60-
61-
data DryRun = DryRun | NoDryRun
62-
deriving (Show)
63-
64-
makeLenses ''MigratorSettings
65-
66-
makeLenses ''CassandraSettings
36+
import Spar.DataMigration.Types
6737

6838
settingsParser :: Parser MigratorSettings
6939
settingsParser =

‎services/spar/migrate-data/src/Spar/DataMigration/RIO.hs

Lines changed: 38 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,38 @@
1+
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+
3+
-- This file is part of the Wire Server implementation.
4+
--
5+
-- Copyright (C) 2020 Wire Swiss GmbH <[email protected]>
6+
--
7+
-- This program is free software: you can redistribute it and/or modify it under
8+
-- the terms of the GNU Affero General Public License as published by the Free
9+
-- Software Foundation, either version 3 of the License, or (at your option) any
10+
-- later version.
11+
--
12+
-- This program is distributed in the hope that it will be useful, but WITHOUT
13+
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
14+
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
15+
-- details.
16+
--
17+
-- You should have received a copy of the GNU Affero General Public License along
18+
-- with this program. If not, see <https://www.gnu.org/licenses/>.
19+
20+
module Spar.DataMigration.RIO where
21+
22+
import Imports
23+
24+
newtype RIO env a = RIO {unRIO :: ReaderT env IO a}
25+
deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader env)
26+
27+
runRIO :: env -> RIO env a -> IO a
28+
runRIO e f = runReaderT (unRIO f) e
29+
30+
modifyRef :: (env -> IORef a) -> (a -> a) -> RIO env ()
31+
modifyRef get_ mod' = do
32+
ref <- asks get_
33+
liftIO (modifyIORef ref mod')
34+
35+
readRef :: (env -> IORef b) -> RIO env b
36+
readRef g = do
37+
ref <- asks g
38+
liftIO $ readIORef ref

‎services/spar/migrate-data/src/Spar/DataMigration/Run.hs

Lines changed: 113 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,113 @@
1+
{-# LANGUAGE RecordWildCards #-}
2+
3+
-- This file is part of the Wire Server implementation.
4+
--
5+
-- Copyright (C) 2020 Wire Swiss GmbH <[email protected]>
6+
--
7+
-- This program is free software: you can redistribute it and/or modify it under
8+
-- the terms of the GNU Affero General Public License as published by the Free
9+
-- Software Foundation, either version 3 of the License, or (at your option) any
10+
-- later version.
11+
--
12+
-- This program is distributed in the hope that it will be useful, but WITHOUT
13+
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
14+
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
15+
-- details.
16+
--
17+
-- You should have received a copy of the GNU Affero General Public License along
18+
-- with this program. If not, see <https://www.gnu.org/licenses/>.
19+
20+
module Spar.DataMigration.Run where
21+
22+
import qualified Cassandra as C
23+
import qualified Cassandra.Settings as C
24+
import Control.Lens
25+
import Control.Monad.Catch (finally)
26+
import qualified Data.Text as Text
27+
import Data.Time (UTCTime, getCurrentTime)
28+
import Imports
29+
import qualified Options.Applicative as Opts
30+
import Spar.DataMigration.Options (settingsParser)
31+
import Spar.DataMigration.Types
32+
import qualified System.Logger as Log
33+
34+
main :: IO ()
35+
main = do
36+
settings <- Opts.execParser (Opts.info (Opts.helper <*> settingsParser) desc)
37+
migrate
38+
settings
39+
[]
40+
where
41+
desc = Opts.header "Spar Cassandra Data Migrations" <> Opts.fullDesc
42+
43+
migrate :: MigratorSettings -> [Migration] -> IO ()
44+
migrate settings ms = do
45+
env <- mkEnv settings
46+
runMigrations env ms `finally` cleanup env
47+
48+
mkEnv :: MigratorSettings -> IO Env
49+
mkEnv settings = do
50+
lgr <- initLogger settings
51+
spar <- initCassandra (settings ^. setCasSpar) lgr
52+
brig <- initCassandra (settings ^. setCasBrig) lgr
53+
pure $ Env spar brig lgr (settings ^. setPageSize) (settings ^. setDebug) (settings ^. setDryRun)
54+
where
55+
initLogger s =
56+
Log.new
57+
. Log.setOutput Log.StdOut
58+
. Log.setFormat Nothing
59+
. Log.setBufSize 0
60+
. Log.setLogLevel
61+
(if s ^. setDebug == Debug then Log.Debug else Log.Info)
62+
$ Log.defSettings
63+
initCassandra cas l =
64+
C.init
65+
. C.setLogger (C.mkLogger l)
66+
. C.setContacts (cas ^. cHosts) []
67+
. C.setPortNumber (fromIntegral $ cas ^. cPort)
68+
. C.setKeyspace (cas ^. cKeyspace)
69+
. C.setProtocolVersion C.V4
70+
$ C.defSettings
71+
72+
cleanup :: (MonadIO m) => Env -> m ()
73+
cleanup env = do
74+
C.shutdown (sparCassandra env)
75+
C.shutdown (brigCassandra env)
76+
Log.close (logger env)
77+
78+
runMigrations :: Env -> [Migration] -> IO ()
79+
runMigrations env migrations = do
80+
vmax <- latestMigrationVersion env
81+
let pendingMigrations = filter (\m -> version m > vmax) migrations
82+
if null pendingMigrations
83+
then info env "No new migrations."
84+
else info env "New migrations found."
85+
mapM_ (runMigration env) pendingMigrations
86+
87+
runMigration :: Env -> Migration -> IO ()
88+
runMigration env@Env {..} (Migration ver txt mig) = do
89+
info env $ "Running: [" <> show (migrationVersion ver) <> "] " <> Text.unpack txt
90+
mig env
91+
unless (dryRun == DryRun) $
92+
persistVersion env ver txt =<< liftIO getCurrentTime
93+
94+
latestMigrationVersion :: Env -> IO MigrationVersion
95+
latestMigrationVersion Env {..} =
96+
MigrationVersion . maybe 0 fromIntegral
97+
<$> C.runClient
98+
sparCassandra
99+
(C.query1 cql (C.params C.Quorum ()))
100+
where
101+
cql :: C.QueryString C.R () (Identity Int32)
102+
cql = "select version from data_migration where id=1 order by version desc limit 1"
103+
104+
persistVersion :: Env -> MigrationVersion -> Text -> UTCTime -> IO ()
105+
persistVersion Env {..} (MigrationVersion v) desc time =
106+
C.runClient sparCassandra $
107+
C.write cql (C.params C.Quorum (fromIntegral v, desc, time))
108+
where
109+
cql :: C.QueryString C.W (Int32, Text, UTCTime) ()
110+
cql = "insert into data_migration (id, version, descr, date) values (1,?,?,?)"
111+
112+
info :: Env -> String -> IO ()
113+
info Env {..} msg = Log.info logger $ Log.msg $ msg

‎services/spar/migrate-data/src/Spar/DataMigration/Types.hs

Lines changed: 70 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,70 @@
1+
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+
3+
-- This file is part of the Wire Server implementation.
4+
--
5+
-- Copyright (C) 2020 Wire Swiss GmbH <[email protected]>
6+
--
7+
-- This program is free software: you can redistribute it and/or modify it under
8+
-- the terms of the GNU Affero General Public License as published by the Free
9+
-- Software Foundation, either version 3 of the License, or (at your option) any
10+
-- later version.
11+
--
12+
-- This program is distributed in the hope that it will be useful, but WITHOUT
13+
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
14+
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
15+
-- details.
16+
--
17+
-- You should have received a copy of the GNU Affero General Public License along
18+
-- with this program. If not, see <https://www.gnu.org/licenses/>.
19+
20+
module Spar.DataMigration.Types where
21+
22+
import qualified Cassandra as C
23+
import Control.Lens
24+
import Imports
25+
import Numeric.Natural (Natural)
26+
import qualified System.Logger as Logger
27+
28+
data Migration = Migration
29+
{ version :: MigrationVersion,
30+
text :: Text,
31+
action :: Env -> IO ()
32+
}
33+
34+
newtype MigrationVersion = MigrationVersion {migrationVersion :: Natural}
35+
deriving (Show, Eq, Ord)
36+
37+
data Env = Env
38+
{ sparCassandra :: C.ClientState,
39+
brigCassandra :: C.ClientState,
40+
logger :: Logger.Logger,
41+
pageSize :: Int32,
42+
debug :: Debug,
43+
dryRun :: DryRun
44+
}
45+
46+
data Debug = Debug | NoDebug
47+
deriving (Show, Eq)
48+
49+
data DryRun = DryRun | NoDryRun
50+
deriving (Show, Eq)
51+
52+
data MigratorSettings = MigratorSettings
53+
{ _setCasSpar :: !CassandraSettings,
54+
_setCasBrig :: !CassandraSettings,
55+
_setDebug :: Debug,
56+
_setDryRun :: DryRun,
57+
_setPageSize :: Int32
58+
}
59+
deriving (Show)
60+
61+
data CassandraSettings = CassandraSettings
62+
{ _cHosts :: !String,
63+
_cPort :: !Word16,
64+
_cKeyspace :: !C.Keyspace
65+
}
66+
deriving (Show)
67+
68+
makeLenses ''MigratorSettings
69+
70+
makeLenses ''CassandraSettings

0 commit comments

Comments
 (0)