From 77bb2c156ed3943d3fca74615d6580edba6deb7f Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 16 May 2020 16:12:49 +0200 Subject: [PATCH] make migrations possible --- app/AppTypes/Configuration.hs | 11 ++++++++++- app/Main.hs | 27 ++++++++++++++++++++++++--- src/Model/Role.hs | 16 +++++++++++----- 3 files changed, 45 insertions(+), 9 deletions(-) diff --git a/app/AppTypes/Configuration.hs b/app/AppTypes/Configuration.hs index 3c708c7..9368b1b 100644 --- a/app/AppTypes/Configuration.hs +++ b/app/AppTypes/Configuration.hs @@ -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 + ) diff --git a/app/Main.hs b/app/Main.hs index bcbaaa7..c2e4f77 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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) $ diff --git a/src/Model/Role.hs b/src/Model/Role.hs index a975132..1db889a 100644 --- a/src/Model/Role.hs +++ b/src/Model/Role.hs @@ -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