Add spar-migrate-data executable

tools/db/migrate-external-ids/src/Main.hs → services/spar/migrate-data/src/Main.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 -- This file is part of the Wire Server implementation.
 --
 -- Copyright (C) 2020 Wire Swiss GmbH <[email protected]>
@@ -17,13 +15,10 @@
 -- You should have received a copy of the GNU Affero General Public License along
 -- with this program. If not, see <https://www.gnu.org/licenses/>.
 
-module Main
-  ( main,
-  )
-where
+module Main where
 
 import Imports
-import qualified Work
+import qualified Spar.DataMigration.Run as Run
 
 main :: IO ()
-main = Work.main
+main = Run.main

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

@@ -1,6 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
-
 -- This file is part of the Wire Server implementation.
 --
 -- Copyright (C) 2020 Wire Swiss GmbH <[email protected]>
@@ -18,7 +15,7 @@
 -- You should have received a copy of the GNU Affero General Public License along
 -- with this program. If not, see <https://www.gnu.org/licenses/>.
 
-module Options
+module Spar.DataMigration.Options
   ( setCasSpar,
     setCasBrig,
     setDebug,
@@ -28,8 +25,6 @@ module Options
     cPort,
     cKeyspace,
     settingsParser,
-    Debug (..),
-    DryRun (..),
   )
 where
 
@@ -38,32 +33,7 @@ import Control.Lens
 import Data.Text.Strict.Lens
 import Imports
 import Options.Applicative
-
-data MigratorSettings = MigratorSettings
-  { _setCasSpar :: !CassandraSettings,
-    _setCasBrig :: !CassandraSettings,
-    _setDebug :: Debug,
-    _setDryRun :: DryRun,
-    _setPageSize :: Int32
-  }
-  deriving (Show)
-
-data CassandraSettings = CassandraSettings
-  { _cHosts :: !String,
-    _cPort :: !Word16,
-    _cKeyspace :: !C.Keyspace
-  }
-  deriving (Show)
-
-data Debug = Debug | NoDebug
-  deriving (Show)
-
-data DryRun = DryRun | NoDryRun
-  deriving (Show)
-
-makeLenses ''MigratorSettings
-
-makeLenses ''CassandraSettings
+import Spar.DataMigration.Types
 
 settingsParser :: Parser MigratorSettings
 settingsParser =

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

