make migrations possible

This commit is contained in:
nek0 2020-05-16 16:12:49 +02:00
parent 583316224c
commit 77bb2c156e
3 changed files with 45 additions and 9 deletions

View file

@ -34,8 +34,9 @@ instance FromYAML ServerConfig where
-- <*> m .:? "max_connections_per_client" .!= 10
<*> m .: "block_registration"
newtype Options = Options
data Options = Options
{ optConfigLocation :: T.Text
, optMigrationLocation :: T.Text
}
deriving (Show)
@ -47,3 +48,11 @@ options = Options
<> metavar "FILEPATH"
<> help "Location of the configuration YAML-file"
)
<*> strOption
( long "migration-dir"
<> short 'm'
<> metavar "DIRPATH"
<> help "Location of the migration scripts folder"
<> value "./migration_scripts"
<> showDefault
)

View file

@ -40,6 +40,7 @@ import Control.Concurrent.STM.TVar
import Options.Applicative
import System.Clock (TimeSpec(..))
import System.Exit
-- internal imports
@ -56,7 +57,7 @@ import Paths_mateamt (version)
main :: IO ()
main = do
(Options confLoc) <- execParser opts
(Options confLoc tMigLoc) <- execParser opts
raw <- BL.readFile (T.unpack confLoc)
case decode1 raw of
Left (loc, msg) ->
@ -101,8 +102,28 @@ main = do
execute_ conn initJournal
execute_ conn initRole
execute_ conn initUserToRole
runInsertInitialRole
-- TODO: check for Migrations
void $ runInsertInitialRole conn
-- validate Migrations
let migLoc = T.unpack tMigLoc
ok <- withTransaction conn $ runMigration $ MigrationContext
(MigrationValidation (MigrationDirectory migLoc)) True conn
case ok of
MigrationError err -> do
putStrLn ("Migration validation error: " ++ err)
putStrLn ("Running Migrations!")
void $ withTransaction conn $ runMigration $
MigrationContext (MigrationDirectory migLoc) True conn
MigrationSuccess -> return ()
ok2 <- withTransaction conn $ runMigration $ MigrationContext
(MigrationValidation (MigrationDirectory migLoc)) True conn
case ok2 of
MigrationError err -> do
putStrLn ("Migration validation error: " ++ err)
putStrLn ("MIgration failure! exiting...")
exitWith (ExitFailure 3)
MigrationSuccess -> do
putStrLn ("Migration validation success!")
putStrLn ("starting up...")
forkCleanProcess conn store
withStdoutLogger $ \ilog -> do
let settings = setPort (fromIntegral lport) $

View file

@ -11,6 +11,12 @@ import Data.Profunctor.Product (p2, p13)
import Opaleye as O hiding (null, not)
import Opaleye.Constant as C
import Control.Monad.IO.Class (liftIO)
-- internal imports
import Types
initRole :: PGS.Query
initRole = mconcat
[ "CREATE TABLE IF NOT EXISTS \"role\" ("
@ -101,18 +107,18 @@ userToRoleTable = table "user_to_role" (
)
)
insertInitialRole :: PGS.Connection -> MateHandler ()
insertInitialRole :: PGS.Connection -> MateHandler [Int]
insertInitialRole conn =
liftIO $ runInsertInitalRole conn
liftIO $ runInsertInitialRole conn
runInsertInitalRole :: PGS.Connection -> IO ()
runInsertInitalRole conn =
runInsertInitialRole :: PGS.Connection -> IO [Int]
runInsertInitialRole conn =
runInsert_ conn $ Insert
{ iTable = roleTable
, iRows =
[
( C.constant (Nothing :: Maybe Int)
, C.constant "Administrator"
, C.constant ("Administrator" :: String)
, C.constant True
, C.constant True
, C.constant True