packages feed

clickhouse-migrate-cli (empty) → 0.1.0.0

raw patch · 18 files changed

+1747/−0 lines, 18 filesdep +aesondep +basedep +bytestring

Dependencies added: aeson, base, bytestring, clickhouse-migrate, clickhouse-migrate-cli, containers, optparse-applicative, text

Files

+ CHANGELOG.md view
@@ -0,0 +1,18 @@+# Changelog for clickhouse-migrate-cli++## 0.1.0.0 — 2026-10-16++Initial release.++### New Features++- Reusable, composable administrative CLI for `clickhouse-migrate`+  (`ClickHouseMigrate.CLI`) with application-owned configuration, coordination,+  rendering and exit policy.+- Composable parsing and dispatch of guarded commands with explicit result+  contracts (`ClickHouseMigrate.CLI.Parser`, `ClickHouseMigrate.CLI.Handler`).+- Text and `schemaVersion` 1 JSON rendering+  (`ClickHouseMigrate.CLI.Render.Text`, `ClickHouseMigrate.CLI.Render.Json`).+- Bounded adoption input files (`ClickHouseMigrate.CLI.AdoptionFile`).+- Preserves partial evidence, explicit recovery, stdout/stderr separation and+  cancellation.
+ LICENSE view
@@ -0,0 +1,25 @@+Copyright (c) 2026, shinzui+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.
+ README.md view
@@ -0,0 +1,20 @@+# clickhouse-migrate-cli++Mount `commandParser` or use `parseInvocation`, then pass the application-owned+environment and compiled plan to `handleCommand`. The application chooses configuration,+exclusive-access provider, event/diagnostic sinks, command policy, stdout and exit code.+The reusable library performs no implicit environment/secret loading or process exit.+Offline plan never evaluates the environment; mutations require a provider.++Includes plan, status, history, verify with require-current, up with explicit retained+initialization UUID, all four repair operations, and adoption preview/apply/resume.+No force/reset/checksum-rewrite operations. Repair/adoption validate explicit audit,+expected state and quiescence/evidence before core dispatch. Adoption reads only an+explicit bounded strict JSON evidence file; executable SQL comes from the compiled plan.++`renderJson` returns one schemaVersion 1 document without a newline. The caller writes+it after normal return and keeps progress on a separate sink. Synchronous failures+retain primary cause, latest acknowledged report, query/receipt identities and separate+secondary errors. Cancellation is rethrown and may produce no final JSON. Default+text/JSON excludes SQL, credentials and raw exception bodies. Frozen golden fixtures+ship under test/golden; the workspace's docs/user/contracts/json-v1.md defines the wire format.
+ clickhouse-migrate-cli.cabal view
@@ -0,0 +1,67 @@+cabal-version: 3.12+name: clickhouse-migrate-cli+version: 0.1.0.0+synopsis: Reusable administrative CLI for ClickHouse migrations+description:+  Reusable administrative CLI for ClickHouse migrations.+  Application-owned configuration, coordination, rendering and exit policy.++license: BSD-3-Clause+license-file: LICENSE+author: shinzui+maintainer: shinzui@users.noreply.github.com+category: Database+build-type: Simple+extra-doc-files:+  CHANGELOG.md+  README.md++data-files: test/golden/*.json+tested-with: ghc ==9.12.4++source-repository head+  type: git+  location: https://github.com/shinzui/clickhouse-migrate.git+  subdir: clickhouse-migrate-cli++common common+  default-language: GHC2024+  default-extensions:+    DeriveAnyClass+    DuplicateRecordFields+    OverloadedLabels+    OverloadedStrings++  ghc-options:+    -Wall+    -Werror=incomplete-patterns++  build-depends:+    aeson >=2.2.4.1 && <2.4,+    base >=4.21 && <4.22,+    bytestring >=0.12.2 && <0.13,+    clickhouse-migrate ==0.1.*,+    containers >=0.7 && <0.9,+    optparse-applicative >=0.18.1 && <0.20,+    text >=2.1 && <2.2,++library+  import: common+  hs-source-dirs: src+  exposed-modules:+    ClickHouseMigrate.CLI+    ClickHouseMigrate.CLI.AdoptionFile+    ClickHouseMigrate.CLI.Handler+    ClickHouseMigrate.CLI.Parser+    ClickHouseMigrate.CLI.Render.Json+    ClickHouseMigrate.CLI.Render.Text+    ClickHouseMigrate.CLI.Types++test-suite clickhouse-migrate-cli-test+  import: common+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Main.hs+  build-depends: clickhouse-migrate-cli+  other-modules: Paths_clickhouse_migrate_cli+  autogen-modules: Paths_clickhouse_migrate_cli
+ src/ClickHouseMigrate/CLI.hs view
@@ -0,0 +1,18 @@+-- | Reusable commands around an application's compiled plan. The application+-- owns configuration, coordination, diagnostics, stdout and process exit policy.+-- 'handleCommand' returns synchronous failures with the last acknowledged report;+-- asynchronous exceptions propagate after the core's bounded cleanup.+module ClickHouseMigrate.CLI+  ( module ClickHouseMigrate.CLI.Types,+    module ClickHouseMigrate.CLI.Parser,+    module ClickHouseMigrate.CLI.Handler,+    renderJson,+    renderText,+  )+where++import ClickHouseMigrate.CLI.Handler+import ClickHouseMigrate.CLI.Parser+import ClickHouseMigrate.CLI.Render.Json (renderJson)+import ClickHouseMigrate.CLI.Render.Text (renderText)+import ClickHouseMigrate.CLI.Types
+ src/ClickHouseMigrate/CLI/AdoptionFile.hs view
@@ -0,0 +1,124 @@+-- | Explicit bounded source-neutral input. SQL definitions always come from the+-- compiled plan; historical bytes here can only verify predecessor evidence.+module ClickHouseMigrate.CLI.AdoptionFile (readAdoptionInput, decodeAdoptionInput) where++import ClickHouseMigrate.Adoption qualified as A+import ClickHouseMigrate.CLI.Types+import ClickHouseMigrate.Ledger qualified as L+import ClickHouseMigrate.Prelude+import ClickHouseMigrate.Target (TargetKey)+import Control.Exception (IOException, try)+import Data.Aeson (Value (..), eitherDecodeStrict')+import Data.Aeson.Decoding.ByteString (bsToTokens)+import Data.Aeson.Decoding.Tokens+import Data.Aeson.Key qualified as Key+import Data.Aeson.KeyMap qualified as KM+import Data.ByteString qualified as BS+import Data.Foldable (toList)+import Data.List.NonEmpty qualified as NE+import Data.Set qualified as Set+import Data.Text qualified as Text+import System.IO (IOMode (ReadMode), withBinaryFile)++readAdoptionInput :: FilePath -> IO (Either CommandError ByteString)+readAdoptionInput file = do+  result <- try @IOException (withBinaryFile file ReadMode (\handle -> BS.hGet handle 16777217))+  pure $ case result of Left _ -> Left InputUnavailable; Right bytes | BS.length bytes > 16777216 -> Left InputTooLarge; Right bytes -> Right bytes++-- The public Aeson token API is walked before duplicate keys are discarded,+-- including escaped aliases. Parser errors never carry arbitrary input text.+checkTokens :: Int -> Tokens k String -> Either CommandError k+checkTokens _ (TkLit _ next) = Right next+checkTokens _ (TkText _ next) = Right next+checkTokens _ (TkNumber _ next) = Right next+checkTokens depth (TkArrayOpen values) | depth < 64 = checkArray (depth + 1) values+checkTokens depth (TkRecordOpen pairs) | depth < 64 = checkRecord (depth + 1) Set.empty pairs+checkTokens _ _ = Left InvalidJsonInput++checkArray :: Int -> TkArray k String -> Either CommandError k+checkArray _ (TkArrayEnd next) = Right next+checkArray _ (TkArrayErr _) = Left InvalidJsonInput+checkArray depth (TkItem value) = checkTokens depth value >>= checkArray depth++checkRecord :: Int -> Set Key.Key -> TkRecord k String -> Either CommandError k+checkRecord _ _ (TkRecordEnd next) = Right next+checkRecord _ _ (TkRecordErr _) = Left InvalidJsonInput+checkRecord depth seen (TkPair key value)+  | Set.member key seen = Left DuplicateJsonKey+  | otherwise = checkTokens depth value >>= checkRecord depth (Set.insert key seen)++objectAt :: [Key.Key] -> Value -> Either CommandError (KM.KeyMap Value)+objectAt allowed (Object value) | all (`elem` allowed) (KM.keys value) = Right value+objectAt _ _ = Left InvalidAdoptionInput++member :: Key.Key -> KM.KeyMap Value -> Either CommandError Value+member name = maybe (Left InvalidAdoptionInput) Right . KM.lookup name++textAt :: Value -> Either CommandError Text+textAt (String value) = Right value+textAt _ = Left InvalidAdoptionInput++arrayAt :: Value -> Either CommandError [Value]+arrayAt (Array values) | length values <= 1000 = Right (toList values)+arrayAt (Array _) = Left InputTooLarge+arrayAt _ = Left InvalidAdoptionInput++unhex :: Text -> Either CommandError ByteString+unhex value+  | Text.length value > 4194304 = Left InputTooLarge+  | odd (Text.length value) = Left InvalidAdoptionInput+  | otherwise = BS.pack <$> go [] (Text.unpack value)+  where+    nibble c+      | c >= '0' && c <= '9' = Right (fromEnum c - fromEnum '0')+      | c >= 'a' && c <= 'f' = Right (fromEnum c - fromEnum 'a' + 10)+      | otherwise = Left InvalidAdoptionInput+    go acc [] = Right (reverse acc)+    go acc (a : b : rest) = do x <- nibble a; y <- nibble b; go (fromIntegral (x * 16 + y) : acc) rest+    go _ _ = Left InvalidAdoptionInput++core :: Either A.AdoptionError a -> Either CommandError a+core = either (const (Left InvalidAdoptionInput)) Right++decodeAdoptionInput :: TargetKey -> L.ExpectedLedgerState -> Maybe L.InitializationAuthorization -> L.QuiescenceEvidence -> L.AuditContext -> ByteString -> Either CommandError A.AdoptionRequest+decodeAdoptionInput target expected authorization quiet audit bytes = do+  when (BS.length bytes > 16777216) (Left InputTooLarge)+  _ <- checkTokens 0 (bsToTokens bytes)+  value <- either (const (Left InvalidJsonInput)) Right (eitherDecodeStrict' bytes)+  object <- objectAt ["schemaVersion", "source", "snapshotReference", "rows", "mappings"] value+  version <- member "schemaVersion" object+  unless (version == Number 1) (Left UnsupportedInputVersion)+  source <- member "source" object >>= textAt+  reference <- member "snapshotReference" object >>= textAt+  rows <- member "rows" object >>= arrayAt >>= traverse parseRow+  mappings <- member "mappings" object >>= arrayAt >>= traverse parseMapping+  nonemptyRows <- maybe (Left InvalidAdoptionInput) Right (NE.nonEmpty rows)+  nonemptyMappings <- maybe (Left InvalidAdoptionInput) Right (NE.nonEmpty mappings)+  core (A.adoptionRequest target expected authorization quiet audit source reference nonemptyRows nonemptyMappings)+  where+    parseRow value = do+      object <- objectAt ["id", "appliedAt", "checksum"] value+      identity <- member "id" object >>= textAt+      appliedAt <- member "appliedAt" object >>= textAt+      checksum <- case KM.lookup "checksum" object of+        Nothing -> Right Nothing+        Just Null -> Right Nothing+        Just stored -> do+          fields <- objectAt ["algorithm", "digest"] stored+          algorithm <- member "algorithm" fields >>= textAt+          digest <- member "digest" fields >>= textAt+          Just <$> core (A.sourceChecksum algorithm digest)+      core (A.legacyRow identity appliedAt checksum)+    parseMapping value = do+      object <- objectAt ["row", "component", "migration", "checksum", "evidence"] value+      row <- member "row" object >>= textAt+      component <- member "component" object >>= textAt+      migration <- member "migration" object >>= textAt+      checksum <- member "checksum" object >>= textAt+      evidence <- member "evidence" object >>= objectAt ["level", "references", "historicalBytesHex"]+      level <- member "level" evidence >>= textAt+      refs <- member "references" evidence >>= arrayAt >>= traverse textAt+      case level of+        "operator-attestation" | not (KM.member "historicalBytesHex" evidence) -> core (A.attestedMapping row component migration checksum refs)+        "predecessor-checksum" -> do historical <- member "historicalBytesHex" evidence >>= textAt >>= unhex; core (A.verifiedMapping row component migration checksum historical refs)+        _ -> Left InvalidAdoptionInput
+ src/ClickHouseMigrate/CLI/Handler.hs view
@@ -0,0 +1,148 @@+-- | Dispatch with application-owned configuration, sinks and command policy.+module ClickHouseMigrate.CLI.Handler (commandEnvironment, handleCommand, planReport, quiescenceForCommand) where++import ClickHouseMigrate+import ClickHouseMigrate.Adoption qualified as A+import ClickHouseMigrate.CLI.AdoptionFile+import ClickHouseMigrate.CLI.Parser (commandName, isMutation)+import ClickHouseMigrate.CLI.Types+import ClickHouseMigrate.Event qualified as E+import ClickHouseMigrate.ExclusiveAccess (ExclusiveAccess)+import ClickHouseMigrate.Inspection qualified as I+import ClickHouseMigrate.Ledger qualified as L+import ClickHouseMigrate.Prelude+import ClickHouseMigrate.Repair qualified as Repair+import ClickHouseMigrate.Report qualified as R+import ClickHouseMigrate.Runner qualified as Run+import Data.List.NonEmpty qualified as NE+import Data.Set qualified as Set++commandEnvironment :: Maybe TargetConfig -> Maybe ExclusiveAccess -> E.EventSink -> E.DiagnosticPolicy -> CommandPolicy -> CommandEnvironment+commandEnvironment = CommandEnvironment++planReport :: MigrationPlan -> [PlanComponent]+planReport plan =+  [ PlanComponent+      (componentNameText (componentViewName component))+      (map componentNameText (Set.toAscList (componentDependencies component)))+      [ PlanMigration+          (migrationNameText (migrationIdName (migrationId migration)))+          (migrationDescription migration)+          (migrationChecksumHex (migrationChecksum migration))+          [PlanStep (stepNameText (stepViewName step)) (stepChecksumHex (stepChecksum step)) | step <- NE.toList (migrationSteps migration)]+      | migration <- NE.toList (componentMigrations component)+      ]+  | component <- NE.toList (inspectPlan plan)+  ]++makeAudit :: AuditInput -> Either CommandError L.AuditContext+makeAudit (AuditInput actor reason refs) = either (const (Left InvalidAuditInput)) Right (L.auditContext actor reason refs)++makeQuiet :: TargetKey -> AuditInput -> Bool -> Either CommandError (Maybe L.QuiescenceEvidence)+makeQuiet _ _ False = Right Nothing+makeQuiet key input@(AuditInput _ _ refs) True = do+  unless (not (null refs)) (Left RecoveryEvidenceRequired)+  audit <- makeAudit input+  Just <$> either (const (Left InvalidAuditInput)) Right (L.attestQuiescence key audit)++-- Applications may use this to construct a conservative development provider.+-- It does not prove exclusion/drain; the assertion remains the caller's duty.+quiescenceForCommand :: TargetKey -> Command -> Either CommandError (Maybe L.QuiescenceEvidence)+quiescenceForCommand actual = \case+  UpCommand (UpInput expected audit _ quiet) -> match expected >> makeQuiet actual audit quiet+  RepairCommand _ (RepairInput expected _ _ _ audit quiet _) -> match expected >> required audit quiet+  AdoptCommand _ (AdoptionInput expected _ _ audit quiet _ _) -> match expected >> required audit quiet+  _ -> Right Nothing+  where+    match expected = unless (actual == expected) (Left ExpectedTargetMismatch)+    required audit quiet = do+      unless quiet (Left QuiescenceRequired)+      makeQuiet actual audit quiet++data Ready = Ready !TargetConfig !(Maybe ExclusiveAccess) !E.EventSink !E.DiagnosticPolicy++prepare :: CommandEnvironment -> Command -> Either CommandError Ready+prepare (CommandEnvironment configured provider sink diagnostics policy) command = do+  when (isMutation command && policy /= AdministrativeCommands) (Left CommandNotAllowed)+  config <- maybe (Left MissingTargetConfiguration) Right configured+  when (isMutation command && isNothing provider) (Left MissingExclusiveAccess)+  let key = configuredTargetKey config+  _ <- quiescenceForCommand key command+  case command of+    UpCommand (UpInput _ audit _ _) -> void (makeAudit audit)+    RepairCommand _ (RepairInput _ _ _ _ audit _ _) -> void (makeAudit audit)+    AdoptCommand _ (AdoptionInput _ _ _ audit _ _ file) -> do+      void (makeAudit audit)+      when (null file || '\0' `elem` file) (Left InvalidAdoptionInput)+    _ -> pure ()+  pure (Ready config provider sink diagnostics)++inspection :: Maybe ExclusiveAccess -> Bool -> Either CommandError I.InspectionOptions+inspection _ False = Right I.Observe+inspection provider True = maybe (Left MissingExclusiveAccess) (Right . I.Guarded) provider++-- Offline plan deliberately does not force the environment argument.+handleCommand :: CommandEnvironment -> MigrationPlan -> Command -> IO CommandResult+handleCommand _ plan PlanCommand = pure (CommandResult "plan" (Right (PlanReport (planReport plan) [(componentNameText (migrationIdComponent identity), migrationNameText (migrationIdName identity)) | view <- NE.toList (inspectSchedule plan), let identity = migrationId view])))+handleCommand environment plan command =+  let name = commandName command+      reject = pure . CommandResult name . Left . CommandRejected+      finish = pure . CommandResult name+   in case prepare environment command of+        Left failure -> reject failure+        Right (Ready config provider sink diagnostics) ->+          let readWith guarded action = case inspection provider guarded of Left failure -> reject failure; Right options -> action options >>= finish+              mutate action = case provider of Nothing -> reject MissingExclusiveAccess; Just access -> action (Run.mutationContext config access sink diagnostics)+           in case command of+                StatusCommand guarded -> readWith guarded (\options -> fmap (either (Left . InspectionFailed) (Right . StatusReport)) (I.status options config plan))+                HistoryCommand guarded -> readWith guarded (\options -> fmap (either (Left . InspectionFailed) (Right . HistoryReport)) (I.history options config))+                VerifyCommand current guarded -> readWith guarded (\options -> fmap (either (Left . InspectionFailed) (Right . VerificationReport)) (I.verify options config (I.verifyOptions current) plan))+                UpCommand (UpInput target input initialization _) -> case makeAudit input of+                  Left failure -> reject failure+                  Right audit -> mutate $ \context -> Run.up context (Run.upOptions audit (fmap (\ledger -> L.authorizeInitialization target ledger audit) initialization)) plan >>= finish . either (Left . RunFailed) (Right . RunReport)+                RepairCommand operation (RepairInput _ expected attempt selected input quiet receipts) -> case recovery config input quiet receipts of+                  Left failure -> reject failure+                  Right evidence -> case buildRepair operation expected attempt selected evidence of+                    Left failure -> reject failure+                    Right request -> mutate $ \context -> Repair.repair context plan request >>= finish . either (Left . RunFailed) (Right . RunReport)+                AdoptCommand operation (AdoptionInput target expected initialization input quiet guarded file) -> case makeAdoption target expected initialization input quiet of+                  Left failure -> reject failure+                  Right (state, authorization, established, audit) -> do+                    loaded <- readAdoptionInput file+                    case loaded >>= decodeAdoptionInput target state authorization established audit of+                      Left failure -> reject failure+                      Right request -> case inspection provider guarded of+                        Left failure -> reject failure+                        Right options -> do+                          observed <- I.status options config plan+                          case observed of+                            Left failure -> finish (Left (InspectionFailed failure))+                            Right snapshot -> case A.planAdoption plan snapshot request of+                              Left failure -> let R.InspectionReport observedHistory _ _ = snapshot in finish (Left (AdoptionRejected failure observedHistory))+                              Right adoption -> case operation of+                                PlanAdoption -> let R.InspectionReport observedHistory _ _ = snapshot in finish (Right (AdoptionPlanReport observedHistory (A.inspectAdoption adoption) (A.adoptionEntries adoption)))+                                ApplyAdoption -> mutate $ \context -> A.applyAdoption context plan adoption >>= finish . either (Left . RunFailed) (Right . RunReport)+                                ResumeAdoption -> mutate $ \context -> A.resumeAdoption context plan adoption >>= finish . either (Left . RunFailed) (Right . RunReport)++recovery :: TargetConfig -> AuditInput -> Bool -> [L.AppendReceipt] -> Either CommandError Repair.RecoveryEvidence+recovery config input quiet receipts = do+  established <- makeQuiet (configuredTargetKey config) input quiet >>= maybe (Left QuiescenceRequired) Right+  audit <- makeAudit input+  either (const (Left InvalidRepairInput)) Right (Repair.recoveryEvidence audit established receipts)++buildRepair :: RepairOperation -> L.LedgerPosition -> L.AttemptId -> Maybe R.StepAttempt -> Repair.RecoveryEvidence -> Either CommandError Repair.RepairRequest+buildRepair operation expected attempt selected evidence = either (const (Left InvalidRepairInput)) Right $ case (operation, selected) of+  (Resume, Nothing) -> Repair.resumeRequest expected attempt evidence+  (Finalize, Nothing) -> Repair.finalizeRequest expected attempt evidence+  (RetryStep, Just step) -> Repair.retryStepRequest expected attempt step evidence+  (AcceptStep, Just step) -> Repair.acceptStepRequest expected attempt step evidence+  _ -> Left Repair.InvalidStepAttempt++makeAdoption :: TargetKey -> ExpectedInput -> Maybe LedgerId -> AuditInput -> Bool -> Either CommandError (L.ExpectedLedgerState, Maybe L.InitializationAuthorization, L.QuiescenceEvidence, L.AuditContext)+makeAdoption target expected initialization input quiet = do+  established <- makeQuiet target input quiet >>= maybe (Left QuiescenceRequired) Right+  audit <- makeAudit input+  let state = case expected of AbsentInput -> L.ExpectAbsent target; PositionInput position -> L.ExpectPosition position+      authorization = fmap (\ledger -> L.authorizeInitialization target ledger audit) initialization+  when (case expected of AbsentInput -> isNothing authorization; _ -> False) (Left InitializationRequired)+  pure (state, authorization, established, audit)
+ src/ClickHouseMigrate/CLI/Parser.hs view
@@ -0,0 +1,131 @@+-- | Composable optparse-applicative parser. The caller owns its outer executable.+module ClickHouseMigrate.CLI.Parser (commandParser, commandInfo, parseInvocation, commandName, requiresTarget, isMutation) where++import ClickHouseMigrate.CLI.Types+import ClickHouseMigrate.Definition qualified as D+import ClickHouseMigrate.Ledger qualified as L+import ClickHouseMigrate.Prelude+import ClickHouseMigrate.Repair qualified as Repair+import ClickHouseMigrate.Report qualified as R+import ClickHouseMigrate.Target qualified as T+import Control.Applicative (many, optional, some, (<**>), (<|>))+import Data.Text qualified as Text+import Options.Applicative qualified as O+import System.Exit (ExitCode (..))++readValidated :: (Show e) => (Text -> Either e a) -> O.ReadM a+readValidated parse = O.eitherReader (either (Left . show) Right . parse . Text.pack)++textOption :: String -> String -> String -> O.Parser Text+textOption name metavar description = O.option reader (O.long name <> O.metavar metavar <> O.help description)+  where+    reader = O.eitherReader $ \raw ->+      let value = Text.pack raw+          checked = case name of "actor" -> L.auditContext value "parser validation" []; "reason" -> L.auditContext "parser validation" value []; _ -> L.auditContext "parser validation" "parser validation" [value]+       in either (const (Left "Invalid audit field")) (const (Right value)) checked++output :: O.Parser OutputFormat+output = O.flag TextOutput JsonOutput (O.long "json" <> O.help "Return one schemaVersion 1 command-result JSON document; progress uses the caller sink")++audit :: Bool -> O.Parser AuditInput+audit required = AuditInput <$> textOption "actor" "ACTOR" "Administrative actor retained in immutable history" <*> textOption "reason" "REASON" "Reason retained in immutable history" <*> (if required then some evidence else many evidence)+  where+    evidence = textOption "evidence" "REFERENCE" "External evidence reference; repeat for additional evidence"++expectedTarget :: O.Parser T.TargetKey+expectedTarget = O.option (readValidated T.targetKey) (O.long "expect-target" <> O.metavar "TARGET" <> O.help "Exact configured target key")++initialization :: O.Parser (Maybe T.LedgerId)+initialization = optional (O.option (readValidated T.ledgerId) (O.long "initialize-ledger" <> O.metavar "UUID" <> O.help "Explicit first-use UUID; retain before submission, then persist the returned ledger binding"))++quiescent :: Bool -> O.Parser Bool+quiescent required = if required then O.flag' True description else O.switch description+  where+    description = O.long "quiescent" <> O.help "Assert external exclusion and complete drain of all predecessor SQL, ledger and bootstrap requests; absence/timeout is insufficient"++guarded :: O.Parser Bool+guarded = O.switch (O.long "guarded" <> O.help "Acquire the caller's provider for this observation")++stepAttempt :: O.Parser R.StepAttempt+stepAttempt = R.StepAttempt <$> O.option (readValidated L.parseAttemptId) (O.long "step-attempt" <> O.metavar "UUID" <> O.help "Original migration attempt owning the selected step query") <*> O.option (O.eitherReader (either (const (Left "Invalid stable step name")) (Right . D.stepNameText) . D.stepName . Text.pack)) (O.long "step" <> O.metavar "STEP") <*> O.option (readValidated T.queryId) (O.long "query-id" <> O.metavar "QUERY_ID" <> O.help "Exact selected query identity from history")++repairInput :: Bool -> O.Parser RepairInput+repairInput selected = RepairInput <$> expectedTarget <*> O.option (readValidated L.parseLedgerPosition) (O.long "expect-position" <> O.metavar "TOKEN") <*> O.option (readValidated L.parseAttemptId) (O.long "attempt" <> O.metavar "UUID" <> O.help "Current migration attempt from fresh guarded history") <*> (if selected then Just <$> stepAttempt else pure Nothing) <*> audit True <*> quiescent True <*> many (O.option (readValidated L.parseAppendReceipt) (O.long "pending-append" <> O.metavar "RECEIPT" <> O.help "Retained exact uncertain append receipt; repeat as needed"))++adoptionInput :: O.Parser AdoptionInput+adoptionInput = AdoptionInput <$> expectedTarget <*> expected <*> initialization <*> audit True <*> quiescent True <*> guarded <*> O.strOption (O.long "request" <> O.metavar "FILE" <> O.help "Explicit source-neutral adoption input JSON; contains no executable migration definitions")+  where+    expected = (PositionInput <$> O.option (readValidated L.parseLedgerPosition) (O.long "expect-position" <> O.metavar "TOKEN")) <|> O.flag' AbsentInput (O.long "expect-absent" <> O.help "Expect missing or compatible uninitialized native history; requires explicit initialization UUID")++leaf :: String -> String -> O.Parser Command -> O.Mod O.CommandFields Invocation+leaf name description parser = O.command name (O.info ((Invocation <$> output <*> parser) <**> O.helper) (O.progDesc description))++commandParser :: O.Parser Invocation+commandParser =+  O.hsubparser+    ( leaf "plan" "Inspect compiled definitions offline; no target or server required" (pure PlanCommand)+        <> leaf "status" "Observe definition compatibility and recorded states; never initialize" (StatusCommand <$> guarded)+        <> leaf "history" "Observe immutable history without requiring compatible current definitions" (HistoryCommand <$> guarded)+        <> leaf "verify" "Verify compatible history; pending is compatible unless --require-current. This does not verify schema equality" (VerifyCommand <$> O.switch (O.long "require-current" <> O.help "Fail when any migration remains pending") <*> guarded)+        <> leaf "up" "Execute pending SQL once per authorized attempt; unresolved history blocks; no automatic repair" (UpCommand <$> (UpInput <$> expectedTarget <*> audit False <*> initialization <*> quiescent False))+        <> O.command "repair" (O.info (repairs <**> O.helper) (O.progDesc "Explicit expected-state recovery; no force, reset or checksum rewriting"))+        <> O.command "adopt" (O.info (adoptions <**> O.helper) (O.progDesc "Review/apply/resume a complete legacy prefix without executing its SQL"))+    )+  where+    repairs = O.hsubparser (leaf "resume" "Run only never-started remaining steps of the selected migration" (RepairCommand Resume <$> repairInput False) <> leaf "retry-step" "Authorize fresh attempt/query IDs and execute only the selected step" (RepairCommand RetryStep <$> repairInput True) <> leaf "accept-step" "Attest the selected uncertain step; no SQL, continuation or finalization" (RepairCommand AcceptStep <$> repairInput True) <> leaf "finalize" "Complete a fully resolved migration without application SQL" (RepairCommand Finalize <$> repairInput False))+    adoptions = O.hsubparser (leaf "plan" "Read and validate the entire source/mapping before mutation" (AdoptCommand PlanAdoption <$> adoptionInput) <> leaf "apply" "Initialize only when explicitly authorized; append a reviewed fresh batch" (AdoptCommand ApplyAdoption <$> adoptionInput) <> leaf "resume" "Resume the identical interrupted batch at fresh expected state" (AdoptCommand ResumeAdoption <$> adoptionInput))++commandInfo :: O.ParserInfo Invocation+commandInfo = O.info (commandParser <**> O.helper) (O.fullDesc <> O.progDesc "Compiled ClickHouse migrations; application-owned configuration, coordination, logging and exit policy")++-- Invalid arguments deliberately do not echo arbitrary values or secrets.+-- Applications needing optparse's richer diagnostics may use commandInfo directly.+parseInvocation :: [String] -> Either ParseIssue Invocation+parseInvocation args = case O.execParserPure O.defaultPrefs commandInfo args of+  O.Success invocation@(Invocation _ command) -> validateParsed command >> Right invocation+  O.Failure failure -> let (helpText, exit) = O.renderFailure failure "clickhouse-migrate" in Left (if exit == ExitSuccess then HelpRequested (Text.pack helpText) else ArgumentsRejected)+  O.CompletionInvoked _ -> Left CompletionRequested++validateParsed :: Command -> Either ParseIssue ()+validateParsed = \case+  UpCommand (UpInput target input _ quiet) -> do+    auditContext <- checkedAudit input+    when (quiet && null (L.auditReferences auditContext)) (Left ArgumentsRejected)+    _ <- if quiet then validate (L.attestQuiescence target auditContext) else Right ()+    pure ()+  RepairCommand operation (RepairInput target expected attempt step input quiet receipts) -> do+    auditContext <- checkedAudit input+    unless quiet (Left ArgumentsRejected)+    established <- either (const (Left ArgumentsRejected)) Right (L.attestQuiescence target auditContext)+    evidence <- either (const (Left ArgumentsRejected)) Right (Repair.recoveryEvidence auditContext established receipts)+    case (operation, step) of+      (Resume, Nothing) -> validate (Repair.resumeRequest expected attempt evidence)+      (Finalize, Nothing) -> validate (Repair.finalizeRequest expected attempt evidence)+      (RetryStep, Just selected) -> validate (Repair.retryStepRequest expected attempt selected evidence)+      (AcceptStep, Just selected) -> validate (Repair.acceptStepRequest expected attempt selected evidence)+      _ -> Left ArgumentsRejected+  AdoptCommand _ (AdoptionInput _ expected initialLedger input quiet _ file) -> do+    auditContext <- checkedAudit input+    unless (quiet && not (null (L.auditReferences auditContext)) && not (null file) && not ('\0' `elem` file)) (Left ArgumentsRejected)+    case expected of AbsentInput | isNothing initialLedger -> Left ArgumentsRejected; _ -> Right ()+  _ -> Right ()+  where+    checkedAudit (AuditInput actor reason refs) = either (const (Left ArgumentsRejected)) Right (L.auditContext actor reason refs)+    validate = either (const (Left ArgumentsRejected)) (const (Right ()))++commandName :: Command -> Text+commandName = \case+  PlanCommand -> "plan"+  StatusCommand _ -> "status"+  HistoryCommand _ -> "history"+  VerifyCommand _ _ -> "verify"+  UpCommand _ -> "up"+  RepairCommand operation _ -> case operation of Resume -> "repair.resume"; RetryStep -> "repair.retry-step"; AcceptStep -> "repair.accept-step"; Finalize -> "repair.finalize"+  AdoptCommand operation _ -> case operation of PlanAdoption -> "adopt.plan"; ApplyAdoption -> "adopt.apply"; ResumeAdoption -> "adopt.resume"++requiresTarget :: Command -> Bool+requiresTarget PlanCommand = False+requiresTarget _ = True++isMutation :: Command -> Bool+isMutation = \case UpCommand _ -> True; RepairCommand _ _ -> True; AdoptCommand PlanAdoption _ -> False; AdoptCommand _ _ -> True; _ -> False
+ src/ClickHouseMigrate/CLI/Render/Json.hs view
@@ -0,0 +1,242 @@+-- | Explicit schemaVersion 1 encoding. No domain Generic/Show-based wire format.+module ClickHouseMigrate.CLI.Render.Json (renderJson, resultValue, commandErrorCode, runErrorCode) where++import ClickHouseMigrate.Adoption qualified as A+import ClickHouseMigrate.CLI.Types+import ClickHouseMigrate.ExclusiveAccess qualified as Access+import ClickHouseMigrate.Ledger qualified as L+import ClickHouseMigrate.Plan qualified as Plan+import ClickHouseMigrate.Prelude+import ClickHouseMigrate.Report qualified as R+import ClickHouseMigrate.Target qualified as T+import Data.Aeson (Value (..), object, (.=))+import Data.Aeson qualified as JSON+import Data.ByteString.Lazy qualified as Lazy+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Encoding++renderJson :: CommandResult -> ByteString+renderJson = Lazy.toStrict . JSON.encode . resultValue++nullable :: (a -> Value) -> Maybe a -> Value+nullable encode = maybe Null encode++resultValue :: CommandResult -> Value+resultValue (CommandResult command result) =+  object+    [ "schemaVersion" .= (1 :: Int),+      "command" .= command,+      "status" .= (case result of Left _ -> "error" :: Text; Right _ -> "ok"),+      "result" .= either (const Null) reportValue result,+      "error" .= either failureValue (const Null) result+    ]++reportValue :: CommandReport -> Value+reportValue = \case+  PlanReport components schedule -> object ["kind" .= ("plan" :: Text), "checksumFormat" .= Plan.checksumFormatName Plan.ChecksumV1, "completionPolicy" .= Encoding.decodeUtf8 Plan.completionPolicy, "components" .= componentsValue schedule 0 components, "schedule" .= [object ["ordinal" .= ordinal, "component" .= component, "migration" .= migration] | (ordinal, (component, migration)) <- zip [0 :: Int ..] schedule]]+  StatusReport report -> object ["kind" .= ("status" :: Text), "report" .= inspectionValue report]+  HistoryReport report -> object ["kind" .= ("history" :: Text), "report" .= historyValue report]+  VerificationReport (R.VerificationReport report current) -> object ["kind" .= ("verification" :: Text), "compatible" .= True, "current" .= current, "report" .= inspectionValue report]+  RunReport report -> object ["kind" .= ("run" :: Text), "report" .= runValue report]+  AdoptionPlanReport observation summary entries -> object ["kind" .= ("adoption-plan" :: Text), "observation" .= historyValue observation, "batch" .= adoptionValue summary, "entries" .= [object ["definition" .= definitionValue definition, "evidence" .= evidenceValue evidence] | (definition, evidence) <- entries]]++componentsValue :: [(Text, Text)] -> Int -> [PlanComponent] -> [Value]+componentsValue _ _ [] = []+componentsValue schedule componentIndex (PlanComponent name dependencies migrations : rest) =+  object ["index" .= componentIndex, "name" .= name, "dependencies" .= dependencies, "migrations" .= [object ["ordinal" .= lookup (name, migration) (zip schedule [0 :: Int ..]), "name" .= migration, "description" .= description, "checksum" .= checksum, "steps" .= [object ["index" .= stepIndex, "name" .= step, "checksum" .= digest] | (stepIndex, PlanStep step digest) <- zip [0 :: Int ..] steps]] | PlanMigration migration description checksum steps <- migrations]] : componentsValue schedule (componentIndex + 1) rest++definitionValue :: R.DefinitionSummary -> Value+definitionValue (R.DefinitionSummary ordinal componentIndex component dependencies migration checksum steps) = object ["ordinal" .= ordinal, "componentIndex" .= componentIndex, "component" .= component, "dependencies" .= dependencies, "migration" .= migration, "checksum" .= checksum, "steps" .= [object ["name" .= name, "checksum" .= digest] | (name, digest) <- steps]]++stepReferenceValue :: R.StepReference -> Value+stepReferenceValue (R.StepReference component migration step migrationChecksum stepChecksum) = object ["component" .= component, "migration" .= migration, "step" .= step, "migrationChecksum" .= migrationChecksum, "stepChecksum" .= stepChecksum]++evidenceValue :: R.EvidenceSummary -> Value+evidenceValue (R.EvidenceSummary level references) = object ["level" .= (case level of L.OperatorAttestation -> "operator-attestation" :: Text; L.PredecessorChecksum -> "predecessor-checksum"), "references" .= references]++stepAttemptValue :: R.StepAttempt -> Value+stepAttemptValue (R.StepAttempt owner name query) = object ["ownerAttempt" .= L.attemptIdText owner, "step" .= name, "queryId" .= T.queryIdText query]++migrationState :: R.MigrationStatus -> Text+migrationState = \case R.Pending -> "pending"; R.InProgress -> "in-progress"; R.Failed -> "failed"; R.Applied -> "applied"; R.Adopted -> "adopted"; R.Invalid -> "invalid"++stepState :: R.StepStatus -> Text+stepState = \case R.StepPending -> "pending"; R.StepUncertain -> "uncertain"; R.StepObservedSuccess -> "observed-success"; R.StepObservedFailure -> "observed-failure"; R.StepAccepted -> "accepted"++migrationValue :: R.MigrationSummary -> Value+migrationValue (R.MigrationSummary definition state attempt steps) = object ["definition" .= definitionValue definition, "state" .= migrationState state, "attempt" .= fmap L.attemptIdText attempt, "steps" .= map stepValue steps]+  where+    stepValue (R.StepSummary name checksum status selected evidence) = object ["name" .= name, "checksum" .= checksum, "state" .= stepState status, "attempt" .= nullable stepAttemptValue selected, "evidence" .= nullable evidenceValue evidence]++accessValue :: Access.AccessDescription -> Value+accessValue access = object ["strategy" .= Access.accessStrategy access, "scope" .= Access.accessScope access]++observationAccess :: R.InspectionAccess -> Value+observationAccess = \case+  R.UnguardedObservation -> object ["mode" .= ("unguarded-observation" :: Text)]+  R.GuardedObservation access -> object ["mode" .= ("guarded-observation" :: Text), "provider" .= accessValue access]++presenceValue :: R.LedgerPresence -> Value+presenceValue = \case+  R.LedgerUnknown -> object ["kind" .= ("unknown" :: Text)]+  R.LedgerMissing -> object ["kind" .= ("missing" :: Text)]+  R.LedgerUninitialized -> object ["kind" .= ("uninitialized" :: Text)]+  R.LedgerInitializedAt ledger -> object ["kind" .= ("initialized" :: Text), "ledgerId" .= T.ledgerIdText ledger]++serverValue :: T.ServerIdentity -> Value+serverValue identity = object ["serverId" .= T.serverIdText (T.identityServerId identity), "version" .= T.identityVersion identity, "hostName" .= T.identityHostName identity]++historyValue :: R.HistoryReport -> Value+historyValue (R.HistoryReport target server presence position access events migrations unresolved) = object ["target" .= T.targetKeyText target, "server" .= nullable serverValue server, "ledger" .= presenceValue presence, "position" .= fmap L.ledgerPositionText position, "access" .= observationAccess access, "events" .= map eventValue events, "migrations" .= map migrationValue migrations, "unresolved" .= unresolved]++inspectionValue :: R.InspectionReport -> Value+inspectionValue (R.InspectionReport history migrations issues) = object ["observation" .= historyValue history, "migrations" .= map migrationValue migrations, "issues" .= map issueValue issues]++issueValue :: R.CompatibilityIssue -> Value+issueValue = \case+  R.DefinitionChanged index expected actual -> object ["code" .= ("definition-changed" :: Text), "index" .= index, "expected" .= nullable definitionValue expected, "actual" .= nullable definitionValue actual]+  R.UnresolvedAttempt attempt -> object ["code" .= ("unresolved-attempt" :: Text), "attempt" .= L.attemptIdText attempt]+  R.IncompleteAdoption batch -> object ["code" .= ("incomplete-adoption" :: Text), "batch" .= adoptionValue batch]++runValue :: R.RunReport -> Value+runValue (R.RunReport identity target access acquired history migrations observations initialized) = object ["runId" .= identity, "target" .= T.targetKeyText target, "access" .= accessValue access, "acquired" .= acquired, "history" .= historyValue history, "migrations" .= map migrationValue migrations, "observations" .= map sqlValue observations, "initializedLedgerId" .= fmap T.ledgerIdText initialized]++sqlValue :: R.SqlObservation -> Value+sqlValue (R.SqlObservation reference query evidence) = object ["step" .= stepReferenceValue reference, "queryId" .= T.queryIdText query, "evidence" .= case evidence of R.QueryAcknowledged -> object ["outcome" .= ("acknowledged-success" :: Text)]; R.QueryRejected outcome problem -> object ["outcome" .= requestEvidence outcome, "transport" .= transportValue problem]]++auditValue :: L.AuditContext -> Value+auditValue audit = object ["actor" .= L.auditActor audit, "reason" .= L.auditReason audit, "references" .= L.auditReferences audit]++adoptionValue :: R.AdoptionSummary -> Value+adoptionValue (R.AdoptionSummary source snapshot mapping definitions count) = object ["source" .= source, "snapshotDigest" .= snapshot, "mappingDigest" .= mapping, "definitionsDigest" .= definitions, "count" .= count]++eventValue :: R.HistoryEvent -> Value+eventValue (R.HistoryEvent eventSequence identity ledger run attempt time audit runner context body) = object ["sequence" .= Text.pack (show eventSequence), "eventId" .= identity, "ledgerId" .= T.ledgerIdText ledger, "runId" .= run, "attempt" .= fmap L.attemptIdText attempt, "occurredAt" .= time, "audit" .= auditValue audit, "runnerVersion" .= runner, "context" .= nullable contextValue context, "kind" .= R.historyKind body, "body" .= bodyValue body]+  where+    contextValue (component, migration, checksum, step) = object ["component" .= component, "migration" .= migration, "checksum" .= checksum, "step" .= nullable (\(name, digest) -> object ["name" .= name, "checksum" .= digest]) step]++bodyValue :: R.HistoryBody -> Value+bodyValue = \case+  R.LedgerInitialized target -> object ["target" .= T.targetKeyText target]+  R.MigrationDefinition definition -> object ["definition" .= definitionValue definition]+  R.StepIntent index query -> object ["step" .= index, "queryId" .= T.queryIdText query]+  R.StepCompletion index query -> object ["step" .= index, "queryId" .= T.queryIdText query]+  R.ExecutionFailure index query (R.FailureSummary code status server) -> object ["step" .= index, "queryId" .= T.queryIdText query, "code" .= code, "httpStatus" .= status, "serverCode" .= server]+  R.MigrationCompletion -> object []+  R.RecoveryAuthorization action expected previous next target quietAudit -> object ["action" .= recoveryValue action, "expected" .= L.ledgerPositionText expected, "previousAttempt" .= L.attemptIdText previous, "nextAttempt" .= L.attemptIdText next, "target" .= T.targetKeyText target, "quiescence" .= auditValue quietAudit]+  R.AcceptedCompletion index evidence -> object ["step" .= index, "evidence" .= evidenceValue evidence]+  R.AdoptionBeginning batch -> adoptionValue batch+  R.AdoptedDefinition definition evidence -> object ["definition" .= definitionValue definition, "evidence" .= evidenceValue evidence]+  R.AdoptionCompletion digest -> object ["mappingDigest" .= digest]++recoveryValue :: R.RecoveryAction -> Value+recoveryValue = \case R.Resume -> object ["kind" .= ("resume" :: Text)]; R.RetryStep index -> object ["kind" .= ("retry-step" :: Text), "step" .= index]; R.AcceptStep index -> object ["kind" .= ("accept-step" :: Text), "step" .= index]; R.Finalize -> object ["kind" .= ("finalize" :: Text)]++failureValue :: CommandFailure -> Value+failureValue = \case+  CommandRejected failure -> envelope "command" (object ["code" .= commandErrorCode failure]) [] Null+  AdoptionRejected failure observation -> envelope "adoption" (object ["code" .= adoptionErrorCode failure]) [] (historyValue observation)+  RunFailed (R.RunFailure primary report secondary) -> envelope "run" (runErrorValue primary) (map secondaryValue secondary) (runValue report)+  InspectionFailed (R.InspectionFailure primary observation secondary) -> envelope "inspection" (runErrorValue primary) (map secondaryValue secondary) (nullable historyValue observation)+  where+    envelope :: Text -> Value -> [Value] -> Value -> Value+    envelope category primary secondary report = object ["category" .= (category :: Text), "primary" .= primary, "secondary" .= secondary, "report" .= report]++secondaryValue :: R.SecondaryError -> Value+secondaryValue = \case+  R.RecordingError problem -> object ["kind" .= ("recording" :: Text), "error" .= runErrorValue problem]+  R.ObserverError phase -> object ["kind" .= ("observer" :: Text), "callback" .= callbackValue phase]+  R.TransportCleanup problem -> object ["kind" .= ("transport-cleanup" :: Text), "error" .= transportValue problem]+  R.AccessCleanup problem -> object ["kind" .= ("access-cleanup" :: Text), "code" .= accessErrorCode problem]++callbackValue :: R.CallbackPhase -> Value+callbackValue = \case R.EventCallback phase -> object ["kind" .= ("event" :: Text), "phase" .= phase]; R.SqlDiagnosticCallback -> object ["kind" .= ("sql-diagnostic" :: Text)]++requestEvidence :: L.RequestEvidence -> Text+requestEvidence = \case L.PositiveNonSubmission -> "positive-non-submission"; L.ObservedFailure -> "observed-server-failure"; L.UncertainSubmission -> "submission-uncertain"++transportValue :: L.TransportError -> Value+transportValue (L.TransportError code status server) = object ["code" .= transportErrorCode code, "httpStatus" .= status, "serverCode" .= server]++transportErrorCode :: L.TransportErrorCode -> Text+transportErrorCode = \case L.AdministrativeAccessLost -> "administrative-access-lost"; L.InvalidRequest -> "invalid-request"; L.ClientScopeFailed -> "client-scope-failed"; L.ConnectionFailed -> "connection-failed"; L.DeadlineExpired -> "deadline-expired"; L.ResponseInterrupted -> "response-interrupted"; L.ResponseTooLarge -> "response-too-large"; L.UnexpectedResponse -> "unexpected-response"; L.ServerRejected -> "server-rejected"; L.RedirectRejected -> "redirect-rejected"; L.ServerIdentityMismatch -> "server-identity-mismatch"; L.UnsupportedServer -> "unsupported-server"; L.CompletionPolicyMismatch -> "completion-policy-mismatch"; L.CleanupFailed -> "cleanup-failed"; L.CleanupTimedOut -> "cleanup-timed-out"++accessErrorCode :: Access.AccessError -> Text+accessErrorCode = \case Access.InvalidAccessStrategy -> "invalid-access-strategy"; Access.AcquisitionTimedOut -> "acquisition-timed-out"; Access.AcquisitionFailed -> "acquisition-failed"; Access.AccessLost -> "access-lost"; Access.AccessScopeClosed -> "access-scope-closed"; Access.AccessActionFailed -> "access-action-failed"; Access.PredecessorQuiescenceRequired -> "predecessor-quiescence-required"; Access.AccessReleaseFailed -> "access-release-failed"; Access.AccessReleaseTimedOut -> "access-release-timed-out"++ledgerErrorCode :: L.LedgerError -> Text+ledgerErrorCode = \case L.InvalidPosition -> "invalid-position"; L.InvalidAudit -> "invalid-audit"; L.InvalidEvidence -> "invalid-evidence"; L.InvalidEvent -> "invalid-event"; L.UnsupportedLedgerVersion -> "unsupported-ledger-version"; L.SequenceGap -> "sequence-gap"; L.SequenceConflict -> "sequence-conflict"; L.EventIdentityConflict -> "event-identity-conflict"; L.LedgerIdentityMismatch -> "ledger-identity-mismatch"; L.MissingInitialization -> "missing-initialization"; L.ImpossibleTransition -> "impossible-transition"; L.DefinitionMismatch -> "definition-mismatch"; L.InvalidLedgerSchema -> "invalid-ledger-schema"; L.UnsupportedLedgerStorage -> "unsupported-ledger-storage"; L.LedgerAbsent -> "ledger-absent"; L.LedgerUninitialized -> "ledger-uninitialized"; L.InitializationNotAuthorized -> "initialization-not-authorized"; L.StaleLedgerState -> "stale-ledger-state"; L.UnresolvedHistory -> "unresolved-history"; L.OutstandingRequests -> "outstanding-requests"; L.LedgerLimitExceeded -> "ledger-limit-exceeded"++adoptionErrorCode :: A.AdoptionError -> Text+adoptionErrorCode = \case A.InvalidSourceEvidence -> "invalid-source-evidence"; A.UnsupportedSourceChecksum -> "unsupported-source-checksum"; A.InvalidSourceChecksum -> "invalid-source-checksum"; A.DuplicateSourceRow -> "duplicate-source-row"; A.DuplicateMapping -> "duplicate-mapping"; A.IncompleteMapping -> "incomplete-mapping"; A.UnknownSourceRow -> "unknown-source-row"; A.MappingOrderMismatch -> "mapping-order-mismatch"; A.MappingDefinitionMismatch -> "mapping-definition-mismatch"; A.HistoricalChecksumMismatch -> "historical-checksum-mismatch"; A.HistoricalChecksumRequired -> "historical-checksum-required"; A.AdoptionTargetMismatch -> "adoption-target-mismatch"; A.AdoptionInitializationRequired -> "adoption-initialization-required"; A.AdoptionExpectedStateMismatch -> "adoption-expected-state-mismatch"; A.AdoptionNativeConflict -> "adoption-native-conflict"; A.AdoptionBatchConflict -> "adoption-batch-conflict"; A.AdoptionResumeRequired -> "adoption-resume-required"; A.AdoptionBatchTooLarge -> "adoption-batch-too-large"++repairReason :: R.RepairReason -> Text+repairReason = \case R.NoActiveMigration -> "no-active-migration"; R.AdoptionInProgress -> "adoption-in-progress"; R.UncertainStepRemains -> "uncertain-step-remains"; R.NoPendingSteps -> "no-pending-steps"; R.SelectedStepIsResolved -> "selected-step-is-resolved"; R.StepsNotResolved -> "steps-not-resolved"; R.ConflictingAppend -> "conflicting-append"; R.WrongQuiescenceTarget -> "wrong-quiescence-target"++commandErrorCode :: CommandError -> Text+commandErrorCode = \case InvalidArguments -> "invalid-arguments"; MissingTargetConfiguration -> "missing-target-configuration"; MissingExclusiveAccess -> "missing-exclusive-access"; CommandNotAllowed -> "command-not-allowed"; ExpectedTargetMismatch -> "expected-target-mismatch"; InvalidAuditInput -> "invalid-audit-input"; QuiescenceRequired -> "quiescence-required"; RecoveryEvidenceRequired -> "recovery-evidence-required"; InvalidRepairInput -> "invalid-repair-input"; InitializationRequired -> "initialization-required"; InvalidAdoptionInput -> "invalid-adoption-input"; InputUnavailable -> "input-unavailable"; InputTooLarge -> "input-too-large"; InvalidJsonInput -> "invalid-json-input"; DuplicateJsonKey -> "duplicate-json-key"; UnsupportedInputVersion -> "unsupported-input-version"++runErrorCode :: R.RunError -> Text+runErrorCode = \case+  R.InvalidRuntimePlan _ -> "invalid-runtime-plan"+  R.LedgerNamespaceInSql _ -> "ledger-namespace-in-sql"+  R.DefinitionTooLarge _ -> "definition-too-large"+  R.AccessFailed problem -> accessErrorCode problem+  R.TargetFailed _ -> "target-failed"+  R.LedgerFailed problem -> ledgerErrorCode problem+  R.LedgerRequestFailed {} -> "ledger-request-failed"+  R.InitializationFailed {} -> "initialization-failed"+  R.SqlFailed {} -> "sql-failed"+  R.CallbackFailed _ -> "callback-failed"+  R.IncompatibleHistory _ -> "incompatible-history"+  R.VerificationNotCurrent -> "verification-not-current"+  R.RecoveryEventTooLarge _ -> "recovery-event-too-large"+  R.AuditTooLarge -> "audit-too-large"+  R.LedgerRequired -> "ledger-required"+  R.AdoptionRejected problem -> adoptionErrorCode problem+  R.ExistingBindingRequired -> "existing-ledger-binding-required"+  R.StalePosition {} -> "stale-position"+  R.AttemptMismatch {} -> "attempt-mismatch"+  R.StepAttemptMismatch _ -> "step-attempt-mismatch"+  R.RepairNotAllowed _ -> "repair-not-allowed"+  R.PriorQueriesActive _ -> "prior-queries-active"+  R.CleanupFailed -> "cleanup-failed"+  R.UnexpectedRuntimeFailure -> "unexpected-runtime-failure"++runErrorValue :: R.RunError -> Value+runErrorValue failure = object (("code" .= runErrorCode failure) : fields failure)+  where+    fields = \case+      R.InvalidRuntimePlan step -> ["step" .= stepReferenceValue step]+      R.LedgerNamespaceInSql step -> ["step" .= stepReferenceValue step]+      R.DefinitionTooLarge definition -> ["definition" .= definitionValue definition]+      R.AccessFailed _ -> []+      R.TargetFailed problem -> ["transport" .= transportValue problem]+      R.LedgerFailed _ -> []+      R.LedgerRequestFailed evidence problem receipt -> ["evidence" .= requestEvidence evidence, "transport" .= transportValue problem, "pendingAppend" .= fmap L.appendReceiptText receipt]+      R.InitializationFailed ledger stage query evidence problem -> ["ledgerId" .= ledger, "stage" .= stage, "queryId" .= T.queryIdText query, "evidence" .= requestEvidence evidence, "transport" .= transportValue problem]+      R.SqlFailed step query evidence problem -> ["step" .= stepReferenceValue step, "queryId" .= T.queryIdText query, "evidence" .= requestEvidence evidence, "transport" .= transportValue problem]+      R.CallbackFailed phase -> ["callback" .= callbackValue phase]+      R.IncompatibleHistory issues -> ["issues" .= map issueValue issues]+      R.VerificationNotCurrent -> []+      R.RecoveryEventTooLarge kind -> ["event" .= recoveryEventKind kind]+      R.AuditTooLarge -> []+      R.LedgerRequired -> []+      R.AdoptionRejected _ -> []+      R.ExistingBindingRequired -> []+      R.StalePosition expected actual -> ["expected" .= L.ledgerPositionText expected, "actual" .= fmap L.ledgerPositionText actual]+      R.AttemptMismatch expected actual -> ["expected" .= L.attemptIdText expected, "actual" .= fmap L.attemptIdText actual]+      R.StepAttemptMismatch step -> ["stepAttempt" .= stepAttemptValue step]+      R.RepairNotAllowed reason -> ["reason" .= repairReason reason]+      R.PriorQueriesActive queries -> ["queryIds" .= map T.queryIdText queries]+      R.CleanupFailed -> []+      R.UnexpectedRuntimeFailure -> []++recoveryEventKind :: R.RecoveryEventKind -> Text+recoveryEventKind = \case+  R.RecoveryAuthorizationEvent -> "authorization"+  R.RecoveryAcceptanceEvent -> "acceptance"+  R.RecoveryCompletionEvent -> "completion"+  R.RecoveryStepStartEvent -> "step-start"+  R.RecoveryStepSuccessEvent -> "step-success"+  R.RecoveryStepFailureEvent -> "step-failure"
+ src/ClickHouseMigrate/CLI/Render/Text.hs view
@@ -0,0 +1,48 @@+-- | Concise human summaries, with complete safe failure detail retained.+module ClickHouseMigrate.CLI.Render.Text (renderText) where++import ClickHouseMigrate.CLI.Render.Json (renderJson)+import ClickHouseMigrate.CLI.Types+import ClickHouseMigrate.Ledger qualified as L+import ClickHouseMigrate.Prelude+import ClickHouseMigrate.Report qualified as R+import ClickHouseMigrate.Target qualified as T+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Encoding++renderText :: CommandResult -> Text+renderText result@(CommandResult command outcome) = Text.unlines $ case outcome of+  Left _ -> [command <> ": error", "Safe failure detail (schemaVersion 1; latest acknowledged report, local observations and secondary errors):", Encoding.decodeUtf8 (renderJson result)]+  Right report ->+    (command <> ": ok") : case report of+      PlanReport components schedule -> ["Execution order:"] ++ ["  " <> number ordinal <> " " <> component <> "/" <> migrationName | (ordinal, (component, migrationName)) <- zip [0 ..] schedule] ++ concatMap componentLines components+      StatusReport (R.InspectionReport history migrations issues) -> historyLines history ++ migrationLines migrations ++ ["Compatibility issues: " <> number (length issues)]+      HistoryReport history -> historyLines history ++ eventLines history+      VerificationReport (R.VerificationReport (R.InspectionReport history migrations _) current) -> ["Compatible: yes", "Current: " <> if current then "yes" else "no (pending definitions)"] ++ historyLines history ++ migrationLines migrations+      RunReport (R.RunReport _ _ _ acquired history migrations observations _) -> ["Administrative access acquired: " <> if acquired then "yes" else "no"] ++ historyLines history ++ migrationLines migrations ++ ["Local SQL observations: " <> number (length observations)]+      AdoptionPlanReport history (R.AdoptionSummary source _ _ _ count) _ -> historyLines history ++ ["Adoption source: " <> source, "Reviewed prefix entries: " <> number count, "No application SQL executed."]+  where+    componentLines (PlanComponent name dependencies migrations) = ("Component: " <> name <> " (depends on: " <> Text.intercalate ", " dependencies <> ")") : concatMap migration migrations+    migration (PlanMigration name _ checksum steps) = ("  " <> name <> " " <> checksum) : ["    " <> step <> " " <> digest | PlanStep step digest <- steps]++number :: Int -> Text+number = Text.pack . show++historyLines :: R.HistoryReport -> [Text]+historyLines (R.HistoryReport target _ presence position access _ _ unresolved) =+  [ "Target: " <> T.targetKeyText target,+    "Ledger: " <> case presence of R.LedgerUnknown -> "unknown"; R.LedgerMissing -> "missing"; R.LedgerUninitialized -> "uninitialized"; R.LedgerInitializedAt identity -> T.ledgerIdText identity,+    "Position: " <> maybe "none" L.ledgerPositionText position,+    "Observation: " <> case access of R.UnguardedObservation -> "unguarded"; R.GuardedObservation _ -> "guarded",+    "Unresolved: " <> if unresolved then "yes" else "no"+  ]++eventLines :: R.HistoryReport -> [Text]+eventLines (R.HistoryReport _ _ _ _ _ events _ _) = [Text.pack (show ordinal) <> " " <> R.historyKind body | R.HistoryEvent ordinal _ _ _ _ _ _ _ _ body <- events]++migrationLines :: [R.MigrationSummary] -> [Text]+migrationLines = concatMap $ \(R.MigrationSummary (R.DefinitionSummary _ _ component _ name _ _) state _ steps) ->+  (component <> "/" <> name <> ": " <> migrationState state) : ["  " <> step <> ": " <> stepState status | R.StepSummary step _ status _ _ <- steps]+  where+    migrationState = \case R.Pending -> "pending"; R.InProgress -> "in-progress"; R.Failed -> "failed"; R.Applied -> "applied"; R.Adopted -> "adopted"; R.Invalid -> "invalid"+    stepState = \case R.StepPending -> "pending"; R.StepUncertain -> "uncertain"; R.StepObservedSuccess -> "observed-success"; R.StepObservedFailure -> "observed-failure"; R.StepAccepted -> "accepted (operator attestation)"
+ src/ClickHouseMigrate/CLI/Types.hs view
@@ -0,0 +1,89 @@+-- | Command values contain input, never an acquired administrative capability.+module ClickHouseMigrate.CLI.Types where++import ClickHouseMigrate.Adoption (AdoptionError)+import ClickHouseMigrate.Event (DiagnosticPolicy, EventSink)+import ClickHouseMigrate.ExclusiveAccess (ExclusiveAccess)+import ClickHouseMigrate.Ledger qualified as L+import ClickHouseMigrate.Prelude+import ClickHouseMigrate.Report qualified as R+import ClickHouseMigrate.Target (LedgerId, TargetConfig, TargetKey)++data OutputFormat = TextOutput | JsonOutput deriving stock (Eq, Show)++data Invocation = Invocation !OutputFormat !Command deriving stock (Show)++data AuditInput = AuditInput !Text !Text ![Text] deriving stock (Show)++data UpInput = UpInput !TargetKey !AuditInput !(Maybe LedgerId) !Bool deriving stock (Show)++data RepairOperation = Resume | RetryStep | AcceptStep | Finalize deriving stock (Eq, Show)++data RepairInput = RepairInput !TargetKey !L.LedgerPosition !L.AttemptId !(Maybe R.StepAttempt) !AuditInput !Bool ![L.AppendReceipt] deriving stock (Show)++data AdoptionOperation = PlanAdoption | ApplyAdoption | ResumeAdoption deriving stock (Eq, Show)++data ExpectedInput = AbsentInput | PositionInput !L.LedgerPosition deriving stock (Show)++data AdoptionInput = AdoptionInput !TargetKey !ExpectedInput !(Maybe LedgerId) !AuditInput !Bool !Bool !FilePath deriving stock (Show)++data Command+  = PlanCommand+  | StatusCommand !Bool+  | HistoryCommand !Bool+  | VerifyCommand !Bool !Bool+  | UpCommand !UpInput+  | RepairCommand !RepairOperation !RepairInput+  | AdoptCommand !AdoptionOperation !AdoptionInput+  deriving stock (Show)++data CommandPolicy = ReadOnlyCommands | AdministrativeCommands deriving stock (Eq, Show)++-- Configuration and sinks are explicitly supplied. No implicit environment,+-- credentials, stdout, process exit, or live guard is owned by this value.+data CommandEnvironment = CommandEnvironment !(Maybe TargetConfig) !(Maybe ExclusiveAccess) !EventSink !DiagnosticPolicy !CommandPolicy++data CommandError+  = InvalidArguments+  | MissingTargetConfiguration+  | MissingExclusiveAccess+  | CommandNotAllowed+  | ExpectedTargetMismatch+  | InvalidAuditInput+  | QuiescenceRequired+  | RecoveryEvidenceRequired+  | InvalidRepairInput+  | InitializationRequired+  | InvalidAdoptionInput+  | InputUnavailable+  | InputTooLarge+  | InvalidJsonInput+  | DuplicateJsonKey+  | UnsupportedInputVersion+  deriving stock (Eq, Show)++data CommandFailure+  = CommandRejected !CommandError+  | RunFailed !R.RunFailure+  | InspectionFailed !R.InspectionFailure+  | AdoptionRejected !AdoptionError !R.HistoryReport+  deriving stock (Show)++data PlanStep = PlanStep !Text !Text deriving stock (Eq, Show)++data PlanMigration = PlanMigration !Text !(Maybe Text) !Text ![PlanStep] deriving stock (Eq, Show)++data PlanComponent = PlanComponent !Text ![Text] ![PlanMigration] deriving stock (Eq, Show)++data CommandReport+  = PlanReport ![PlanComponent] ![(Text, Text)]+  | StatusReport !R.InspectionReport+  | HistoryReport !R.HistoryReport+  | VerificationReport !R.VerificationReport+  | RunReport !R.RunReport+  | AdoptionPlanReport !R.HistoryReport !R.AdoptionSummary ![(R.DefinitionSummary, R.EvidenceSummary)]+  deriving stock (Show)++data CommandResult = CommandResult !Text !(Either CommandFailure CommandReport) deriving stock (Show)++data ParseIssue = HelpRequested !Text | ArgumentsRejected | CompletionRequested deriving stock (Show)
+ test/Main.hs view
@@ -0,0 +1,100 @@+module Main (main) where++import ClickHouseMigrate hiding (history, up)+import ClickHouseMigrate.CLI+import ClickHouseMigrate.CLI.AdoptionFile+import ClickHouseMigrate.Event qualified as E+import ClickHouseMigrate.ExclusiveAccess qualified as Access+import ClickHouseMigrate.Ledger qualified as L+import ClickHouseMigrate.Report qualified as R+import Control.Monad (forM_, unless)+import Data.Aeson qualified as JSON+import Data.ByteString qualified as BS+import Data.List.NonEmpty (NonEmpty (..))+import Data.Set qualified as Set+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Encoding+import Paths_clickhouse_migrate_cli (getDataFileName)++assert :: String -> Bool -> IO ()+assert label value = unless value (fail label)++right :: (Show e) => Either e a -> a+right = either (error . show) id++uuid :: Text.Text+uuid = "00000000-0000-0000-0000-000000000001"++positionText :: Text.Text+positionText = "chm1:" <> uuid <> ":5:" <> uuid++receiptText :: Text.Text+receiptText = "chm-receipt1:74657374:" <> uuid <> ":6:" <> uuid <> ":" <> Text.replicate 64 "a" <> ":append-6"++main :: IO ()+main = do+  let step = right (sqlStep "create" "CREATE TABLE default.secret_fixture (id UInt8) ENGINE=Memory")+      migration = right (sqlMigration "one" (step :| []))+      component = right (migrationComponent "app" Set.empty (migration :| []))+      plan = right (migrationPlan (component :| []))+      key = right (targetKey "test")+      audit = right (L.auditContext "fixture actor" "fixture reason" ["fixture/drain"])+      quiet = right (L.attestQuiescence key audit)+      ledger = right (ledgerId uuid)+      authorization = Just (L.authorizeInitialization key ledger audit)+      decode = decodeAdoptionInput key (L.ExpectAbsent key) authorization quiet audit+  offline <- handleCommand (error "Offline plan forced configuration") plan PlanCommand+  assert "offline plan missing" (case offline of CommandResult "plan" (Right (PlanReport [_] [("app", "one")])) -> True; _ -> False)+  let two = right (sqlMigration "two" (step :| []))+      a = right (migrationComponent "a" Set.empty (migration :| [two]))+      b = right (migrationComponent "b" (Set.singleton "a") (migration :| []))+      identity c m = migrationIdFromNames (right (componentName c)) (right (migrationName m))+      scheduled = right (scheduledMigrationPlan (a :| [b]) (identity "a" "one" :| [identity "b" "one", identity "a" "two"]))+  scheduledResult <- handleCommand (error "Offline schedule forced environment") scheduled PlanCommand+  assert "CLI schedule order wrong" (case scheduledResult of CommandResult _ (Right (PlanReport _ [("a", "one"), ("b", "one"), ("a", "two")])) -> True; _ -> False)+  assert "Text omits execution schedule" ("0 a/one\n  1 b/one\n  2 a/two" `Text.isInfixOf` renderText scheduledResult)+  assert "offline plan leaked SQL" (not ("secret_fixture" `Text.isInfixOf` Encoding.decodeUtf8 (renderJson offline)))+  let auditArgs = ["--expect-target", "test", "--actor", "fixture actor", "--reason", "fixture reason"]+      recoveryArgs = auditArgs ++ ["--expect-position", Text.unpack positionText, "--attempt", Text.unpack uuid, "--evidence", "fixture/drain", "--quiescent", "--pending-append", Text.unpack receiptText]+      selected = ["--step-attempt", Text.unpack uuid, "--step", "insert", "--query-id", "query-2"]+      adoptionArgs = auditArgs ++ ["--expect-absent", "--initialize-ledger", Text.unpack uuid, "--evidence", "fixture/drain", "--quiescent", "--request", "input.json"]+  forM_ ([["plan", "--json"], ["status"], ["history", "--guarded"], ["verify", "--require-current"], ["up"] ++ auditArgs] ++ [["repair", op] ++ recoveryArgs ++ if op `elem` ["retry-step", "accept-step"] then selected else [] | op <- ["resume", "retry-step", "accept-step", "finalize"]] ++ [["adopt", op] ++ adoptionArgs | op <- ["plan", "apply", "resume"]]) $ \args -> assert ("Valid parser case rejected: " ++ show args) (case parseInvocation args of Right _ -> True; _ -> False)+  forM_ [[], ["reset"], ["up", "--force"], ["repair", "accept-step"] ++ recoveryArgs, ["repair", "resume"] ++ filter (/= "--quiescent") recoveryArgs, ["up"] ++ auditArgs ++ ["--actor", "secret-password"], ["adopt", "apply"] ++ auditArgs ++ ["--expect-absent", "--quiescent", "--evidence", "fixture/drain", "--request", "a.json"], ["status", "--initialize-ledger", Text.unpack uuid]] $ \args -> assert "Malformed parser input accepted" (case parseInvocation args of Left ArgumentsRejected -> True; _ -> False)+  assert "Help missing" (case parseInvocation ["verify", "--help"] of Left (HelpRequested text) -> "schema equality" `Text.isInfixOf` text; _ -> False)+  let noTarget = commandEnvironment Nothing Nothing E.quietEvents E.redactedDiagnostics AdministrativeCommands+      config = targetConfig key (right (directEndpoint "http://127.0.0.1:1")) (right (serverId uuid)) (right (ledgerNamespace "fixture_history")) FirstUse (right (basicCredentials "default" "secret-password")) defaultHttpLimits+      noProvider = commandEnvironment (Just config) Nothing E.quietEvents E.redactedDiagnostics AdministrativeCommands+      forbidden = commandEnvironment Nothing Nothing E.quietEvents E.redactedDiagnostics ReadOnlyCommands+      up = UpCommand (UpInput key (AuditInput "actor" "reason" []) Nothing False)+  forM_ [(noTarget, StatusCommand False, MissingTargetConfiguration), (noProvider, up, MissingExclusiveAccess), (noProvider, StatusCommand True, MissingExclusiveAccess), (forbidden, up, CommandNotAllowed)] $ \(env, command, expected) -> do+    result <- handleCommand env plan command+    assert "Preflight error wrong" (case result of CommandResult _ (Left (CommandRejected actual)) -> actual == expected; _ -> False)+  forM_ [("{", InvalidJsonInput), ("{\"schemaVersion\":1,\"schemaVersion\":1}", DuplicateJsonKey), ("{\"schemaVersion\":1,\"schema\\u0056ersion\":1}", DuplicateJsonKey), ("{\"schemaVersion\":2}", UnsupportedInputVersion), ("{\"schemaVersion\":1,\"force\":true}", InvalidAdoptionInput), ("{} {}", InvalidJsonInput)] $ \(bytes, expected) -> assert "Unsafe adoption JSON accepted" (case decode bytes of Left actual -> actual == expected; _ -> False)+  forM_ goldenCases $ \(name, result) -> do+    path <- getDataFileName ("test/golden/" ++ name ++ ".json")+    bytes <- BS.readFile path+    let actual = JSON.eitherDecodeStrict' (renderJson result) :: Either String JSON.Value+        expected = JSON.eitherDecodeStrict' bytes :: Either String JSON.Value+    assert ("JSON golden mismatch: " ++ name) (actual == expected && either (const False) (const True) expected)+    forM_ [renderJson result, Encoding.encodeUtf8 (renderText result)] $ \rendered -> assert "Sensitive SQL or credentials escaped" (not (BS.isInfixOf "SQL_SECRET_MARKER" rendered) && not (BS.isInfixOf "secret-password" rendered))+  putStrLn "CLI: offline environment unforced; all commands parsed; fail-closed policy/access; strict adoption decoding; six schemaVersion 1 golden results"++goldenCases :: [(String, CommandResult)]+goldenCases = [("schedule", CommandResult "plan" (Right (PlanReport [PlanComponent "a" [] [PlanMigration "one" Nothing "a1-hash" [], PlanMigration "two" (Just "upgrade") "a2-hash" []], PlanComponent "b" ["a"] [PlanMigration "one" Nothing "b1-hash" []]] [("a", "one"), ("b", "one"), ("a", "two")]))), ("recovery-too-large", CommandResult "repair.accept-step" (Left (RunFailed (R.RunFailure (R.RecoveryEventTooLarge R.RecoveryAcceptanceEvent) run [])))), ("malformed", CommandResult "parse" (Left (CommandRejected InvalidArguments))), ("partial", CommandResult "up" (Left (RunFailed (R.RunFailure (R.SqlFailed reference query L.UncertainSubmission problem) run [R.AccessCleanup Access.AccessReleaseFailed])))), ("delayed-ledger", CommandResult "up" (Left (RunFailed (R.RunFailure (R.LedgerRequestFailed L.UncertainSubmission problem (Just receipt)) run [R.RecordingError (R.LedgerFailed L.OutstandingRequests)])))), ("accepted", CommandResult "status" (Right (StatusReport (R.InspectionReport history [accepted] []))))]+  where+    identity = right (ledgerId uuid)+    attempt = right (L.parseAttemptId uuid)+    query = right (queryId "query-2")+    receipt = right (L.parseAppendReceipt receiptText)+    position = right (L.parseLedgerPosition positionText)+    key = right (targetKey "test")+    access = Access.exclusiveAccessDescription (right (Access.externallySerialized "fixture" "owned target" 1000 (const (fail "Golden provider must never acquire")) (const (pure ())) (const (pure False))))+    definition = R.DefinitionSummary 0 0 "app" [] "one" "migration-hash" [("create", "create-hash"), ("insert", "insert-hash")]+    reference = R.StepReference "app" "one" "insert" "migration-hash" "insert-hash"+    selected = R.StepAttempt attempt "insert" query+    create = R.StepSummary "create" "create-hash" R.StepObservedSuccess (Just (R.StepAttempt attempt "create" (right (queryId "query-1")))) Nothing+    unresolved = R.MigrationSummary definition R.InProgress (Just attempt) [create, R.StepSummary "insert" "insert-hash" R.StepUncertain (Just selected) Nothing]+    accepted = R.MigrationSummary definition R.InProgress (Just attempt) [create, R.StepSummary "insert" "insert-hash" R.StepAccepted (Just selected) (Just (R.EvidenceSummary L.OperatorAttestation ["fixture/drain"]))]+    history = R.HistoryReport key Nothing (R.LedgerInitializedAt identity) (Just position) (R.GuardedObservation access) [] [unresolved] True+    problem = L.TransportError L.ResponseInterrupted Nothing Nothing+    run = R.RunReport "run-fixture" key access True history [unresolved] [R.SqlObservation reference query (R.QueryRejected L.UncertainSubmission problem)] (Just identity)
+ test/golden/accepted.json view
@@ -0,0 +1,131 @@+{+  "schemaVersion": 1,+  "command": "status",+  "status": "ok",+  "result": {+    "kind": "status",+    "report": {+      "observation": {+        "target": "test",+        "server": null,+        "ledger": {+          "kind": "initialized",+          "ledgerId": "00000000-0000-0000-0000-000000000001"+        },+        "position": "chm1:00000000-0000-0000-0000-000000000001:5:00000000-0000-0000-0000-000000000001",+        "access": {+          "mode": "guarded-observation",+          "provider": {+            "strategy": "fixture",+            "scope": "owned target"+          }+        },+        "events": [],+        "migrations": [+          {+            "definition": {+              "ordinal": 0,+              "componentIndex": 0,+              "component": "app",+              "dependencies": [],+              "migration": "one",+              "checksum": "migration-hash",+              "steps": [+                {+                  "name": "create",+                  "checksum": "create-hash"+                },+                {+                  "name": "insert",+                  "checksum": "insert-hash"+                }+              ]+            },+            "state": "in-progress",+            "attempt": "00000000-0000-0000-0000-000000000001",+            "steps": [+              {+                "name": "create",+                "checksum": "create-hash",+                "state": "observed-success",+                "attempt": {+                  "ownerAttempt": "00000000-0000-0000-0000-000000000001",+                  "step": "create",+                  "queryId": "query-1"+                },+                "evidence": null+              },+              {+                "name": "insert",+                "checksum": "insert-hash",+                "state": "uncertain",+                "attempt": {+                  "ownerAttempt": "00000000-0000-0000-0000-000000000001",+                  "step": "insert",+                  "queryId": "query-2"+                },+                "evidence": null+              }+            ]+          }+        ],+        "unresolved": true+      },+      "migrations": [+        {+          "definition": {+            "ordinal": 0,+            "componentIndex": 0,+            "component": "app",+            "dependencies": [],+            "migration": "one",+            "checksum": "migration-hash",+            "steps": [+              {+                "name": "create",+                "checksum": "create-hash"+              },+              {+                "name": "insert",+                "checksum": "insert-hash"+              }+            ]+          },+          "state": "in-progress",+          "attempt": "00000000-0000-0000-0000-000000000001",+          "steps": [+            {+              "name": "create",+              "checksum": "create-hash",+              "state": "observed-success",+              "attempt": {+                "ownerAttempt": "00000000-0000-0000-0000-000000000001",+                "step": "create",+                "queryId": "query-1"+              },+              "evidence": null+            },+            {+              "name": "insert",+              "checksum": "insert-hash",+              "state": "accepted",+              "attempt": {+                "ownerAttempt": "00000000-0000-0000-0000-000000000001",+                "step": "insert",+                "queryId": "query-2"+              },+              "evidence": {+                "level": "operator-attestation",+                "references": [+                  "fixture/drain"+                ]+              }+            }+          ]+        }+      ],+      "issues": []+    }+  },+  "error": null+}
+ test/golden/delayed-ledger.json view
@@ -0,0 +1,171 @@+{+  "schemaVersion": 1,+  "command": "up",+  "status": "error",+  "result": null,+  "error": {+    "category": "run",+    "primary": {+      "code": "ledger-request-failed",+      "evidence": "submission-uncertain",+      "transport": {+        "code": "response-interrupted",+        "httpStatus": null,+        "serverCode": null+      },+      "pendingAppend": "chm-receipt1:74657374:00000000-0000-0000-0000-000000000001:6:00000000-0000-0000-0000-000000000001:aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa:append-6"+    },+    "secondary": [+      {+        "kind": "recording",+        "error": {+          "code": "outstanding-requests"+        }+      }+    ],+    "report": {+      "runId": "run-fixture",+      "target": "test",+      "access": {+        "strategy": "fixture",+        "scope": "owned target"+      },+      "acquired": true,+      "history": {+        "target": "test",+        "server": null,+        "ledger": {+          "kind": "initialized",+          "ledgerId": "00000000-0000-0000-0000-000000000001"+        },+        "position": "chm1:00000000-0000-0000-0000-000000000001:5:00000000-0000-0000-0000-000000000001",+        "access": {+          "mode": "guarded-observation",+          "provider": {+            "strategy": "fixture",+            "scope": "owned target"+          }+        },+        "events": [],+        "migrations": [+          {+            "definition": {+              "ordinal": 0,+              "componentIndex": 0,+              "component": "app",+              "dependencies": [],+              "migration": "one",+              "checksum": "migration-hash",+              "steps": [+                {+                  "name": "create",+                  "checksum": "create-hash"+                },+                {+                  "name": "insert",+                  "checksum": "insert-hash"+                }+              ]+            },+            "state": "in-progress",+            "attempt": "00000000-0000-0000-0000-000000000001",+            "steps": [+              {+                "name": "create",+                "checksum": "create-hash",+                "state": "observed-success",+                "attempt": {+                  "ownerAttempt": "00000000-0000-0000-0000-000000000001",+                  "step": "create",+                  "queryId": "query-1"+                },+                "evidence": null+              },+              {+                "name": "insert",+                "checksum": "insert-hash",+                "state": "uncertain",+                "attempt": {+                  "ownerAttempt": "00000000-0000-0000-0000-000000000001",+                  "step": "insert",+                  "queryId": "query-2"+                },+                "evidence": null+              }+            ]+          }+        ],+        "unresolved": true+      },+      "migrations": [+        {+          "definition": {+            "ordinal": 0,+            "componentIndex": 0,+            "component": "app",+            "dependencies": [],+            "migration": "one",+            "checksum": "migration-hash",+            "steps": [+              {+                "name": "create",+                "checksum": "create-hash"+              },+              {+                "name": "insert",+                "checksum": "insert-hash"+              }+            ]+          },+          "state": "in-progress",+          "attempt": "00000000-0000-0000-0000-000000000001",+          "steps": [+            {+              "name": "create",+              "checksum": "create-hash",+              "state": "observed-success",+              "attempt": {+                "ownerAttempt": "00000000-0000-0000-0000-000000000001",+                "step": "create",+                "queryId": "query-1"+              },+              "evidence": null+            },+            {+              "name": "insert",+              "checksum": "insert-hash",+              "state": "uncertain",+              "attempt": {+                "ownerAttempt": "00000000-0000-0000-0000-000000000001",+                "step": "insert",+                "queryId": "query-2"+              },+              "evidence": null+            }+          ]+        }+      ],+      "observations": [+        {+          "step": {+            "component": "app",+            "migration": "one",+            "step": "insert",+            "migrationChecksum": "migration-hash",+            "stepChecksum": "insert-hash"+          },+          "queryId": "query-2",+          "evidence": {+            "outcome": "submission-uncertain",+            "transport": {+              "code": "response-interrupted",+              "httpStatus": null,+              "serverCode": null+            }+          }+        }+      ],+      "initializedLedgerId": "00000000-0000-0000-0000-000000000001"+    }+  }+}
+ test/golden/malformed.json view
@@ -0,0 +1,14 @@+{+  "schemaVersion": 1,+  "command": "parse",+  "status": "error",+  "result": null,+  "error": {+    "category": "command",+    "primary": {+      "code": "invalid-arguments"+    },+    "secondary": [],+    "report": null+  }+}
+ test/golden/partial.json view
@@ -0,0 +1,176 @@+{+  "schemaVersion": 1,+  "command": "up",+  "status": "error",+  "result": null,+  "error": {+    "category": "run",+    "primary": {+      "code": "sql-failed",+      "step": {+        "component": "app",+        "migration": "one",+        "step": "insert",+        "migrationChecksum": "migration-hash",+        "stepChecksum": "insert-hash"+      },+      "queryId": "query-2",+      "evidence": "submission-uncertain",+      "transport": {+        "code": "response-interrupted",+        "httpStatus": null,+        "serverCode": null+      }+    },+    "secondary": [+      {+        "kind": "access-cleanup",+        "code": "access-release-failed"+      }+    ],+    "report": {+      "runId": "run-fixture",+      "target": "test",+      "access": {+        "strategy": "fixture",+        "scope": "owned target"+      },+      "acquired": true,+      "history": {+        "target": "test",+        "server": null,+        "ledger": {+          "kind": "initialized",+          "ledgerId": "00000000-0000-0000-0000-000000000001"+        },+        "position": "chm1:00000000-0000-0000-0000-000000000001:5:00000000-0000-0000-0000-000000000001",+        "access": {+          "mode": "guarded-observation",+          "provider": {+            "strategy": "fixture",+            "scope": "owned target"+          }+        },+        "events": [],+        "migrations": [+          {+            "definition": {+              "ordinal": 0,+              "componentIndex": 0,+              "component": "app",+              "dependencies": [],+              "migration": "one",+              "checksum": "migration-hash",+              "steps": [+                {+                  "name": "create",+                  "checksum": "create-hash"+                },+                {+                  "name": "insert",+                  "checksum": "insert-hash"+                }+              ]+            },+            "state": "in-progress",+            "attempt": "00000000-0000-0000-0000-000000000001",+            "steps": [+              {+                "name": "create",+                "checksum": "create-hash",+                "state": "observed-success",+                "attempt": {+                  "ownerAttempt": "00000000-0000-0000-0000-000000000001",+                  "step": "create",+                  "queryId": "query-1"+                },+                "evidence": null+              },+              {+                "name": "insert",+                "checksum": "insert-hash",+                "state": "uncertain",+                "attempt": {+                  "ownerAttempt": "00000000-0000-0000-0000-000000000001",+                  "step": "insert",+                  "queryId": "query-2"+                },+                "evidence": null+              }+            ]+          }+        ],+        "unresolved": true+      },+      "migrations": [+        {+          "definition": {+            "ordinal": 0,+            "componentIndex": 0,+            "component": "app",+            "dependencies": [],+            "migration": "one",+            "checksum": "migration-hash",+            "steps": [+              {+                "name": "create",+                "checksum": "create-hash"+              },+              {+                "name": "insert",+                "checksum": "insert-hash"+              }+            ]+          },+          "state": "in-progress",+          "attempt": "00000000-0000-0000-0000-000000000001",+          "steps": [+            {+              "name": "create",+              "checksum": "create-hash",+              "state": "observed-success",+              "attempt": {+                "ownerAttempt": "00000000-0000-0000-0000-000000000001",+                "step": "create",+                "queryId": "query-1"+              },+              "evidence": null+            },+            {+              "name": "insert",+              "checksum": "insert-hash",+              "state": "uncertain",+              "attempt": {+                "ownerAttempt": "00000000-0000-0000-0000-000000000001",+                "step": "insert",+                "queryId": "query-2"+              },+              "evidence": null+            }+          ]+        }+      ],+      "observations": [+        {+          "step": {+            "component": "app",+            "migration": "one",+            "step": "insert",+            "migrationChecksum": "migration-hash",+            "stepChecksum": "insert-hash"+          },+          "queryId": "query-2",+          "evidence": {+            "outcome": "submission-uncertain",+            "transport": {+              "code": "response-interrupted",+              "httpStatus": null,+              "serverCode": null+            }+          }+        }+      ],+      "initializedLedgerId": "00000000-0000-0000-0000-000000000001"+    }+  }+}
+ test/golden/recovery-too-large.json view
@@ -0,0 +1,158 @@+{+  "schemaVersion": 1,+  "command": "repair.accept-step",+  "status": "error",+  "result": null,+  "error": {+    "category": "run",+    "primary": {+      "code": "recovery-event-too-large",+      "event": "acceptance"+    },+    "secondary": [],+    "report": {+      "runId": "run-fixture",+      "target": "test",+      "access": {+        "strategy": "fixture",+        "scope": "owned target"+      },+      "acquired": true,+      "history": {+        "target": "test",+        "server": null,+        "ledger": {+          "kind": "initialized",+          "ledgerId": "00000000-0000-0000-0000-000000000001"+        },+        "position": "chm1:00000000-0000-0000-0000-000000000001:5:00000000-0000-0000-0000-000000000001",+        "access": {+          "mode": "guarded-observation",+          "provider": {+            "strategy": "fixture",+            "scope": "owned target"+          }+        },+        "events": [],+        "migrations": [+          {+            "definition": {+              "ordinal": 0,+              "componentIndex": 0,+              "component": "app",+              "dependencies": [],+              "migration": "one",+              "checksum": "migration-hash",+              "steps": [+                {+                  "name": "create",+                  "checksum": "create-hash"+                },+                {+                  "name": "insert",+                  "checksum": "insert-hash"+                }+              ]+            },+            "state": "in-progress",+            "attempt": "00000000-0000-0000-0000-000000000001",+            "steps": [+              {+                "name": "create",+                "checksum": "create-hash",+                "state": "observed-success",+                "attempt": {+                  "ownerAttempt": "00000000-0000-0000-0000-000000000001",+                  "step": "create",+                  "queryId": "query-1"+                },+                "evidence": null+              },+              {+                "name": "insert",+                "checksum": "insert-hash",+                "state": "uncertain",+                "attempt": {+                  "ownerAttempt": "00000000-0000-0000-0000-000000000001",+                  "step": "insert",+                  "queryId": "query-2"+                },+                "evidence": null+              }+            ]+          }+        ],+        "unresolved": true+      },+      "migrations": [+        {+          "definition": {+            "ordinal": 0,+            "componentIndex": 0,+            "component": "app",+            "dependencies": [],+            "migration": "one",+            "checksum": "migration-hash",+            "steps": [+              {+                "name": "create",+                "checksum": "create-hash"+              },+              {+                "name": "insert",+                "checksum": "insert-hash"+              }+            ]+          },+          "state": "in-progress",+          "attempt": "00000000-0000-0000-0000-000000000001",+          "steps": [+            {+              "name": "create",+              "checksum": "create-hash",+              "state": "observed-success",+              "attempt": {+                "ownerAttempt": "00000000-0000-0000-0000-000000000001",+                "step": "create",+                "queryId": "query-1"+              },+              "evidence": null+            },+            {+              "name": "insert",+              "checksum": "insert-hash",+              "state": "uncertain",+              "attempt": {+                "ownerAttempt": "00000000-0000-0000-0000-000000000001",+                "step": "insert",+                "queryId": "query-2"+              },+              "evidence": null+            }+          ]+        }+      ],+      "observations": [+        {+          "step": {+            "component": "app",+            "migration": "one",+            "step": "insert",+            "migrationChecksum": "migration-hash",+            "stepChecksum": "insert-hash"+          },+          "queryId": "query-2",+          "evidence": {+            "outcome": "submission-uncertain",+            "transport": {+              "code": "response-interrupted",+              "httpStatus": null,+              "serverCode": null+            }+          }+        }+      ],+      "initializedLedgerId": "00000000-0000-0000-0000-000000000001"+    }+  }+}
+ test/golden/schedule.json view
@@ -0,0 +1,67 @@+{+  "schemaVersion": 1,+  "command": "plan",+  "status": "ok",+  "result": {+    "kind": "plan",+    "checksumFormat": "sha256-v1",+    "completionPolicy": "clickhouse-migrate/local-sync-v1;async_insert=0;mutations_sync=1;alter_sync=1",+    "components": [+      {+        "index": 0,+        "name": "a",+        "dependencies": [],+        "migrations": [+          {+            "ordinal": 0,+            "name": "one",+            "description": null,+            "checksum": "a1-hash",+            "steps": []+          },+          {+            "ordinal": 2,+            "name": "two",+            "description": "upgrade",+            "checksum": "a2-hash",+            "steps": []+          }+        ]+      },+      {+        "index": 1,+        "name": "b",+        "dependencies": [+          "a"+        ],+        "migrations": [+          {+            "ordinal": 1,+            "name": "one",+            "description": null,+            "checksum": "b1-hash",+            "steps": []+          }+        ]+      }+    ],+    "schedule": [+      {+        "ordinal": 0,+        "component": "a",+        "migration": "one"+      },+      {+        "ordinal": 1,+        "component": "b",+        "migration": "one"+      },+      {+        "ordinal": 2,+        "component": "a",+        "migration": "two"+      }+    ]+  },+  "error": null+}