diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,16 @@ +# Changelog + +## 0.1.0.0 — 2026-07-14 + +### Added + +- Added a pg-migrate administration executable for planning, listing, checking, inspecting, + verifying, applying, repairing, and creating migrations. +- Added checked Codd-history import for the pinned Kiroku, Keiro, and Kioku migration cohort with + text or JSON reports. +- Added automatic read-model registry reconciliation after successful migration application. + +### Changed + +- Updated the executable to pg-migrate 1.1 and the Keiro 0.3/Kiroku Store 0.3 application resource + model. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +BSD 3-Clause License + +Copyright (c) 2026, Nadeem Bitar +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +3. Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,227 @@ +module Main where + +import Data.Aeson qualified as Aeson +import Data.ByteString.Lazy.Char8 qualified as LazyByteString +import Data.Foldable (for_) +import Data.Int (Int64) +import Data.List.NonEmpty qualified as NonEmpty +import Data.Text qualified as Text +import Data.Text.IO qualified as Text.IO +import Database.PostgreSQL.Migrate + ( Confirmation (..), + EquivalentHistoryPolicy (AllowEquivalentHistory), + HistoryImportOutcome (..), + HistoryImportReport (..), + HistoryImportResult (..), + MigrationPlan, + connectionProviderFromSettings, + defaultImportOptions, + defaultRunOptions, + withEquivalentHistory, + ) +import Database.PostgreSQL.Migrate.CLI +import Database.PostgreSQL.Migrate.History.Codd + ( defaultCoddLockKey, + importCoddHistoryWithValidators, + withCoddLockKey, + ) +import Hasql.Connection.Settings qualified as Settings +import Kioku.App (runAppIO, withNoopAppEnv) +import Kioku.Migrations (kiokuMigrationPlan) +import Kioku.Migrations.History.Codd + ( cohortCoddHistoryMappings, + cohortCoddSourceConfig, + cohortCoddStateValidators, + ) +import Kioku.ReadModel (ReadModelSchema (..), ReconcileOutcome (..), reconcileReadModelRegistry) +import Kiroku.Store.Connection (defaultConnectionSettings) +import Options.Applicative +import Options.Applicative qualified as Opt +import System.Environment (lookupEnv) +import System.Exit qualified as Exit +import Text.Read qualified as Read + +-- | Apply the migration chain, then reconcile keiro's read-model registry to the +-- identity this binary's read models declare. +-- +-- The second half is what keeps a read-model version bump from taking production +-- down: keiro's @registerReadModel@ only ever inserts, so an existing registry row +-- stays pinned at its old version and every query for that model fails closed with +-- @ReadModelStaleSchema@. Reconciling here means the repair ships with the schema +-- change instead of needing a hand-written registry migration per bump. Migration +-- time is also the only moment where exactly one process is doing this; doing it at +-- app startup would have every host racing to write the registry on boot. +main :: IO () +main = do + plan <- either (fail . show) pure kiokuMigrationPlan + command <- + execParser + ( info + (kiokuCommandParser plan <**> helper) + (fullDesc <> progDesc "Manage the Kiroku, Keiro, and Kioku migration components") + ) + defaultDatabaseUrl <- lookupEnv "DATABASE_URL" + case command of + Standard migrationCommand -> runStandardCommand plan defaultDatabaseUrl migrationCommand + ImportCodd importOptions -> runImportCommand plan defaultDatabaseUrl importOptions + +data KiokuCommand + = Standard !MigrationCommand + | ImportCodd !CoddImportOptions + +data CoddImportOptions = CoddImportOptions + { targetSettings :: !(Maybe Settings.Settings), + sourceSettings :: !(Maybe Settings.Settings), + sourceLockKey :: !Int64, + strictSource :: !Bool, + reason :: !Text.Text, + confirmation :: !Confirmation, + outputFormat :: !OutputFormat + } + +kiokuCommandParser :: MigrationPlan -> Parser KiokuCommand +kiokuCommandParser plan = + (Standard <$> migrationCommandParser plan) + <|> hsubparser + ( Opt.command + "import" + ( info + (ImportCodd <$> coddImportOptionsParser <**> helper) + (progDesc "Import the 30-migration pinned Kiroku/Keiro/Kioku Codd cohort without replaying DDL") + ) + ) + +coddImportOptionsParser :: Parser CoddImportOptions +coddImportOptionsParser = + CoddImportOptions + <$> optional (databaseUrlOption "database-url" "Target PostgreSQL connection string; defaults to DATABASE_URL") + <*> optional (databaseUrlOption "source-database-url" "Codd source connection string; defaults to the target") + <*> option + auto + ( long "source-lock-key" + <> metavar "INT64" + <> value defaultCoddLockKey + <> showDefault + <> help "Cooperating Codd advisory-lock key" + ) + <*> switch (long "strict-source" <> help "Reject unselected rows in the shared Codd ledger") + <*> strOption (long "reason" <> metavar "TEXT" <> help "Audit reason recorded with every imported migration") + <*> flag NotConfirmed Confirmed (long "confirm" <> help "Confirm the checked-in Codd payload evidence") + <*> flag TextOutput JsonOutput (long "json" <> help "Emit JSON schema version 1") + where + databaseUrlOption optionName description = + option + (Settings.connectionString . Text.pack <$> str) + (long optionName <> metavar "URL" <> help description) + +runStandardCommand :: MigrationPlan -> Maybe String -> MigrationCommand -> IO () +runStandardCommand plan defaultDatabaseUrl command = do + let defaultSettings = + Settings.connectionString (Text.pack (maybe "" id defaultDatabaseUrl)) + environment = cliEnvironment defaultSettings plan defaultRunOptions + outcome <- runMigrationCommand environment command + case commandOutputFormat command of + TextOutput -> Text.IO.putStrLn (renderMigrationCommandText outcome) + JsonOutput -> LazyByteString.putStrLn (Aeson.encode (renderMigrationCommandJson outcome)) + reconcileAfterUp defaultDatabaseUrl command outcome + Exit.exitWith + (case exitClass outcome of ExitSucceeded -> Exit.ExitSuccess; _ -> Exit.ExitFailure 1) + +runImportCommand :: MigrationPlan -> Maybe String -> CoddImportOptions -> IO () +runImportCommand plan defaultDatabaseUrl options = do + let fallbackSettings = Settings.connectionString (Text.pack (maybe "" id defaultDatabaseUrl)) + targetSettings = maybe fallbackSettings id options.targetSettings + sourceSettings = maybe targetSettings id options.sourceSettings + targetProvider = connectionProviderFromSettings targetSettings + sourceProvider = connectionProviderFromSettings sourceSettings + config <- + either + (Exit.die . ("invalid Codd import configuration: " <>) . show) + pure + ( cohortCoddSourceConfig + sourceProvider + options.strictSource + options.reason + options.confirmation + ) + imported <- + importCoddHistoryWithValidators + (withEquivalentHistory AllowEquivalentHistory defaultImportOptions) + cohortCoddStateValidators + (withCoddLockKey options.sourceLockKey config) + targetProvider + plan + cohortCoddHistoryMappings + report <- either (Exit.die . ("Codd history import failed: " <>) . show) pure imported + case options.outputFormat of + JsonOutput -> LazyByteString.putStrLn (Aeson.encode (renderHistoryImportJson "codd" report)) + TextOutput -> renderImportReport report + +renderImportReport :: HistoryImportReport -> IO () +renderImportReport HistoryImportReport {importResults, cleanupIssues} = do + for_ (NonEmpty.toList importResults) \HistoryImportResult {importedMigration, importOutcome} -> + putStrLn + ( show importedMigration + <> ": " + <> case importOutcome of + Imported -> "imported" + AlreadyImported -> "already imported" + ) + for_ cleanupIssues \cleanupIssue -> + putStrLn ("cleanup_issue=" <> show cleanupIssue) + +reconcileAfterUp :: Maybe String -> MigrationCommand -> CliOutcome -> IO () +reconcileAfterUp defaultDatabaseUrl command outcome = + case (command, exitClass outcome) of + (Up UpOptions {connection = ConnectionOptions override}, ExitSucceeded) -> + reconcile (maybe defaultConnectionString settingsConnectionString override) + _ -> pure () + where + defaultConnectionString = Text.pack (maybe "" id defaultDatabaseUrl) + +settingsConnectionString :: Settings.Settings -> Text.Text +settingsConnectionString settings = + case Read.readMaybe (show settings) of + Just connectionString -> Text.pack connectionString + Nothing -> error "Hasql rendered an unreadable connection string" + +reconcile :: Text.Text -> IO () +reconcile connectionString = + withNoopAppEnv (defaultConnectionSettings connectionString) \env -> do + result <- + runAppIO env reconcileReadModelRegistry + case result of + Left err -> Exit.die ("read-model registry reconciliation failed: " <> show err) + Right outcomes -> for_ outcomes report + +commandOutputFormat :: MigrationCommand -> OutputFormat +commandOutputFormat command = + case command of + Plan PlanOptions {output = OutputOptions format} -> format + List ListOptions {output = OutputOptions format} -> format + Check CheckOptions {output = OutputOptions format} -> format + Status StatusOptions {output = OutputOptions format} -> format + Verify VerifyOptions {output = OutputOptions format} -> format + Up UpOptions {output = OutputOptions format} -> format + Repair RepairOptions {output = OutputOptions format} -> format + New NewOptions {output = OutputOptions format} -> format + +-- | Report only what changed, so a no-op run stays quiet. +report :: (ReadModelSchema, ReconcileOutcome) -> IO () +report (schema, outcome) = + case outcome of + AlreadyCurrent -> pure () + Registered -> say "registered read model" + Reconciled -> say "reconciled read model" + where + say verb = + putStrLn + ( verb + <> " " + <> Text.unpack schema.readModelName + <> " at v" + <> show schema.readModelVersion + <> " (" + <> Text.unpack schema.readModelShapeHash + <> ")" + ) diff --git a/kioku-migrate.cabal b/kioku-migrate.cabal new file mode 100644 --- /dev/null +++ b/kioku-migrate.cabal @@ -0,0 +1,56 @@ +cabal-version: 3.0 +name: kioku-migrate +version: 0.1.0.0 +synopsis: The kioku schema migration entry point +description: + Applies kioku's migration chain and then reconciles keiro's read-model + registry to the identity the compiled read models declare. + . + This lives in its own package rather than as an executable of + kioku-migrations because it depends on kioku-core (for the read-model + schemas), and kioku-core's test suite depends on + kioku-migrations:test-support. Cabal's solver detects dependency cycles at + package granularity, so an executable stanza inside kioku-migrations would + close that cycle and make the whole project unsolvable -- even though the + component graph itself is acyclic. + +license: BSD-3-Clause +license-file: LICENSE +author: Nadeem Bitar +maintainer: nadeem@gmail.com +copyright: 2026 Nadeem Bitar +category: Database +build-type: Simple +homepage: https://github.com/shinzui/kioku +bug-reports: https://github.com/shinzui/kioku/issues +extra-doc-files: CHANGELOG.md + +source-repository head + type: git + location: https://github.com/shinzui/kioku.git + subdir: kioku-migrate + +executable kioku-migrate + main-is: Main.hs + hs-source-dirs: app + default-language: GHC2024 + default-extensions: + BlockArguments + DuplicateRecordFields + OverloadedRecordDot + OverloadedStrings + + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + , aeson >=2.2 && <2.3 + , base >=4.21 && <5 + , bytestring >=0.12 && <0.13 + , hasql >=1.10 && <1.11 + , kioku-core ^>=0.1.0.0 + , kioku-migrations ^>=0.1.0.0 + , kiroku-store ^>=0.3.0.1 + , optparse-applicative >=0.17 && <0.20 + , pg-migrate ^>=1.1.0.0 + , pg-migrate-cli ^>=1.1.0.0 + , pg-migrate-import-codd ^>=1.1.0.0 + , text >=2.0 && <2.2