@@ -0,0 +1,38 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2020 Wire Swiss GmbH <[email protected]>
+--
+-- This program is free software: you can redistribute it and/or modify it under
+-- the terms of the GNU Affero General Public License as published by the Free
+-- Software Foundation, either version 3 of the License, or (at your option) any
+-- later version.
+--
+-- This program is distributed in the hope that it will be useful, but WITHOUT
+-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
+-- details.
+--
+-- You should have received a copy of the GNU Affero General Public License along
+-- with this program. If not, see <https://www.gnu.org/licenses/>.
+
+module Spar.DataMigration.RIO where
+
+import Imports
+
+newtype RIO env a = RIO {unRIO :: ReaderT env IO a}
+  deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader env)
+
+runRIO :: env -> RIO env a -> IO a
+runRIO e f = runReaderT (unRIO f) e
+
+modifyRef :: (env -> IORef a) -> (a -> a) -> RIO env ()
+modifyRef get_ mod' = do
+  ref <- asks get_
+  liftIO (modifyIORef ref mod')
+
+readRef :: (env -> IORef b) -> RIO env b
+readRef g = do
+  ref <- asks g
+  liftIO $ readIORef ref

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

@@ -0,0 +1,113 @@
+{-# LANGUAGE RecordWildCards #-}
+
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2020 Wire Swiss GmbH <[email protected]>
+--
+-- This program is free software: you can redistribute it and/or modify it under
+-- the terms of the GNU Affero General Public License as published by the Free
+-- Software Foundation, either version 3 of the License, or (at your option) any
+-- later version.
+--
+-- This program is distributed in the hope that it will be useful, but WITHOUT
+-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
+-- details.
+--
+-- You should have received a copy of the GNU Affero General Public License along
+-- with this program. If not, see <https://www.gnu.org/licenses/>.
+
+module Spar.DataMigration.Run where
+
+import qualified Cassandra as C
+import qualified Cassandra.Settings as C
+import Control.Lens
+import Control.Monad.Catch (finally)
+import qualified Data.Text as Text
+import Data.Time (UTCTime, getCurrentTime)
+import Imports
+import qualified Options.Applicative as Opts
+import Spar.DataMigration.Options (settingsParser)
+import Spar.DataMigration.Types
+import qualified System.Logger as Log
+
+main :: IO ()
+main = do
+  settings <- Opts.execParser (Opts.info (Opts.helper <*> settingsParser) desc)
+  migrate
+    settings
+    []
+  where
+    desc = Opts.header "Spar Cassandra Data Migrations" <> Opts.fullDesc
+
+migrate :: MigratorSettings -> [Migration] -> IO ()
+migrate settings ms = do
+  env <- mkEnv settings
+  runMigrations env ms `finally` cleanup env
+
+mkEnv :: MigratorSettings -> IO Env
+mkEnv settings = do
+  lgr <- initLogger settings
+  spar <- initCassandra (settings ^. setCasSpar) lgr
+  brig <- initCassandra (settings ^. setCasBrig) lgr
+  pure $ Env spar brig lgr (settings ^. setPageSize) (settings ^. setDebug) (settings ^. setDryRun)
+  where
+    initLogger s =
+      Log.new
+        . Log.setOutput Log.StdOut
+        . Log.setFormat Nothing
+        . Log.setBufSize 0
+        . Log.setLogLevel
+          (if s ^. setDebug == Debug then Log.Debug else Log.Info)
+        $ Log.defSettings
+    initCassandra cas l =
+      C.init
+        . C.setLogger (C.mkLogger l)
+        . C.setContacts (cas ^. cHosts) []
+        . C.setPortNumber (fromIntegral $ cas ^. cPort)
+        . C.setKeyspace (cas ^. cKeyspace)
+        . C.setProtocolVersion C.V4
+        $ C.defSettings
+
+cleanup :: (MonadIO m) => Env -> m ()
+cleanup env = do
+  C.shutdown (sparCassandra env)
+  C.shutdown (brigCassandra env)
+  Log.close (logger env)
+
+runMigrations :: Env -> [Migration] -> IO ()
+runMigrations env migrations = do
+  vmax <- latestMigrationVersion env
+  let pendingMigrations = filter (\m -> version m > vmax) migrations
+  if null pendingMigrations
+    then info env "No new migrations."
+    else info env "New migrations found."
+  mapM_ (runMigration env) pendingMigrations
+
+runMigration :: Env -> Migration -> IO ()
+runMigration env@Env {..} (Migration ver txt mig) = do
+  info env $ "Running: [" <> show (migrationVersion ver) <> "] " <> Text.unpack txt
+  mig env
+  unless (dryRun == DryRun) $
+    persistVersion env ver txt =<< liftIO getCurrentTime
+
+latestMigrationVersion :: Env -> IO MigrationVersion
+latestMigrationVersion Env {..} =
+  MigrationVersion . maybe 0 fromIntegral
+    <$> C.runClient
+      sparCassandra
+      (C.query1 cql (C.params C.Quorum ()))
+  where
+    cql :: C.QueryString C.R () (Identity Int32)
+    cql = "select version from data_migration where id=1 order by version desc limit 1"
+
+persistVersion :: Env -> MigrationVersion -> Text -> UTCTime -> IO ()
+persistVersion Env {..} (MigrationVersion v) desc time =
+  C.runClient sparCassandra $
+    C.write cql (C.params C.Quorum (fromIntegral v, desc, time))
+  where
+    cql :: C.QueryString C.W (Int32, Text, UTCTime) ()
+    cql = "insert into data_migration (id, version, descr, date) values (1,?,?,?)"
+
+info :: Env -> String -> IO ()
+info Env {..} msg = Log.info logger $ Log.msg $ msg

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

@@ -0,0 +1,70 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2020 Wire Swiss GmbH <[email protected]>
+--
+-- This program is free software: you can redistribute it and/or modify it under
+-- the terms of the GNU Affero General Public License as published by the Free
+-- Software Foundation, either version 3 of the License, or (at your option) any
+-- later version.
+--
+-- This program is distributed in the hope that it will be useful, but WITHOUT
+-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
+-- details.
+--
+-- You should have received a copy of the GNU Affero General Public License along
+-- with this program. If not, see <https://www.gnu.org/licenses/>.
+
+module Spar.DataMigration.Types where
+
+import qualified Cassandra as C
+import Control.Lens
+import Imports
+import Numeric.Natural (Natural)
+import qualified System.Logger as Logger
+
+data Migration = Migration
+  { version :: MigrationVersion,
+    text :: Text,
+    action :: Env -> IO ()
+  }
+
+newtype MigrationVersion = MigrationVersion {migrationVersion :: Natural}
+  deriving (Show, Eq, Ord)
+
+data Env = Env
+  { sparCassandra :: C.ClientState,
+    brigCassandra :: C.ClientState,
+    logger :: Logger.Logger,
+    pageSize :: Int32,
+    debug :: Debug,
+    dryRun :: DryRun
+  }
+
+data Debug = Debug | NoDebug
+  deriving (Show, Eq)
+
+data DryRun = DryRun | NoDryRun
+  deriving (Show, Eq)
+
+data MigratorSettings = MigratorSettings
+  { _setCasSpar :: !CassandraSettings,
+    _setCasBrig :: !CassandraSettings,
+    _setDebug :: Debug,
+    _setDryRun :: DryRun,
+    _setPageSize :: Int32
+  }
+  deriving (Show)
+
+data CassandraSettings = CassandraSettings
+  { _cHosts :: !String,
+    _cPort :: !Word16,
+    _cKeyspace :: !C.Keyspace
+  }
+  deriving (Show)
+
+makeLenses ''MigratorSettings
+
+makeLenses ''CassandraSettings