Add spar-migrate-data, remove migrate-external-ids

Author: smatting

tools/db/migrate-external-ids/src/Main.hs renamed to 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

services/spar/package.yaml

@@ -30,8 +30,10 @@ dependencies:
   - bytestring-conversion
   - case-insensitive
   - cassandra-util
+  - conduit
   - containers
   - cookie
+  - cql
   - cryptonite
   - data-default
   - email-validate
@@ -125,6 +127,13 @@ executables:
     dependencies:
       - spar
 
+  spar-migrate-data:
+    main: Main.hs
+    source-dirs: migrate-data/src
+    ghc-options: -threaded -rtsopts -with-rtsopts=-N
+    dependencies:
+      - spar
+
   spar-integration:
     main: Spec.hs
     source-dirs:

services/spar/schema/src/Main.hs

@@ -27,6 +27,7 @@ import qualified V1
 import qualified V10
 import qualified V11
 import qualified V12
+import qualified V13
 import qualified V2
 import qualified V3
 import qualified V4
@@ -57,7 +58,8 @@ main = do
       V9.migration,
       V10.migration,
       V11.migration,
-      V12.migration
+      V12.migration,
+      V13.migration
       -- When adding migrations here, don't forget to update
       -- 'schemaVersion' in Spar.Data
 

services/spar/schema/src/V13.hs

@@ -0,0 +1,38 @@
+-- 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 V13
+  ( migration,
+  )
+where
+
+import Cassandra.Schema
+import Imports
+import Text.RawString.QQ
+
+migration :: Migration
+migration = Migration 13 "Create table `data_migration`" $ do
+  schema'
+    [r|
+        CREATE TABLE data_migration (
+            id      int,
+            version int,
+            descr   text,
+            date    timestamp,
+            PRIMARY KEY (id, version)
+        );
+        |]

services/spar/spar.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: d5476ea0ce8d09ebda5cea51897773fb0372e5cae747e17a5dc89f7460c75604
+-- hash: 3c81df1298b4c17e7c600b0ce3b168e1ed99b271f4dee5cc565e43485d08025c
 
 name:           spar
 version:        0.1
@@ -27,6 +27,11 @@ library
       Spar.App
       Spar.Data
       Spar.Data.Instances
+      Spar.DataMigration.Options
+      Spar.DataMigration.RIO
+      Spar.DataMigration.Run
+      Spar.DataMigration.Types
+      Spar.DataMigration.V1_ExternalIds
       Spar.Error
       Spar.Intra.Brig
       Spar.Intra.Galley
@@ -60,8 +65,10 @@ library
     , bytestring-conversion
     , case-insensitive
     , cassandra-util
+    , conduit
     , containers
     , cookie
+    , cql
     , cryptonite
     , data-default
     , email-validate
@@ -140,8 +147,10 @@ executable spar
     , bytestring-conversion
     , case-insensitive
     , cassandra-util
+    , conduit
     , containers
     , cookie
+    , cql
     , cryptonite
     , data-default
     , email-validate
@@ -238,8 +247,10 @@ executable spar-integration
     , bytestring-conversion
     , case-insensitive
     , cassandra-util
+    , conduit
     , containers
     , cookie
+    , cql
     , cryptonite
     , data-default
     , email-validate
@@ -310,6 +321,89 @@ executable spar-integration
     , zauth
   default-language: Haskell2010
 
+executable spar-migrate-data
+  main-is: Main.hs
+  other-modules:
+      Paths_spar
+  hs-source-dirs:
+      migrate-data/src
+  default-extensions: AllowAmbiguousTypes BangPatterns ConstraintKinds DataKinds DefaultSignatures DerivingStrategies DeriveFunctor DeriveGeneric DeriveLift DeriveTraversable EmptyCase FlexibleContexts FlexibleInstances FunctionalDependencies GADTs InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PackageImports PatternSynonyms PolyKinds QuasiQuotes RankNTypes ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeFamilyDependencies TypeOperators UndecidableInstances ViewPatterns
+  ghc-options: -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path -j -Wno-redundant-constraints -Werror -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      HsOpenSSL
+    , aeson
+    , aeson-pretty
+    , aeson-qq
+    , attoparsec
+    , base
+    , base64-bytestring
+    , bilge
+    , binary
+    , brig-types
+    , bytestring
+    , bytestring-conversion
+    , case-insensitive
+    , cassandra-util
+    , conduit
+    , containers
+    , cookie
+    , cql
+    , cryptonite
+    , data-default
+    , email-validate
+    , errors
+    , exceptions
+    , extended
+    , extra
+    , galley-types
+    , ghc-prim
+    , hscim
+    , http-api-data
+    , http-client
+    , http-client-tls
+    , http-media
+    , http-types
+    , imports
+    , insert-ordered-containers
+    , interpolate
+    , lens
+    , memory
+    , metrics-core
+    , metrics-wai
+    , mtl
+    , network-uri
+    , optparse-applicative
+    , prometheus-client
+    , raw-strings-qq
+    , retry
+    , saml2-web-sso >=0.18
+    , scientific
+    , servant
+    , servant-multipart
+    , servant-server
+    , servant-swagger
+    , spar
+    , string-conversions
+    , swagger2
+    , text
+    , text-latin1
+    , time
+    , tinylog
+    , transformers
+    , types-common
+    , unordered-containers
+    , uri-bytestring
+    , uuid
+    , wai
+    , wai-middleware-prometheus
+    , wai-utilities
+    , warp
+    , wire-api
+    , x509
+    , xml-conduit
+    , yaml
+  default-language: Haskell2010
+
 executable spar-schema
   main-is: Main.hs
   other-modules:
@@ -318,6 +412,7 @@ executable spar-schema
       V10
       V11
       V12
+      V13
       V2
       V3
       V4
@@ -346,8 +441,10 @@ executable spar-schema
     , bytestring-conversion
     , case-insensitive
     , cassandra-util
+    , conduit
     , containers
     , cookie
+    , cql
     , cryptonite
     , data-default
     , email-validate
@@ -436,8 +533,10 @@ test-suite spec
     , bytestring-conversion
     , case-insensitive
     , cassandra-util
+    , conduit
     , containers
     , cookie
+    , cql
     , cryptonite
     , data-default
     , email-validate

services/spar/src/Spar/Data.hs

@@ -110,7 +110,7 @@ import qualified Prelude
 
 -- | A lower bound: @schemaVersion <= whatWeFoundOnCassandra@, not @==@.
 schemaVersion :: Int32
-schemaVersion = 12
+schemaVersion = 13
 
 ----------------------------------------------------------------------
 -- helpers

tools/db/migrate-external-ids/src/Options.hs renamed to services/spar/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,40 +33,15 @@ 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 =
   MigratorSettings
     <$> cassandraSettingsParser "spar"
     <*> cassandraSettingsParser "brig"
-    <*> flag NoDebug Debug (long "debug")
-    <*> flag NoDryRun DryRun (long "dry-run" <> short 'n')
+    <*> switch (long "debug")
+    <*> switch (long "dry-run" <> short 'n')
     <*> option auto (long "page-size" <> short 'p' <> value 1000)
 
 cassandraSettingsParser :: String -> Parser CassandraSettings

services/spar/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