make migrations possible

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
+    )

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
+                void $ runInsertInitialRole conn
-          -- TODO: check for Migrations
+          -- 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) $

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 ()
+runInsertInitialRole :: PGS.Connection -> IO [Int]
-runInsertInitalRole conn =
+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