diff --git a/db-migration.cabal b/db-migration.cabal index be9266a..986fd77 100644 --- a/db-migration.cabal +++ b/db-migration.cabal @@ -70,6 +70,7 @@ library , postgresql-simple , scientific , text + , time , unliftio , unordered-containers , vector diff --git a/package.yaml b/package.yaml index 25b2e00..a2549d9 100644 --- a/package.yaml +++ b/package.yaml @@ -53,6 +53,7 @@ library: - free - extra - unliftio + - time executables: generate-dll: diff --git a/src/Database/Migration.hs b/src/Database/Migration.hs index e0788c7..265d0b4 100644 --- a/src/Database/Migration.hs +++ b/src/Database/Migration.hs @@ -56,7 +56,7 @@ schemaDiffIteration conn options actualPredicates haskellConstraints = do DF.foldl' (\preds dP -> maybe preds (snoc preds) - $ lenientPredicateCheck options dP groupedDBChecks) + $ lenientlyCheckPredicate options dP groupedDBChecks) [] dbPredicates if null lenientPredicates diff --git a/src/Database/Migration/Backend/Postgres/Queries.hs b/src/Database/Migration/Backend/Postgres/Queries.hs index a374d8d..8477832 100644 --- a/src/Database/Migration/Backend/Postgres/Queries.hs +++ b/src/Database/Migration/Backend/Postgres/Queries.hs @@ -4,50 +4,52 @@ import Data.String (fromString) import qualified Data.Text as T import qualified Database.Beam.Postgres as BP import qualified Database.PostgreSQL.Simple as Pg - -import Control.Monad (void) -import Data.Maybe (fromMaybe) +import Data.Maybe(fromMaybe) import qualified Data.Vector as V -import Database.Migration.Utils.Common +import Control.Monad (void) +import qualified Database.Beam.Postgres.Migrate as BPM +import Database.Migration.Utils.Common(headMaybe) getSequencesFromPg :: BP.Connection -> T.Text -> IO [(String, String, String, String, String, String, String, String)] getSequencesFromPg conn mSchema = - Pg.query_ conn - $ fromString - $ unlines - [ "select sequence_schema, sequence_name, minimum_value," - , "maximum_value, start_value, increment, cycle_option, data_type" - , "from information_schema.sequences" - , "where sequence_schema = '" ++ T.unpack mSchema ++ "';" - ] + BPM.executePgQueryAndWrap conn + (fromString + $ unlines + [ "select sequence_schema, sequence_name, minimum_value," + , "maximum_value, start_value, increment, cycle_option, data_type" + , "from information_schema.sequences" + , "where sequence_schema = '" ++ T.unpack mSchema ++ "';" + ]) + BPM.mkToRowInstanceMaybe getSchemasFromPg :: BP.Connection -> IO [T.Text] getSchemasFromPg conn = - fmap Pg.fromOnly - <$> Pg.query_ - conn - (fromString - "select schema_name from information_schema.schemata where catalog_name = current_database();") + map Pg.fromOnly <$> BPM.executePgQueryAndWrap conn + (fromString + "select schema_name from information_schema.schemata where catalog_name = current_database();") + BPM.mkToRowInstanceMaybe getColumnDefaultsFromPg :: BP.Connection -> T.Text -> IO [(T.Text, T.Text, T.Text, T.Text)] getColumnDefaultsFromPg conn mSchema = - Pg.query_ conn - $ fromString - $ unlines - [ "select table_schema, table_name, column_name, column_default" - , "from information_schema.columns where" - , "column_default is not null and" - , "table_schema = '" ++ T.unpack mSchema ++ "';" - ] + BPM.executePgQueryAndWrap + conn + (fromString + $ unlines + [ "select table_schema, table_name, column_name, column_default" + , "from information_schema.columns where" + , "column_default is not null and" + , "table_schema = '" ++ T.unpack mSchema ++ "';" + ]) + BPM.mkToRowInstanceMaybe getSearchPath :: BP.Connection -> IO [T.Text] -getSearchPath conn = +getSearchPath conn = fromMaybe [] . headMaybe . fmap (V.toList . Pg.fromOnly) - <$> Pg.query_ conn (fromString "select current_schemas(false)") + <$> BPM.executePgQueryAndWrap conn (fromString "select current_schemas(false)") BPM.mkToRowInstanceMaybe setSearchPath :: BP.Connection -> [T.Text] -> IO () setSearchPath conn schemas = diff --git a/src/Database/Migration/Types.hs b/src/Database/Migration/Types.hs index c1854a7..914bc38 100644 --- a/src/Database/Migration/Types.hs +++ b/src/Database/Migration/Types.hs @@ -28,9 +28,22 @@ class RenderPredicate be p where type ColumnTypeCheck = T.Text -> T.Text -> ColumnType -> ColumnType -> Bool +data LoopbackLimitValue = NoLimit | Limit Int + +data LoopbackLimit = LoopbackLimit + { defaultLimit :: LoopbackLimitValue + , partitionedTableMapLimit :: !(HM.HashMap T.Text LoopbackLimitValue) + , logPreloopbackPartionedErr :: Bool + } + +data PartitonFormat = YYYYMM | MMYYYY -- TODO add support weekly paritions or Daily Partitons + data PartitionOption = PartitionOption { includeParentTable :: !Bool , partitionMap :: !(HM.HashMap T.Text [T.Text]) + , loopBackLimit :: LoopbackLimit + , partitionDelimiter :: T.Text -- TODO make this Table Specific HashMap + , partitionFormat :: PartitonFormat } data Options = Options @@ -42,8 +55,11 @@ data Options = Options , listDifference :: !Bool } +defaultLoopbackLimit :: LoopbackLimit +defaultLoopbackLimit = LoopbackLimit NoLimit HM.empty False + defaultPartitionOption :: PartitionOption -defaultPartitionOption = PartitionOption True HM.empty +defaultPartitionOption = PartitionOption True HM.empty defaultLoopbackLimit "_M_" YYYYMM defaultOptions :: Options defaultOptions = Options [] Nothing defaultPartitionOption False False True diff --git a/src/Database/Migration/Utils/Beam.hs b/src/Database/Migration/Utils/Beam.hs index a1e36fe..8e29cde 100644 --- a/src/Database/Migration/Utils/Beam.hs +++ b/src/Database/Migration/Utils/Beam.hs @@ -670,4 +670,4 @@ findIndexInDBPredicates pd groupedDBPredicates = $ LHM.elems groupedDBPredicates in case mPred of Just (DBTableHasIndex p) -> Just p - _ignore -> Nothing + _ignore -> Nothing \ No newline at end of file diff --git a/src/Database/Migration/Utils/Check.hs b/src/Database/Migration/Utils/Check.hs index 1b12d4e..2a36f9c 100644 --- a/src/Database/Migration/Utils/Check.hs +++ b/src/Database/Migration/Utils/Check.hs @@ -5,9 +5,109 @@ import qualified Data.List as DL import Data.Maybe (fromMaybe, isJust) import qualified Data.Text as T import qualified Database.Beam.Migrate as BM -import Database.Migration.Types +import Database.Migration.Types hiding (mod) import qualified Database.Migration.Types.LinkedHashMap as LHM import Database.Migration.Utils.Beam +import qualified Database.Migration.Types as DMT +import qualified Data.HashMap.Strict as HM +import Control.Monad (when,void) +import qualified Debug.Trace as DT +import qualified Database.Beam.Migrate.Types as BMT +import qualified Data.Time as DT +import qualified System.IO.Unsafe as SIU +import qualified Text.Read as TR + +-- type Year = Integer +-- type Month = Int + +getCurrentMonthAndYear :: IO (Integer,Int) +getCurrentMonthAndYear = do + (year,month,_) <- DT.getCurrentTime >>= return . DT.toGregorian . DT.utctDay + return (year,month) + +lenientlyCheckPredicate :: + Options + -> DBPredicate + -> LHM.LinkedHashMap T.Text DBPredicate + -> Maybe DBPredicate +lenientlyCheckPredicate options@Options{partitionOptions} predicate groupedDBPredicates = do + case extractQualifiedTableNameFromPredicate predicate of + Nothing -> lenientPredicateCheck options predicate groupedDBPredicates + Just qualifiedTblName -> do + let (tblName,paritionParam) = extractOrigTblNameAndPartitionParam options qualifiedTblName + case HM.lookup tblName $ DMT.partitionMap partitionOptions of -- check parition options + Nothing -> lenientPredicateCheck options predicate groupedDBPredicates + Just _ -> do + let loopbackLimit = DMT.loopBackLimit partitionOptions + case HM.lookup tblName $ DMT.partitionedTableMapLimit loopbackLimit of + Nothing -> handleLoopbackLimit (DMT.defaultLimit loopbackLimit) (tblName,paritionParam) qualifiedTblName options predicate groupedDBPredicates + Just lbl -> handleLoopbackLimit lbl (tblName,paritionParam) qualifiedTblName options predicate groupedDBPredicates + where + handleLoopbackLimit :: LoopbackLimitValue -> (T.Text,T.Text) -> BMT.QualifiedName -> Options -> DBPredicate -> LHM.LinkedHashMap T.Text DBPredicate -> Maybe DBPredicate + handleLoopbackLimit NoLimit _ _ opt preds gdb = lenientPredicateCheck opt preds gdb + handleLoopbackLimit (Limit lmt) (tblName,paritionParam) qualifiedTblName opt preds gdb = do + let isPartitionedTableBeyondLimit = checkParitionedTableLimit options paritionParam lmt + if isPartitionedTableBeyondLimit + then do + let maybeLenientCheckResp = lenientPredicateCheck opt preds gdb + case maybeLenientCheckResp of + Nothing -> Nothing + Just dbPredicate -> do + when (DMT.logPreloopbackPartionedErr $ DMT.loopBackLimit $ DMT.partitionOptions opt) $ + (return $ DT.traceShow "DB NOT_IN_SYNC " (show (preds,qualifiedTblName))) *> return () + Nothing + else lenientlyCheckPredicate opt preds gdb + + checkParitionedTableLimit :: Options -> T.Text -> Int -> Bool + checkParitionedTableLimit opts@Options{partitionOptions} paritionParam lmt = do + case DMT.partitionFormat partitionOptions of + YYYYMM -> do + let (currYear,currMonth) = SIU.unsafePerformIO getCurrentMonthAndYear + maybeYear = TR.readMaybe (T.unpack (T.take 4 paritionParam)) :: Maybe Integer + maybeMonth = TR.readMaybe (T.unpack (T.drop 4 paritionParam)) :: Maybe Int + year = case maybeYear of + Just val -> val + Nothing -> error "Invalid year" + month = case maybeMonth of + Just val -> val + Nothing -> error "Invalid month" + checkIfTableIsInRange currYear currMonth year month lmt + MMYYYY -> do + let (currYear,currMonth) = SIU.unsafePerformIO getCurrentMonthAndYear + maybeYear = TR.readMaybe (T.unpack (T.drop 4 paritionParam)) :: Maybe Integer + maybeMonth = TR.readMaybe (T.unpack (T.take 2 paritionParam)) :: Maybe Int + year = case maybeYear of + Just val -> val + Nothing -> error "Invalid year" + month = case maybeMonth of + Just val -> val + Nothing -> error "Invalid month" + checkIfTableIsInRange currYear currMonth year month lmt + + checkIfTableIsInRange :: Integer -> Int -> Integer -> Int -> Int -> Bool + checkIfTableIsInRange currYear currMonth year month lmt = do + let prevYear = currYear - toInteger (lmt `div` 12) - (if (lmt `mod` 12 >= currMonth) then 1 else 0) + let prevMonth + | lmt `mod` 12 < currMonth = currMonth - (lmt `mod` 12) :: Int + | otherwise = 12 - (lmt `mod` 12 - currMonth) + prevYear > year || (prevYear == year && prevMonth >= month) + + extractOrigTblNameAndPartitionParam :: Options -> BMT.QualifiedName -> (T.Text,T.Text) + extractOrigTblNameAndPartitionParam options@Options{partitionOptions} qualifiedTableName = do + let tblName = BMT.qnameAsText qualifiedTableName + let partitonTblList = T.splitOn (DMT.partitionDelimiter partitionOptions) tblName + let tableName = partitonTblList DL.!! 0 + let partition = partitonTblList DL.!! 1 + (tableName, partition) + + +extractQualifiedTableNameFromPredicate :: DBPredicate -> Maybe BMT.QualifiedName +extractQualifiedTableNameFromPredicate (DBHasEnum _) = Nothing +extractQualifiedTableNameFromPredicate (DBHasSequence _) = Nothing +extractQualifiedTableNameFromPredicate (DBHasTable (TablePredicate (TableInfo tblName) _ _)) = Just tblName +extractQualifiedTableNameFromPredicate (DBTableHasColumns _) = Nothing +extractQualifiedTableNameFromPredicate (DBHasSchema _) = Nothing +extractQualifiedTableNameFromPredicate (DBTableHasIndex tblIndexPredicate@TableHasIndexPredicate{tableName}) = Just tableName lenientPredicateCheck :: Options diff --git a/stack.yaml b/stack.yaml index 0ab6509..64407e3 100644 --- a/stack.yaml +++ b/stack.yaml @@ -6,7 +6,7 @@ packages: extra-deps: - github: adiR28/beam - commit: 0791544548652731bd70c788b0b22c45b396999d + commit: 2f9a4b45bc43caab717eff94c0974ca4fd71445e subdirs: - beam-core - beam-migrate diff --git a/stack.yaml.lock b/stack.yaml.lock index b20e5c0..c38a3ec 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -1,7 +1,7 @@ # This file was autogenerated by Stack. # You should not edit this file by hand. # For more information, please see the documentation at: -# https://docs.haskellstack.org/en/stable/lock_files +# https://docs.haskellstack.org/en/stable/topics/lock_files packages: - completed: @@ -9,53 +9,53 @@ packages: pantry-tree: sha256: f2f156de6ab2c8e2dfe9df2333ceb570ee168dae709ef7139002fee5f1a1ab7f size: 2623 - sha256: 0fac30be8f83d35c4c06840591130df7a0d917437d46e97ec94f77be46d18056 - size: 1205592 + sha256: 7c5e75657eb1df87b66de701ce4050f9fbc1ebe9c2b80c574f18f29ed7cd2985 + size: 1206197 subdir: beam-core - url: https://github.com/adiR28/beam/archive/0791544548652731bd70c788b0b22c45b396999d.tar.gz + url: https://github.com/adiR28/beam/archive/2f9a4b45bc43caab717eff94c0974ca4fd71445e.tar.gz version: 0.9.0.0 original: subdir: beam-core - url: https://github.com/adiR28/beam/archive/0791544548652731bd70c788b0b22c45b396999d.tar.gz + url: https://github.com/adiR28/beam/archive/2f9a4b45bc43caab717eff94c0974ca4fd71445e.tar.gz - completed: name: beam-migrate pantry-tree: - sha256: e8a6c428770a1b9db684f7433169c2b36c92c96c990ee362236f59b8718c417c + sha256: ff540837092a94be6c9573133be0fd0c1bbfc25117ba1f6894e5c79c957986ec size: 1826 - sha256: 0fac30be8f83d35c4c06840591130df7a0d917437d46e97ec94f77be46d18056 - size: 1205592 + sha256: 7c5e75657eb1df87b66de701ce4050f9fbc1ebe9c2b80c574f18f29ed7cd2985 + size: 1206197 subdir: beam-migrate - url: https://github.com/adiR28/beam/archive/0791544548652731bd70c788b0b22c45b396999d.tar.gz + url: https://github.com/adiR28/beam/archive/2f9a4b45bc43caab717eff94c0974ca4fd71445e.tar.gz version: 0.5.0.0 original: subdir: beam-migrate - url: https://github.com/adiR28/beam/archive/0791544548652731bd70c788b0b22c45b396999d.tar.gz + url: https://github.com/adiR28/beam/archive/2f9a4b45bc43caab717eff94c0974ca4fd71445e.tar.gz - completed: name: beam-postgres pantry-tree: - sha256: f8768b46136bc5500c5ee88700ece0f16780bdec1c683f0be338d74d5ab2ea63 + sha256: 03e7be3f8099015d43cc8f4f1d126b7d27bb3c8e426d05d253fe208c8a2390f1 size: 2594 - sha256: 0fac30be8f83d35c4c06840591130df7a0d917437d46e97ec94f77be46d18056 - size: 1205592 + sha256: 7c5e75657eb1df87b66de701ce4050f9fbc1ebe9c2b80c574f18f29ed7cd2985 + size: 1206197 subdir: beam-postgres - url: https://github.com/adiR28/beam/archive/0791544548652731bd70c788b0b22c45b396999d.tar.gz + url: https://github.com/adiR28/beam/archive/2f9a4b45bc43caab717eff94c0974ca4fd71445e.tar.gz version: 0.5.0.0 original: subdir: beam-postgres - url: https://github.com/adiR28/beam/archive/0791544548652731bd70c788b0b22c45b396999d.tar.gz + url: https://github.com/adiR28/beam/archive/2f9a4b45bc43caab717eff94c0974ca4fd71445e.tar.gz - completed: name: beam-sqlite pantry-tree: sha256: 3de1879fca8bcacf4a55f97b27d6525946820cbadd3f2d2f5c83e083a562a319 size: 859 - sha256: 0fac30be8f83d35c4c06840591130df7a0d917437d46e97ec94f77be46d18056 - size: 1205592 + sha256: 7c5e75657eb1df87b66de701ce4050f9fbc1ebe9c2b80c574f18f29ed7cd2985 + size: 1206197 subdir: beam-sqlite - url: https://github.com/adiR28/beam/archive/0791544548652731bd70c788b0b22c45b396999d.tar.gz + url: https://github.com/adiR28/beam/archive/2f9a4b45bc43caab717eff94c0974ca4fd71445e.tar.gz version: 0.5.0.0 original: subdir: beam-sqlite - url: https://github.com/adiR28/beam/archive/0791544548652731bd70c788b0b22c45b396999d.tar.gz + url: https://github.com/adiR28/beam/archive/2f9a4b45bc43caab717eff94c0974ca4fd71445e.tar.gz - completed: hackage: flatparse-0.5.1.0@sha256:6f5bc2d750061eac198dae1ca700d8c5c9d69dc8a536d53fdccd21a115ccb9aa,4537 pantry-tree: