gachi-plan (empty) → 0.1.0.0
raw patch · 7 files changed
+1675/−0 lines, 7 filesdep +basedep +bytestringdep +containers
Dependencies added: base, bytestring, containers, directory, filepath, gachi-plan, gachi-sync, hspec, process, text, time
Files
- gachi-plan.cabal +67/−0
- src/Gachi/Plan.hs +32/−0
- src/Gachi/Plan/Rollback.hs +395/−0
- src/Gachi/Plan/Snapshot.hs +386/−0
- src/Gachi/Plan/Store.hs +300/−0
- src/Gachi/Plan/Types.hs +224/−0
- test/Main.hs +271/−0
+ gachi-plan.cabal view
@@ -0,0 +1,67 @@+cabal-version: 3.0+name: gachi-plan+version: 0.1.0.0+synopsis: Isolated detached Git store architecture and snapshot ledger for ecosystem plan governance+description:+ Implements Milestone 5.1 of Phase 5 (Ecosystem Plan Governance & Rollback per ~/src/PLAN.md §1.A).+ Establishes an isolated, detached Git store tracking ecosystem-wide governance documents+ (PLAN.md, STATE.md, INDEX.md, and docs/INDEX.md) across ~/src/ without interfering with child git checkouts.+license: EUPL-1.2+author: Nadia Yvette Chambers+maintainer: nadia.yvette.chambers@ik.me+category: Development, VersionControl, Tools+build-type: Simple+tested-with:+ GHC == 9.10.3,+ GHC == 9.12.4,+ GHC == 9.14.1++common commons+ default-language: Haskell2010+ default-extensions:+ OverloadedStrings+ DerivingStrategies+ ScopedTypeVariables+ ghc-options:+ -Wall+ -Wcompat+ -Wredundant-constraints++library+ import: commons+ exposed-modules:+ Gachi.Plan+ Gachi.Plan.Rollback+ Gachi.Plan.Snapshot+ Gachi.Plan.Store+ Gachi.Plan.Types+ hs-source-dirs: src+ build-depends:+ base >= 4.14 && < 5,+ bytestring >= 0.10,+ text >= 2.0,+ containers >= 0.6,+ directory >= 1.3,+ filepath >= 1.4,+ process >= 1.6,+ time >= 1.9,+ gachi-sync >= 0.1++test-suite tests+ import: commons+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: test+ ghc-options:+ -threaded+ build-depends:+ base >= 4.14 && < 5,+ gachi-plan,+ bytestring >= 0.10,+ text >= 2.0,+ containers >= 0.6,+ directory >= 1.3,+ filepath >= 1.4,+ process >= 1.6,+ time >= 1.9,+ hspec >= 2.10
+ src/Gachi/Plan.hs view
@@ -0,0 +1,32 @@+-- | Module: Gachi.Plan+-- Description: Unified facade for ecosystem plan governance and detached Git store operations+--+-- This module serves as the primary entry point for @gachi-plan@, re-exporting+-- the detached Git store lifecycle operations and algebraic data models.+--+-- = Architectural Context & Invariants+--+-- In accordance with Note [Plan Governance and Rollback Mechanics]+-- [ref:note-plan-governance-rollback] and Note [Append-Only Plan Snapshot Invariants]+-- [ref:note-plan-snapshots], the detached Git store architecture and snapshot+-- ledger manage strategic ecosystem governance documents (@PLAN.md@, @STATE.md@,+-- @INDEX.md@, and @docs/INDEX.md@) in an isolated Git repository and append-only+-- directory without creating nested @.git@ roots or interfering with child repository checkouts.+module Gachi.Plan+ ( -- * Core Store Lifecycle & Operations+ module Gachi.Plan.Store++ -- * Append-Only Snapshot Ledger Engine+ , module Gachi.Plan.Snapshot++ -- * Atomic Rollback & Differential History Engine+ , module Gachi.Plan.Rollback++ -- * Algebraic Data Models & Types+ , module Gachi.Plan.Types+ ) where++import Gachi.Plan.Rollback+import Gachi.Plan.Snapshot+import Gachi.Plan.Store+import Gachi.Plan.Types
+ src/Gachi/Plan/Rollback.hs view
@@ -0,0 +1,395 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Module: Gachi.Plan.Rollback+-- Description: Atomic rollback engine, pre-mutation safety snapshots, and differential history+--+-- This module implements Milestone 5.3 of Phase 5 (Ecosystem Plan Governance & Rollback+-- per ~/src/PLAN.md §1.A). It delivers atomic rollback mechanics, pre-mutation safety+-- snapshots, unified diff computation, structured git log queries, and checkpoint commits.+--+-- = Architectural Context & Invariants+--+-- Note [Deterministic Plan Rollback Invariants]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- [tag:note-plan-rollback-invariants]+-- The plan rollback engine guarantees deterministic, reversible state transitions+-- across ecosystem planning and governance documents (PLAN.md, STATE.md, INDEX.md,+-- and docs/INDEX.md).+--+-- Core Invariants:+-- 1. __Pre-Mutation Safety Invariant:__+-- Prior to executing any destructive mutation or checkout of working tree files,+-- the rollback engine MUST record immutable pre-mutation safety snapshots of all+-- governed files currently on disk in the snapshot ledger (~/src/plans/snapshots/).+-- This ensures that uncommitted progress or interim state is never permanently lost.+--+-- 2. __Hermetic Object Store Restoration:__+-- Restoration checks out objects exclusively from the detached Git store+-- using explicit tree pathspecs (@git checkout <ref> -- <governed-files>@).+-- No ambient child repository checkouts or working files outside the governed+-- set are inspected or modified.+--+-- 3. __Byte-Level Verification Invariant:__+-- Every restored file is verified post-checkout by comparing its raw disk bytes+-- against the cryptographic blob stored in the Git object database at the target+-- revision (@git cat-file -p <ref>:<file>@). Any mismatch immediately reports+-- an integrity verification failure.+--+-- 4. __Audit Trail & Attribution Preservation:__+-- Checkpoints recorded during plan governance preserve Sarutahiko RFC 2822+-- attribution trailers (@Assisted-by:@, @Orchestrated-by:@). Rollback queries+-- expose structured log history and semantic diffs without losing provenance.+--+-- 5. __Zero Partial Functions Invariant:__+-- All parsing, string splitting, path manipulation, and tree queries are+-- strictly total. No partial functions (such as unsafe indexing or extraction)+-- are permitted in the rollback or CLI governance pipelines.+module Gachi.Plan.Rollback+ ( -- * Atomic Rollback & Verification+ rollbackToCheckpoint+ , verifyFilesIntegrity+ , verifySingleFile++ -- * Differential Analysis & Log Queries+ , computePlanDiff+ , queryPlanLog++ -- * Checkpoint Creation & Attribution+ , createPlanCheckpoint+ , formatSarutahikoCommitMessage+ , extractTrailers++ -- * Path & Snapshot Resolution+ , resolveSnapshotDirForStore+ ) where++import Control.Exception (SomeException, catch)+import Control.Monad (filterM)+import qualified Data.ByteString as BS+import Data.Char (isAsciiLower, isAsciiUpper)+import Data.Foldable (for_)+import Data.Maybe (fromMaybe, mapMaybe)+import Data.Text (Text)+import qualified Data.Text as T+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import GHC.IO.Exception (ExitCode(..))+import System.Directory+ ( createDirectoryIfMissing+ , doesDirectoryExist+ , doesFileExist+ , makeAbsolute+ )+import System.Environment (lookupEnv)+import System.FilePath ((</>))+import System.IO (hClose, hGetContents)+import System.Process+ ( CreateProcess(..)+ , StdStream(..)+ , createProcess+ , proc+ , waitForProcess+ )+import Text.Read (readMaybe)++import Gachi.Plan.Snapshot+ ( createSnapshot+ , resolvePlanSnapshotDir+ )+import Gachi.Plan.Store+ ( commitStore+ , runGitInStore+ , trackGovernedFiles+ )+import Gachi.Plan.Types+ ( CheckpointResult(..)+ , PlanCommit(..)+ , PlanDiff(..)+ , PlanError(..)+ , PlanStore(..)+ , RollbackResult(..)+ , SnapshotMeta(..)+ , defaultSnapshotDirName+ , planSnapshotDirEnvVar+ )++-- | Resolves the snapshot ledger directory for a given 'PlanStore'.+--+-- Precedence:+-- 1. Environment variable @PLAN_SNAPSHOT_DIR@ (if set and non-empty).+-- 2. @plans/snapshots@ relative to 'planWorkTree' (if exists or if @plans@ dir exists).+-- 3. Canonical default snapshot directory via 'resolvePlanSnapshotDir'.+resolveSnapshotDirForStore :: PlanStore -> IO FilePath+resolveSnapshotDirForStore store = do+ mEnv <- lookupEnv planSnapshotDirEnvVar+ case mEnv of+ Just envPath | not (null envPath) -> makeAbsolute envPath+ _ -> do+ let workSnapDir = planWorkTree store </> defaultSnapshotDirName+ workSnapExists <- doesDirectoryExist workSnapDir+ if workSnapExists+ then makeAbsolute workSnapDir+ else do+ let workPlansDir = planWorkTree store </> "plans"+ workPlansExists <- doesDirectoryExist workPlansDir+ if workPlansExists+ then makeAbsolute workSnapDir+ else resolvePlanSnapshotDir Nothing++-- | Executes low-level git invocation hermetically inside detached store, capturing raw bytes.+runGitInStoreBytes :: PlanStore -> [String] -> IO (ExitCode, BS.ByteString, Text)+runGitInStoreBytes store args = do+ let storeArgs =+ [ "--git-dir=" ++ planGitDir store+ , "--work-tree=" ++ planWorkTree store+ ] ++ args+ let p = (proc "git" storeArgs)+ { std_out = CreatePipe+ , std_err = CreatePipe+ }+ catch+ (do (mIn, mOut, mErr, ph) <- createProcess p+ for_ mIn hClose+ outBytes <- case mOut of+ Just outh -> BS.hGetContents outh+ Nothing -> pure BS.empty+ errStr <- case mErr of+ Just errh -> hGetContents errh+ Nothing -> pure ""+ exitCode <- waitForProcess ph+ pure (exitCode, outBytes, T.pack errStr)+ )+ (\(err :: SomeException) -> pure (ExitFailure 127, BS.empty, T.pack (show err)))++-- | Verifies a single restored file on disk against the raw blob stored in the detached Git store.+verifySingleFile :: PlanStore -> Text -> FilePath -> IO (Either PlanError Bool)+verifySingleFile store commitSha relPath = do+ let fullPath = planWorkTree store </> relPath+ diskExists <- doesFileExist fullPath+ if not diskExists+ then pure (Right False)+ else do+ diskBytes <- BS.readFile fullPath+ let gitObjSpec = T.unpack commitSha ++ ":" ++ relPath+ (code, blobBytes, _) <- runGitInStoreBytes store ["cat-file", "-p", gitObjSpec]+ case code of+ ExitSuccess -> pure (Right (diskBytes == blobBytes))+ ExitFailure _ -> pure (Right False)++-- | Verifies bitwise integrity for a collection of restored files against the target commit.+verifyFilesIntegrity :: PlanStore -> Text -> [FilePath] -> IO (Either PlanError Bool)+verifyFilesIntegrity _ _ [] = pure (Right True)+verifyFilesIntegrity store commitSha files = do+ results <- mapM (verifySingleFile store commitSha) files+ case sequence results of+ Left err -> pure (Left err)+ Right bools -> pure (Right (and bools))++-- | Deterministically rolls back ecosystem planning state to a specified checkpoint reference.+--+-- In accordance with Note [Deterministic Plan Rollback Invariants]+-- [ref:note-plan-rollback-invariants]:+-- 1. Validates that the target revision exists in the detached Git repository.+-- 2. Records pre-mutation safety snapshots of all governed files currently existing on disk.+-- 3. Restores governed files from the Git object store (@git checkout <ref> -- <files>@).+-- 4. Verifies byte-level integrity by comparing restored disk contents with Git blob objects.+rollbackToCheckpoint :: PlanStore -> Text -> IO (Either PlanError RollbackResult)+rollbackToCheckpoint store targetRef = do+ -- 1. Validate target ref in store+ (revCode, revOut, revErr) <- runGitInStore store ["rev-parse", "--verify", T.unpack targetRef ++ "^{commit}"]+ case revCode of+ ExitFailure _ -> pure (Left (PlanGitError ("Target ref does not exist: " <> targetRef <> " (" <> revErr <> ")")))+ ExitSuccess -> do+ let resolvedSha = T.strip revOut++ -- 2. Identify governed files present in target revision+ (treeCode, treeOut, _) <- runGitInStore store ["ls-tree", "-r", "--name-only", T.unpack resolvedSha]+ let filesInCommit =+ case treeCode of+ ExitSuccess ->+ let treeLines = map T.unpack (T.lines treeOut)+ in filter (`elem` planGovernedFiles store) treeLines+ ExitFailure _ -> []+ filesToCheckout =+ if null filesInCommit+ then planGovernedFiles store+ else filesInCommit++ -- 3. Take pre-mutation safety snapshots of all existing governed files on disk+ snapDir <- resolveSnapshotDirForStore store+ createDirectoryIfMissing True snapDir+ let workRoot = planWorkTree store+ existingWorkFiles <- filterM (\f -> doesFileExist (workRoot </> f)) (planGovernedFiles store)+ safetySnapsEither <- mapM (\f -> createSnapshot snapDir (workRoot </> f) False) existingWorkFiles+ case sequence safetySnapsEither of+ Left err -> pure (Left err)+ Right safetySnaps -> do+ -- 4. Restore target files via git checkout+ (checkoutCode, _, checkoutErr) <-+ runGitInStore store (["checkout", T.unpack resolvedSha, "--"] ++ filesToCheckout)+ case checkoutCode of+ ExitFailure _ -> pure (Left (PlanGitError ("Git checkout failed: " <> checkoutErr)))+ ExitSuccess -> do+ -- 5. Verify byte-level integrity+ verifyRes <- verifyFilesIntegrity store resolvedSha filesToCheckout+ case verifyRes of+ Left err -> pure (Left err)+ Right verified ->+ pure (Right RollbackResult+ { rollbackTargetRef = resolvedSha+ , rollbackSafetySnapshots = safetySnaps+ , rollbackRestoredFiles = filesToCheckout+ , rollbackVerified = verified+ })++-- | Computes unified diff of governed documents between working tree and a Git revision.+computePlanDiff :: PlanStore -> Maybe Text -> IO (Either PlanError PlanDiff)+computePlanDiff store mTargetRevision = do+ let baseDiffArgs =+ case mTargetRevision of+ Just rev -> ["diff", T.unpack rev, "--"]+ Nothing -> ["diff", "HEAD", "--"]+ diffArgs = baseDiffArgs ++ planGovernedFiles store+ (code, stdoutTxt, stderrTxt) <- runGitInStore store diffArgs+ case code of+ ExitFailure _ -> pure (Left (PlanGitError stderrTxt))+ ExitSuccess -> do+ let nameArgs =+ (case mTargetRevision of+ Just rev -> ["diff", "--name-only", T.unpack rev, "--"]+ Nothing -> ["diff", "--name-only", "HEAD", "--"])+ ++ planGovernedFiles store+ (nameCode, nameOut, _) <- runGitInStore store nameArgs+ let changed =+ case nameCode of+ ExitSuccess -> filter (not . null) (map T.unpack (T.lines nameOut))+ ExitFailure _ -> []++ diffLines = T.lines stdoutTxt+ isAdd l = "+" `T.isPrefixOf` l && not ("+++" `T.isPrefixOf` l)+ isDel l = "-" `T.isPrefixOf` l && not ("---" `T.isPrefixOf` l)+ addCount = length (filter isAdd diffLines)+ delCount = length (filter isDel diffLines)++ pure (Right PlanDiff+ { diffTargetRef = mTargetRevision+ , diffRawContent = stdoutTxt+ , diffChangedFiles = changed+ , diffAdditions = addCount+ , diffDeletions = delCount+ })++-- | Parses a single commit record emitted with delimiter bytes.+parseCommitRecord :: Text -> PlanCommit+parseCommitRecord rawRecord =+ let fields = T.splitOn "\x1f" rawRecord+ getFld idx = case drop idx fields of+ (val:_) -> val+ [] -> ""+ cHash = T.strip (getFld 0)+ cShortHash = T.strip (getFld 1)+ cAuthor = T.strip (getFld 2)+ cTimeSec = T.strip (getFld 3)+ cSubject = T.strip (getFld 4)+ cBody = T.strip (getFld 5)+ cTimestamp =+ case (readMaybe (T.unpack cTimeSec) :: Maybe Integer) of+ Just s -> posixSecondsToUTCTime (fromIntegral s)+ Nothing -> posixSecondsToUTCTime 0+ trailers = extractTrailers cBody+ in PlanCommit+ { commitHash = cHash+ , commitShortHash = cShortHash+ , commitAuthor = cAuthor+ , commitTimestamp = cTimestamp+ , commitSubject = cSubject+ , commitBody = cBody+ , commitTrailers = trailers+ }++-- | Extracts RFC 2822 git trailers from a commit body.+extractTrailers :: Text -> [(Text, Text)]+extractTrailers bodyText =+ let bodyLines = map T.strip (T.lines bodyText)+ parseTrailerLine line =+ case T.breakOn ":" line of+ (k, rest)+ | not (T.null rest) && isTrailerKey k ->+ let val = T.strip (T.drop 1 rest)+ in Just (k, val)+ _ -> Nothing+ isTrailerKey k =+ not (T.null k) && T.all (\c -> c == '-' || isAsciiLower c || isAsciiUpper c) k+ in mapMaybe parseTrailerLine bodyLines++-- | Queries the chronological commit log of plan governance history.+queryPlanLog :: PlanStore -> Int -> IO (Either PlanError [PlanCommit])+queryPlanLog store limit = do+ let n = if limit <= 0 then 20 else limit+ logFormat = "--format=%H%x1f%h%x1f%an <%ae>%x1f%ct%x1f%s%x1f%b%x1e"+ args = ["log", "-n", show n, logFormat, "--"] ++ planGovernedFiles store+ (code, stdoutTxt, stderrTxt) <- runGitInStore store args+ case code of+ ExitFailure _ ->+ if "does not have any commits yet" `T.isInfixOf` stderrTxt+ || "fatal: your current branch 'master' does not have any commits yet" `T.isInfixOf` stderrTxt+ || "fatal: your current branch 'main' does not have any commits yet" `T.isInfixOf` stderrTxt+ then pure (Right [])+ else pure (Left (PlanGitError stderrTxt))+ ExitSuccess -> do+ let rawRecords = T.splitOn "\x1e" stdoutTxt+ nonEmptyRecords = filter (not . T.null . T.strip) rawRecords+ parsedCommits = map parseCommitRecord nonEmptyRecords+ pure (Right parsedCommits)++-- | Formats a commit message with canonical Sarutahiko RFC 2822 commit attribution trailers.+formatSarutahikoCommitMessage :: Text -> Text+formatSarutahikoCommitMessage rawMsg =+ let msg = T.strip rawMsg+ effectiveMsg = if T.null msg then "Ecosystem plan governance checkpoint" else msg+ hasAssisted = "Assisted-by:" `T.isInfixOf` effectiveMsg+ hasOrchestrated = "Orchestrated-by:" `T.isInfixOf` effectiveMsg+ trailers = case (hasAssisted, hasOrchestrated) of+ (True, True) -> ""+ (True, False) -> "\nOrchestrated-by: Sarutahiko"+ (False, True) -> "\nAssisted-by: Antigravity"+ (False, False) -> "\nAssisted-by: Antigravity\nOrchestrated-by: Sarutahiko"+ in if T.null trailers+ then effectiveMsg+ else effectiveMsg <> "\n" <> trailers++-- | Creates an atomic plan milestone checkpoint.+--+-- 1. Takes pre-mutation snapshots marked as milestone checkpoints for all existing governed files.+-- 2. Stages all existing governed files in the detached Git store.+-- 3. Atomically commits them with Sarutahiko RFC 2822 commit attribution trailers.+createPlanCheckpoint :: PlanStore -> Maybe Text -> IO (Either PlanError CheckpointResult)+createPlanCheckpoint store mUserMsg = do+ let workRoot = planWorkTree store+ existingFiles <- filterM (\f -> doesFileExist (workRoot </> f)) (planGovernedFiles store)+ if null existingFiles+ then pure (Left (PlanIOError "No governed files found on disk to checkpoint"))+ else do+ snapDir <- resolveSnapshotDirForStore store+ createDirectoryIfMissing True snapDir+ snapsEither <- mapM (\f -> createSnapshot snapDir (workRoot </> f) True) existingFiles+ case sequence snapsEither of+ Left err -> pure (Left err)+ Right snapshots -> do+ stageRes <- trackGovernedFiles store+ case stageRes of+ Left err -> pure (Left err)+ Right stagedPaths -> do+ let rawMsg = fromMaybe "Ecosystem plan governance checkpoint" mUserMsg+ formattedMsg = formatSarutahikoCommitMessage rawMsg+ commitRes <- commitStore store formattedMsg+ case commitRes of+ Left err -> pure (Left err)+ Right commitSha ->+ pure (Right CheckpointResult+ { checkpointCommitSha = commitSha+ , checkpointSnapshots = snapshots+ , checkpointStagedFiles = stagedPaths+ , checkpointMessage = formattedMsg+ })
+ src/Gachi/Plan/Snapshot.hs view
@@ -0,0 +1,386 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Module: Gachi.Plan.Snapshot+-- Description: Append-only snapshot ledger engine with SHA-256 integrity verification+--+-- This module implements Milestone 5.2 of Phase 5 (Ecosystem Plan Governance & Rollback+-- per ~/src/PLAN.md §1.A). It provides an append-only snapshot ledger engine writing+-- immutable pre-mutation backups to @~/src/plans/snapshots/@ (configurable via+-- @PLAN_SNAPSHOT_DIR@).+--+-- = Architectural Context & Invariants+--+-- Note [Append-Only Plan Snapshot Invariants]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- [tag:note-plan-snapshots]+-- The plan snapshot ledger operates as an immutable, append-only repository of+-- pre-mutation state backups and milestone checkpoints located in+-- @~/src/plans/snapshots/@ (configurable via @PLAN_SNAPSHOT_DIR@).+--+-- Core Invariants:+-- 1. __Append-Only Immutability Invariant:__+-- Snapshots are strictly write-once. Once written, snapshot files and their+-- associated sidecars are marked read-only on the filesystem (owner write permission+-- revoked). Pre-existing snapshot files are never overwritten in-place under any+-- circumstances.+--+-- 2. __Cryptographic Sidecar Verification:__+-- Every snapshot file is accompanied by a companion @.sha256@ digest sidecar+-- (e.g. @2026-10-28-174500-PLAN.md.sha256@) containing the NIST FIPS 180-2+-- SHA-256 checksum calculated over the immutable snapshot bytes. Tamper detection+-- verifies bitwise equivalence between the sidecar digest and recomputed file hash.+--+-- 3. __Deterministic Timestamped Naming:__+-- Snapshot files follow the canonical timestamp format:+-- @YYYY-MM-DD-HHMMSS-<filename>@ for standard pre-mutation safety backups, and+-- @YYYY-MM-DD-HHMMSS-checkpoint-<filename>@ (with companion @.checkpoint@ sidecar)+-- for milestone checkpoints.+--+-- 4. __Milestone Checkpoint Preservation:__+-- Automated snapshot pruning enforces a retention window for ephemeral pre-mutation+-- snapshots while permanently preserving milestone checkpoints. Checkpoints marked+-- with semantic labels are strictly exempt from pruning regardless of age or+-- retention counts.+--+-- 5. __Zero Partial Functions:__+-- All filesystem discovery, path slicing, sidecar parsing, and timestamp extraction+-- routines are implemented using total pattern matching and safe combinators.+-- No unsafe partial functions or partial list indexing operations are permitted.+module Gachi.Plan.Snapshot+ ( -- * Snapshot Creation & Verification+ createSnapshot+ , createSnapshotAt+ , verifySnapshotIntegrity++ -- * Ledger Querying & Pruning+ , listSnapshots+ , pruneSnapshots++ -- * Path & Environment Resolution+ , resolvePlanSnapshotDir++ -- * Low-Level Hashing & Sidecars+ , computeFileSha256+ , writeSha256Sidecar+ ) where++import Control.Exception (SomeException, catch)+import Control.Monad (forM_, when)+import qualified Data.ByteString as BS+import Data.Char (isHexDigit, toLower)+import Data.List (isPrefixOf, isSuffixOf, sortOn)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import Data.Time+ ( UTCTime+ , defaultTimeLocale+ , formatTime+ , getCurrentTime+ , parseTimeM+ )+import System.Directory+ ( createDirectoryIfMissing+ , doesDirectoryExist+ , doesFileExist+ , getHomeDirectory+ , getPermissions+ , listDirectory+ , makeAbsolute+ , removeFile+ , setOwnerWritable+ , setPermissions+ )+import System.Environment (lookupEnv)+import System.FilePath ((<.>), (</>), takeFileName)++import Gachi.Plan.Types+ ( PlanError(..)+ , SnapshotMeta(..)+ , defaultSnapshotDirName+ , planSnapshotDirEnvVar+ )+import Gachi.Sync.Hash (sha256ByteString)++-- | Resolves the target snapshot ledger directory.+--+-- Precedence:+-- 1. Explicitly provided 'FilePath' argument (if 'Just').+-- 2. Environment variable @PLAN_SNAPSHOT_DIR@ (if set and non-empty).+-- 3. Canonical default at @~/src/plans/snapshots@ relative to the user's home directory.+resolvePlanSnapshotDir :: Maybe FilePath -> IO FilePath+resolvePlanSnapshotDir (Just p) = makeAbsolute p+resolvePlanSnapshotDir Nothing = do+ mEnv <- lookupEnv planSnapshotDirEnvVar+ case mEnv of+ Just envPath | not (null envPath) -> makeAbsolute envPath+ _ -> do+ home <- getHomeDirectory+ let srcPlansDir = home </> "src" </> defaultSnapshotDirName+ srcPlansExists <- doesDirectoryExist (home </> "src")+ if srcPlansExists+ then makeAbsolute srcPlansDir+ else makeAbsolute (home </> defaultSnapshotDirName)++-- | Computes the hexadecimal SHA-256 digest of a target file.+computeFileSha256 :: FilePath -> IO (Either PlanError Text)+computeFileSha256 path = do+ exists <- doesFileExist path+ if not exists+ then pure (Left (PlanIOError ("Cannot compute hash: file does not exist: " <> T.pack path)))+ else catch+ (do bytes <- BS.readFile path+ pure (Right (sha256ByteString bytes)))+ (\(err :: SomeException) ->+ pure (Left (PlanIOError ("Error reading file for hash: " <> T.pack (show err)))))++-- | Writes a companion @.sha256@ sidecar file adjacent to the target snapshot file.+--+-- Sets the resulting sidecar to read-only mode to enforce immutability.+writeSha256Sidecar :: FilePath -> Text -> IO (Either PlanError FilePath)+writeSha256Sidecar snapshotFile digest = do+ let sidecarFile = snapshotFile <.> "sha256"+ sidecarContent = digest <> "\n"+ catch+ (do BS.writeFile sidecarFile (TE.encodeUtf8 sidecarContent)+ perms <- getPermissions sidecarFile+ setPermissions sidecarFile (setOwnerWritable False perms)+ pure (Right sidecarFile))+ (\(err :: SomeException) ->+ pure (Left (PlanIOError ("Failed to write sha256 sidecar: " <> T.pack (show err)))))++-- | Creates an immutable, timestamped snapshot of a target file in the snapshot directory.+--+-- In accordance with Note [Append-Only Plan Snapshot Invariants] [ref:note-plan-snapshots],+-- this operation:+-- 1. Copies target governance file into snapshot directory with a @YYYY-MM-DD-HHMMSS-@ prefix.+-- 2. If 'isCheckpoint' is 'True', inserts a @-checkpoint-@ infix and writes a @.checkpoint@ marker.+-- 3. Computes the cryptographic SHA-256 digest and writes a companion @.sha256@ sidecar.+-- 4. Revokes owner write permissions on both files, enforcing the append-only invariant.+--+-- Accepts parameters in either order: @(snapshotDir, targetFile)@ or @(targetFile, snapshotDir)@.+createSnapshot :: FilePath -> FilePath -> Bool -> IO (Either PlanError SnapshotMeta)+createSnapshot p1 p2 isCheckpoint = do+ now <- getCurrentTime+ createSnapshotAt now p1 p2 isCheckpoint++-- | Deterministic snapshot creation at a designated 'UTCTime' timestamp.+createSnapshotAt :: UTCTime -> FilePath -> FilePath -> Bool -> IO (Either PlanError SnapshotMeta)+createSnapshotAt timestamp p1 p2 isCheckpoint = do+ -- Resolve arguments: detect if caller passed (targetFile, snapshotDir) or (snapshotDir, targetFile)+ p1IsFile <- doesFileExist p1+ p2IsFile <- doesFileExist p2+ let (snapshotDir, targetFile) =+ if p1IsFile && not p2IsFile+ then (p2, p1)+ else (p1, p2)++ targetExists <- doesFileExist targetFile+ if not targetExists+ then pure (Left (PlanIOError ("Target file does not exist: " <> T.pack targetFile)))+ else do+ createDirectoryIfMissing True snapshotDir+ let timePrefix = formatTime defaultTimeLocale "%Y-%m-%d-%H%M%S" timestamp+ baseName = takeFileName targetFile+ snapshotFileName =+ if isCheckpoint+ then timePrefix ++ "-checkpoint-" ++ baseName+ else timePrefix ++ "-" ++ baseName+ targetSnapshotPath = snapshotDir </> snapshotFileName+ sidecarPath = targetSnapshotPath <.> "sha256"+ checkpointMarkerPath = targetSnapshotPath <.> "checkpoint"++ alreadyExists <- doesFileExist targetSnapshotPath+ if alreadyExists+ then pure (Left (PlanIOError ("Snapshot file already exists (append-only invariant): " <> T.pack targetSnapshotPath)))+ else catch+ (do -- 1. Read source bytes+ contentBytes <- BS.readFile targetFile+ let digest = sha256ByteString contentBytes++ -- 2. Write snapshot file+ BS.writeFile targetSnapshotPath contentBytes++ -- 3. Write sidecar file+ BS.writeFile sidecarPath (TE.encodeUtf8 (digest <> "\n"))++ -- 4. Write checkpoint marker if checkpoint+ when isCheckpoint $+ BS.writeFile checkpointMarkerPath (TE.encodeUtf8 "checkpoint\n")++ -- 5. Revoke write permissions to ensure immutability+ perms1 <- getPermissions targetSnapshotPath+ setPermissions targetSnapshotPath (setOwnerWritable False perms1)++ perms2 <- getPermissions sidecarPath+ setPermissions sidecarPath (setOwnerWritable False perms2)++ when isCheckpoint $ do+ perms3 <- getPermissions checkpointMarkerPath+ setPermissions checkpointMarkerPath (setOwnerWritable False perms3)++ absSnapshotPath <- makeAbsolute targetSnapshotPath+ let meta = SnapshotMeta+ { snapshotId = T.pack snapshotFileName+ , snapshotPath = absSnapshotPath+ , snapshotTimestamp = timestamp+ , snapshotSha256 = digest+ , snapshotSourceFile = baseName+ , snapshotIsCheckpoint = isCheckpoint+ }+ pure (Right meta))+ (\(err :: SomeException) ->+ pure (Left (PlanIOError ("Failed to create snapshot: " <> T.pack (show err)))))++-- | Verifies the cryptographic integrity of a snapshot against its @.sha256@ sidecar.+--+-- Recomputes the SHA-256 digest of the snapshot file and verifies equality with the+-- digest recorded in the companion sidecar file. Returns 'True' if matching, 'False'+-- if corrupted or tampered with.+verifySnapshotIntegrity :: FilePath -> IO (Either PlanError Bool)+verifySnapshotIntegrity snapshotPath = do+ snapshotExists <- doesFileExist snapshotPath+ if not snapshotExists+ then pure (Left (PlanIOError ("Snapshot file missing: " <> T.pack snapshotPath)))+ else do+ let sidecarPath = snapshotPath <.> "sha256"+ sidecarExists <- doesFileExist sidecarPath+ if not sidecarExists+ then pure (Left (PlanIOError ("Sidecar checksum file missing: " <> T.pack sidecarPath)))+ else catch+ (do snapshotBytes <- BS.readFile snapshotPath+ sidecarBytes <- BS.readFile sidecarPath+ let computedDigest = sha256ByteString snapshotBytes+ rawSidecarText = TE.decodeUtf8Lenient sidecarBytes+ expectedDigest = extractDigestText rawSidecarText+ pure (Right (computedDigest == expectedDigest)))+ (\(err :: SomeException) ->+ pure (Left (PlanIOError ("Error reading files for integrity verification: " <> T.pack (show err)))))+ where+ -- Extracts first 64-character hex sequence from sidecar content+ extractDigestText :: Text -> Text+ extractDigestText t =+ let candidateWords = T.words t+ in case candidateWords of+ [] -> ""+ (w:_) ->+ let hexChars = filter isHexDigit (map toLower (T.unpack w))+ in T.pack (take 64 hexChars)++-- | Lists all snapshots recorded in the snapshot ledger in ordered chronological sequence.+--+-- Discovers all timestamped snapshot files in @snapshotDir@, excluding @.sha256@ and+-- @.checkpoint@ sidecars, and parses their metadata.+listSnapshots :: FilePath -> IO [SnapshotMeta]+listSnapshots snapshotDir = do+ dirExists <- doesDirectoryExist snapshotDir+ if not dirExists+ then pure []+ else do+ entries <- listDirectory snapshotDir+ absDir <- makeAbsolute snapshotDir+ let candidateFiles = filter isSnapshotFile entries+ metas <- mapMaybeM (parseSnapshotEntry absDir) candidateFiles+ pure (sortOn snapshotTimestamp metas)+ where+ isSnapshotFile :: FilePath -> Bool+ isSnapshotFile name =+ not ("." `isPrefixOf` name)+ && not (".sha256" `isSuffixOf` name)+ && not (".checkpoint" `isSuffixOf` name)+ && not (".tmp" `isSuffixOf` name)++ mapMaybeM :: (a -> IO (Maybe b)) -> [a] -> IO [b]+ mapMaybeM _ [] = pure []+ mapMaybeM f (x:xs) = do+ mRes <- f x+ rest <- mapMaybeM f xs+ case mRes of+ Nothing -> pure rest+ Just val -> pure (val : rest)++ parseSnapshotEntry :: FilePath -> FilePath -> IO (Maybe SnapshotMeta)+ parseSnapshotEntry dir name = do+ let fullPath = dir </> name+ isFile <- doesFileExist fullPath+ if not isFile+ then pure Nothing+ else do+ -- Filename format: YYYY-MM-DD-HHMMSS-[checkpoint-]<filename>+ -- Prefix length: 17 chars (e.g. "2026-10-28-174500")+ let prefixStr = take 17 name+ case parseTimeM True defaultTimeLocale "%Y-%m-%d-%H%M%S" prefixStr of+ Nothing -> pure Nothing+ Just (parsedTime :: UTCTime) -> do+ let remaining = drop 18 name -- skip prefix and hyphen+ (isCpByName, sourceName) =+ if "checkpoint-" `isPrefixOf` remaining+ then (True, drop 11 remaining)+ else (False, remaining)++ cpMarkerExists <- doesFileExist (fullPath <.> "checkpoint")+ let isCheckpoint = isCpByName || cpMarkerExists++ -- Read sha256 from sidecar if present, otherwise compute+ let sidecarFile = fullPath <.> "sha256"+ hasSidecar <- doesFileExist sidecarFile+ shaText <-+ if hasSidecar+ then catch+ (do raw <- BS.readFile sidecarFile+ let rawText = TE.decodeUtf8Lenient raw+ wordsList = T.words rawText+ case wordsList of+ [] -> pure ""+ (w:_) -> pure (T.pack (take 64 (filter isHexDigit (map toLower (T.unpack w))))))+ (\(_ :: SomeException) -> pure "")+ else catch+ (do bytes <- BS.readFile fullPath+ pure (sha256ByteString bytes))+ (\(_ :: SomeException) -> pure "")++ pure (Just (SnapshotMeta+ { snapshotId = T.pack name+ , snapshotPath = fullPath+ , snapshotTimestamp = parsedTime+ , snapshotSha256 = shaText+ , snapshotSourceFile = sourceName+ , snapshotIsCheckpoint = isCheckpoint+ }))++-- | Prunes older non-checkpoint snapshots beyond the designated retention count threshold.+--+-- In accordance with Note [Append-Only Plan Snapshot Invariants] [ref:note-plan-snapshots],+-- milestone checkpoints are permanently preserved and never pruned. Only non-checkpoint+-- snapshots exceeding the retention limit are removed.+--+-- Returns the count of pruned snapshots.+pruneSnapshots :: FilePath -> Int -> IO Int+pruneSnapshots snapshotDir retentionCount = do+ allSnaps <- listSnapshots snapshotDir+ let nonCheckpoints = filter (not . snapshotIsCheckpoint) allSnaps+ retention = max 0 retentionCount+ totalNonCp = length nonCheckpoints++ if totalNonCp <= retention+ then pure 0+ else do+ let pruneCount = totalNonCp - retention+ toPrune = take pruneCount nonCheckpoints+ forM_ toPrune $ \s -> deleteSnapshotFiles (snapshotPath s)+ pure pruneCount+ where+ deleteSnapshotFiles :: FilePath -> IO ()+ deleteSnapshotFiles path = do+ let shaPath = path <.> "sha256"+ cpPath = path <.> "checkpoint"+ forM_ [path, shaPath, cpPath] $ \p -> do+ exists <- doesFileExist p+ when exists $+ catch+ (do perms <- getPermissions p+ setPermissions p (setOwnerWritable True perms)+ removeFile p)+ (\(_ :: SomeException) ->+ catch (removeFile p) (\(_ :: SomeException) -> pure ()))
+ src/Gachi/Plan/Store.hs view
@@ -0,0 +1,300 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Module: Gachi.Plan.Store+-- Description: Detached Git store lifecycle, probing, status, and tracking operations+--+-- This module implements the detached Git store architecture for ecosystem plan+-- governance (~/src/PLAN.md §1.A, Phase 5, Milestone 5.1).+--+-- = Architectural Context & Invariants+--+-- Note [Plan Governance and Rollback Mechanics]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- [tag:note-plan-governance-rollback]+-- Ecosystem planning and operational frontier documents (@PLAN.md@, @STATE.md@,+-- @INDEX.md@, and @docs/INDEX.md@) across @~/src/@ are version-controlled via an+-- isolated, detached Git repository (@--git-dir=<path> --work-tree=<root>@)+-- and an append-only pre-mutation snapshot ledger per ~/src/PLAN.md §1.A.+--+-- Core Invariants:+-- 1. __Non-Interference Invariant:__ Strictly avoids nested @.git@ collisions by+-- never writing @.git@ directories or metadata into child repository workspaces+-- (@~/src/gachi/.git@, @~/src/polytropos/.git@, etc.). The store is maintained+-- as a bare repository in an external directory (default @~/.plan.git@ or+-- @~/src/.plan.git@).+-- 2. __Governed Documents Invariant:__ Exclusively tracks top-level ecosystem+-- planning files and roadmap indexes, ignoring child directory workspaces+-- via explicit pathspec scoping (@-- <governed-files>@). Child project repositories+-- remain completely autonomous.+-- 3. __Hermetic Store Execution:__ All git operations are executed with explicit+-- @--git-dir@ and @--work-tree@ arguments, guaranteeing total independence+-- from ambient directory state or parent repository discovery.+-- 4. __Zero Partial Functions:__ Invariant enforcement and parsing strictly use+-- total pattern matching, eliminating any risk of runtime partial function crashes.+module Gachi.Plan.Store+ ( -- * Store Lifecycle+ initPlanStore+ , isStoreInitialized+ , resolvePlanStorePath++ -- * Status & Tracking Operations+ , queryPlanStore+ , listTrackedFiles+ , trackGovernedFiles+ , stageFiles+ , commitStore+ , getPlanStoreDiff+ , governedFilesExist++ -- * Low-Level Execution+ , runGitInStore+ , runGitRaw+ ) where++import Control.Exception (SomeException, catch)+import Control.Monad (filterM)+import Data.Maybe (mapMaybe)+import Data.Text (Text)+import qualified Data.Text as T+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import GHC.IO.Exception (ExitCode(..))+import System.Directory+ ( createDirectoryIfMissing+ , doesDirectoryExist+ , doesFileExist+ , getHomeDirectory+ , makeAbsolute+ )+import System.Environment (lookupEnv)+import System.FilePath ((</>))+import System.Process (proc, readCreateProcessWithExitCode)+import Text.Read (readMaybe)++import Gachi.Plan.Types+ ( PlanError(..)+ , PlanStore(..)+ , PlanStoreStatus(..)+ , defaultGovernedFiles+ , defaultStoreName+ , planGitDirEnvVar+ )++-- | Resolves the target detached Git store directory.+--+-- Precedence:+-- 1. Explicitly provided 'FilePath' argument (if 'Just').+-- 2. Environment variable @PLAN_GIT_DIR@ (if set and non-empty).+-- 3. Canonical default at @~/.plan.git@ relative to the user's home directory.+resolvePlanStorePath :: Maybe FilePath -> IO FilePath+resolvePlanStorePath (Just p) = makeAbsolute p+resolvePlanStorePath Nothing = do+ mEnv <- lookupEnv planGitDirEnvVar+ case mEnv of+ Just envPath | not (null envPath) -> makeAbsolute envPath+ _ -> do+ home <- getHomeDirectory+ makeAbsolute (home </> defaultStoreName)++-- | Low-level executor invoking git with specified arguments.+-- Safely catches execution exceptions (such as missing git binary).+runGitRaw :: [String] -> IO (ExitCode, Text, Text)+runGitRaw args = do+ let processSpec = proc "git" args+ (code, stdoutStr, stderrStr) <-+ catch+ (readCreateProcessWithExitCode processSpec "")+ (\(err :: SomeException) -> pure (ExitFailure 127, "", show err))+ pure (code, T.pack stdoutStr, T.pack stderrStr)++-- | Executes a git command hermetically inside the detached store context.+-- Explicitly prepends @--git-dir=<path>@ and @--work-tree=<root>@ to all invocations.+runGitInStore :: PlanStore -> [String] -> IO (ExitCode, Text, Text)+runGitInStore store args = do+ let storeArgs =+ [ "--git-dir=" ++ planGitDir store+ , "--work-tree=" ++ planWorkTree store+ ] ++ args+ runGitRaw storeArgs++-- | Checks whether a directory exists and constitutes a valid bare Git repository.+isStoreInitialized :: FilePath -> IO Bool+isStoreInitialized storePath = do+ absPath <- makeAbsolute storePath+ exists <- doesDirectoryExist absPath+ if not exists+ then pure False+ else do+ (code, _, _) <- runGitRaw ["--git-dir=" ++ absPath, "rev-parse", "--git-dir"]+ pure (code == ExitSuccess)++-- | Initializes or opens an isolated detached Git store.+--+-- If the bare git repository at the given store directory does not yet exist,+-- this function creates the directory and executes @git init --bare@.+-- Ensures that the governed work tree root directory also exists.+--+-- Returns a configured 'PlanStore' handle or a 'PlanError' upon initialization failure.+initPlanStore :: FilePath -> FilePath -> IO (Either PlanError PlanStore)+initPlanStore rawStorePath rawWorkTree = do+ absStore <- makeAbsolute rawStorePath+ absWork <- makeAbsolute rawWorkTree+ createDirectoryIfMissing True absWork++ storeExists <- doesDirectoryExist absStore+ if not storeExists+ then do+ createDirectoryIfMissing True absStore+ (code, _, stderrTxt) <- runGitRaw ["init", "--bare", absStore]+ case code of+ ExitSuccess -> pure (Right (PlanStore absStore absWork defaultGovernedFiles))+ ExitFailure _ -> pure (Left (PlanGitError stderrTxt))+ else do+ alreadyInit <- isStoreInitialized absStore+ if alreadyInit+ then pure (Right (PlanStore absStore absWork defaultGovernedFiles))+ else do+ (code, _, stderrTxt) <- runGitRaw ["init", "--bare", absStore]+ case code of+ ExitSuccess -> pure (Right (PlanStore absStore absWork defaultGovernedFiles))+ ExitFailure _ -> pure (Left (PlanGitError stderrTxt))++-- | Lists all governed files currently tracked in the detached Git store index.+-- Runs @git ls-files@ against the detached store.+listTrackedFiles :: PlanStore -> IO [FilePath]+listTrackedFiles store = do+ (code, stdoutTxt, _) <- runGitInStore store ["ls-files"]+ case code of+ ExitSuccess ->+ let nonBlank = filter (not . null) (map T.unpack (T.lines stdoutTxt))+ in pure nonBlank+ ExitFailure _ -> pure []++-- | Queries the status of the detached Git plan store.+--+-- Inspects:+-- 1. Current HEAD commit SHA hash (or 'Nothing' if the repository is newly initialized).+-- 2. Last commit timestamp parsed from POSIX commit seconds.+-- 3. Currently tracked files via 'listTrackedFiles'.+-- 4. Dirty tracking status exclusively across governed files using pathspec scoping.+queryPlanStore :: PlanStore -> IO PlanStoreStatus+queryPlanStore store = do+ -- 1. Query current HEAD commit SHA+ (revCode, revOut, _) <- runGitInStore store ["rev-parse", "--verify", "HEAD"]+ let currentHeadSha =+ case revCode of+ ExitSuccess ->+ let stripped = T.strip revOut+ in if T.null stripped then Nothing else Just stripped+ ExitFailure _ -> Nothing++ -- 2. Query last commit timestamp (POSIX timestamp format via %ct)+ commitTime <-+ case currentHeadSha of+ Nothing -> pure Nothing+ Just _ -> do+ (timeCode, timeOut, _) <- runGitInStore store ["log", "-1", "--format=%ct"]+ case timeCode of+ ExitSuccess ->+ let s = T.unpack (T.strip timeOut)+ in case (readMaybe s :: Maybe Integer) of+ Just sec -> pure (Just (posixSecondsToUTCTime (fromIntegral sec)))+ Nothing -> pure Nothing+ ExitFailure _ -> pure Nothing++ -- 3. Query tracked files+ trackedList <- listTrackedFiles store++ -- 4. Query dirty state restricted exclusively to governed files+ let governed = planGovernedFiles store+ (statusCode, statusOut, _) <-+ if null governed+ then runGitInStore store ["status", "--porcelain"]+ else runGitInStore store (["status", "--porcelain", "--"] ++ governed)++ let porcelainLines =+ case statusCode of+ ExitSuccess -> map T.unpack (T.lines statusOut)+ ExitFailure _ -> []++ -- Extract path from porcelain status output "XY <path>"+ extractDirtyPath :: String -> Maybe FilePath+ extractDirtyPath lineStr+ | length lineStr > 3 = Just (drop 3 lineStr)+ | otherwise = Nothing++ dirtyPaths = mapMaybe extractDirtyPath porcelainLines+ dirtyFlag = not (null dirtyPaths)++ pure PlanStoreStatus+ { statusStorePath = planGitDir store+ , statusWorkTree = planWorkTree store+ , statusHeadCommit = currentHeadSha+ , statusIsDirty = dirtyFlag+ , statusLastCommitTime = commitTime+ , statusDirtyFiles = dirtyPaths+ , statusTrackedFiles = trackedList+ }++-- | Stages specified relative file paths into the detached Git store index.+stageFiles :: PlanStore -> [FilePath] -> IO (Either PlanError ())+stageFiles _ [] = pure (Right ())+stageFiles store paths = do+ (code, _, stderrTxt) <- runGitInStore store (["add", "--"] ++ paths)+ case code of+ ExitSuccess -> pure (Right ())+ ExitFailure _ -> pure (Left (PlanGitError stderrTxt))++-- | Automatically stages all canonical governed planning files that exist on disk in the worktree.+trackGovernedFiles :: PlanStore -> IO (Either PlanError [FilePath])+trackGovernedFiles store = do+ let workRoot = planWorkTree store+ existingFiles <- filterM (\f -> doesFileExist (workRoot </> f)) (planGovernedFiles store)+ case existingFiles of+ [] -> pure (Right [])+ filesToStage -> do+ stageResult <- stageFiles store filesToStage+ case stageResult of+ Right () -> pure (Right filesToStage)+ Left err -> pure (Left err)++-- | Commits staged changes to the detached Git store with a given commit message.+-- Injects hermetic user identity configuration to prevent failures in unconfigured environments.+commitStore :: PlanStore -> Text -> IO (Either PlanError Text)+commitStore store message = do+ let commitArgs =+ [ "-c", "user.name=Gachi Plan Governance"+ , "-c", "user.email=gachi-plan@ecosystem.local"+ , "commit"+ , "-m", T.unpack message+ ]+ (code, _, stderrTxt) <- runGitInStore store commitArgs+ case code of+ ExitSuccess -> do+ (revCode, revOut, revErr) <- runGitInStore store ["rev-parse", "HEAD"]+ case revCode of+ ExitSuccess -> pure (Right (T.strip revOut))+ ExitFailure _ -> pure (Left (PlanGitError revErr))+ ExitFailure _ -> pure (Left (PlanGitError stderrTxt))++-- | Retrieves the Git diff of governed planning documents against HEAD or a specified revision.+getPlanStoreDiff :: PlanStore -> Maybe Text -> IO (Either PlanError Text)+getPlanStoreDiff store mTargetRevision = do+ let baseArgs =+ case mTargetRevision of+ Just rev -> ["diff", T.unpack rev, "--"]+ Nothing -> ["diff", "HEAD", "--"]+ diffArgs = baseArgs ++ planGovernedFiles store+ (code, stdoutTxt, stderrTxt) <- runGitInStore store diffArgs+ case code of+ ExitSuccess -> pure (Right stdoutTxt)+ ExitFailure _ -> pure (Left (PlanGitError stderrTxt))++-- | Checks which governed planning files physically exist in the worktree directory on disk.+governedFilesExist :: PlanStore -> IO [(FilePath, Bool)]+governedFilesExist store = do+ let root = planWorkTree store+ mapM (\relPath -> do+ exists <- doesFileExist (root </> relPath)+ pure (relPath, exists)+ ) (planGovernedFiles store)
+ src/Gachi/Plan/Types.hs view
@@ -0,0 +1,224 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}++-- | Module: Gachi.Plan.Types+-- Description: Core types, models, and data structures for ecosystem plan governance+--+-- This module defines the foundational algebraic data models for the isolated+-- detached Git store architecture (~/src/PLAN.md §1.A, Phase 5, Milestone 5.1).+--+-- = Architectural Context & Invariants+--+-- In accordance with Note [Plan Governance and Rollback Mechanics]+-- [ref:note-plan-governance-rollback], planning files across @~/src/@ are+-- tracked in an isolated detached Git repository without interfering with+-- child repository checkouts. This module formalizes the data models representing+-- the detached store configuration, execution errors, status queries, snapshot+-- ledger metadata, and governed document invariants.+--+-- See also Note [Append-Only Plan Snapshot Invariants] [ref:note-plan-snapshots].+module Gachi.Plan.Types+ ( -- * Store Configuration+ PlanStore(..)+ , defaultGovernedFiles+ , defaultStoreName+ , planGitDirEnvVar++ -- * Snapshot Ledger Configuration & Metadata+ , SnapshotMeta(..)+ , planSnapshotDirEnvVar+ , defaultSnapshotDirName++ -- * Store Status & Metadata+ , PlanStoreStatus(..)+ , isPlanStoreClean++ -- * Rollback, Diff & Log Models+ , RollbackResult(..)+ , PlanDiff(..)+ , PlanCommit(..)+ , CheckpointResult(..)++ -- * Failure Conditions+ , PlanError(..)+ ) where++import Data.Text (Text)+import Data.Time (UTCTime)+import GHC.Generics (Generic)++-- | Configuration and runtime handle for a detached Git plan store.+--+-- The detached store separates the repository metadata directory (@--git-dir@)+-- from the working directory root (@--work-tree@). This architecture guarantees+-- that no nested @.git@ directory is created in @~/src/@, completely avoiding+-- collisions with child repository checkouts.+data PlanStore = PlanStore+ { planGitDir :: !FilePath+ -- ^ Absolute path to the detached bare Git repository directory+ -- (e.g. @/home/nyc/.plan.git@ or @/home/nyc/src/.plan.git@).+ , planWorkTree :: !FilePath+ -- ^ Absolute path to the governed working tree root directory+ -- (e.g. @/home/nyc/src@).+ , planGovernedFiles :: ![FilePath]+ -- ^ Canonical relative paths of governance documents tracked by the store.+ }+ deriving stock (Eq, Show, Generic)++-- | Canonical ecosystem planning and governance files tracked by the detached store.+--+-- Per Note [Plan Governance and Rollback Mechanics] [ref:note-plan-governance-rollback],+-- the detached Git store exclusively tracks top-level planning documents and roadmap+-- indexes across @~/src/@.+defaultGovernedFiles :: [FilePath]+defaultGovernedFiles =+ [ "PLAN.md"+ , "STATE.md"+ , "INDEX.md"+ , "docs/INDEX.md"+ ]++-- | Default name of the bare Git store directory relative to the home directory.+defaultStoreName :: FilePath+defaultStoreName = ".plan.git"++-- | Standard environment variable name for overriding the detached Git store path.+planGitDirEnvVar :: String+planGitDirEnvVar = "PLAN_GIT_DIR"++-- | Standard environment variable name for overriding the snapshot ledger directory.+planSnapshotDirEnvVar :: String+planSnapshotDirEnvVar = "PLAN_SNAPSHOT_DIR"++-- | Default snapshot ledger directory relative to workspace root or home directory.+defaultSnapshotDirName :: FilePath+defaultSnapshotDirName = "plans/snapshots"++-- | Metadata record describing an immutable snapshot within the snapshot ledger.+--+-- In accordance with Note [Append-Only Plan Snapshot Invariants] [ref:note-plan-snapshots],+-- each snapshot preserves a byte-for-byte replica of a governed planning document+-- prior to mutation or at an explicit milestone checkpoint.+data SnapshotMeta = SnapshotMeta+ { snapshotId :: !Text+ -- ^ Unique snapshot identifier (typically matching the snapshot file name).+ , snapshotPath :: !FilePath+ -- ^ Absolute filesystem path to the immutable snapshot file.+ , snapshotTimestamp :: !UTCTime+ -- ^ Timestamp when the snapshot was recorded in UTC.+ , snapshotSha256 :: !Text+ -- ^ Cryptographic SHA-256 digest of the snapshot file contents.+ , snapshotSourceFile :: !FilePath+ -- ^ Original governed file name or relative path that was snapshotted (e.g. @"PLAN.md"@).+ , snapshotIsCheckpoint :: !Bool+ -- ^ Whether this snapshot marks an immutable milestone checkpoint exempt from automated pruning.+ }+ deriving stock (Eq, Show, Generic)++-- | Observed runtime status, commit metadata, and dirty state of a detached Git plan store.+--+-- Captures the current HEAD commit hash, dirty tracking state of governed files,+-- commit timestamp, and tracked file inventory.+data PlanStoreStatus = PlanStoreStatus+ { statusStorePath :: !FilePath+ -- ^ Absolute path to the detached Git store directory.+ , statusWorkTree :: !FilePath+ -- ^ Absolute path to the governed working tree root directory.+ , statusHeadCommit :: !(Maybe Text)+ -- ^ Full 40-character SHA-1 commit hash of the current HEAD revision,+ -- or 'Nothing' if the repository is newly initialized without commits (unborn HEAD).+ , statusIsDirty :: !Bool+ -- ^ 'True' if any governed document has unstaged modifications, staged changes,+ -- or exists untracked in the worktree.+ , statusLastCommitTime :: !(Maybe UTCTime)+ -- ^ Timestamp of the most recent commit in UTC, or 'Nothing' if unborn.+ , statusDirtyFiles :: ![FilePath]+ -- ^ Canonical relative paths of governed files that have uncommitted or untracked changes.+ , statusTrackedFiles :: ![FilePath]+ -- ^ Canonical relative paths of governed files currently tracked in the Git index.+ }+ deriving stock (Eq, Show, Generic)++-- | Predicate checking whether a plan store has zero uncommitted or untracked changes.+isPlanStoreClean :: PlanStoreStatus -> Bool+isPlanStoreClean status = not (statusIsDirty status)++-- | Outcome of an atomic rollback operation.+--+-- In accordance with Note [Deterministic Plan Rollback Invariants]+-- [ref:note-plan-rollback-invariants], records the target commit hash, safety pre-mutation+-- snapshots taken prior to modifying disk state, list of restored governed files,+-- and bitwise integrity verification status.+data RollbackResult = RollbackResult+ { rollbackTargetRef :: !Text+ -- ^ The target commit hash or git reference to which the store was rolled back.+ , rollbackSafetySnapshots :: ![SnapshotMeta]+ -- ^ Pre-mutation safety snapshots recorded in the ledger prior to destructive checkout.+ , rollbackRestoredFiles :: ![FilePath]+ -- ^ Canonical relative paths of governed files successfully restored from the object store.+ , rollbackVerified :: !Bool+ -- ^ 'True' if restored file contents were verified for byte-level integrity against the git object store.+ }+ deriving stock (Eq, Show, Generic)++-- | Structured diff report comparing working planning documents against a Git revision.+data PlanDiff = PlanDiff+ { diffTargetRef :: !(Maybe Text)+ -- ^ Target git reference compared against ('Nothing' indicates HEAD).+ , diffRawContent :: !Text+ -- ^ Raw unified diff text output from git diff.+ , diffChangedFiles :: ![FilePath]+ -- ^ Relative file paths of governed files exhibiting modifications.+ , diffAdditions :: !Int+ -- ^ Total number of added lines (+).+ , diffDeletions :: !Int+ -- ^ Total number of deleted lines (-).+ }+ deriving stock (Eq, Show, Generic)++-- | Historical commit record retrieved from the detached Git plan store.+data PlanCommit = PlanCommit+ { commitHash :: !Text+ -- ^ Full 40-character SHA-1 commit hash.+ , commitShortHash :: !Text+ -- ^ Abbreviated commit hash (7 characters).+ , commitAuthor :: !Text+ -- ^ Author name and email stanza.+ , commitTimestamp :: !UTCTime+ -- ^ Commit timestamp in UTC.+ , commitSubject :: !Text+ -- ^ First line of commit message.+ , commitBody :: !Text+ -- ^ Commit message explanatory body.+ , commitTrailers :: ![(Text, Text)]+ -- ^ Parsed RFC 2822 git trailers (e.g. ("Assisted-by", "Antigravity")).+ }+ deriving stock (Eq, Show, Generic)++-- | Outcome of creating a milestone checkpoint in the plan store.+data CheckpointResult = CheckpointResult+ { checkpointCommitSha :: !Text+ -- ^ Commit hash of the created checkpoint in the detached store.+ , checkpointSnapshots :: ![SnapshotMeta]+ -- ^ Immutable milestone snapshots recorded in the ledger.+ , checkpointStagedFiles :: ![FilePath]+ -- ^ Governed files staged and committed.+ , checkpointMessage :: !Text+ -- ^ Final commit message including attribution trailers.+ }+ deriving stock (Eq, Show, Generic)++-- | Error conditions encountered during detached Git store lifecycle or operations.+data PlanError+ = PlanGitError !Text+ -- ^ An underlying git command exited with a non-zero exit code.+ -- Contains the captured standard error output.+ | PlanStoreMissing !FilePath+ -- ^ The specified detached Git store directory does not exist or is not a valid bare Git repository.+ | PlanWorkTreeMissing !FilePath+ -- ^ The specified working tree root directory does not exist.+ | PlanIOError !Text+ -- ^ A filesystem or I/O failure occurred during store operations.+ | PlanInvalidPath !FilePath+ -- ^ A provided filesystem path is malformed or invalid.+ deriving stock (Eq, Show, Generic)
+ test/Main.hs view
@@ -0,0 +1,271 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Module: Main (gachi-plan test suite)+-- Description: Unit and integration tests for detached Git plan store architecture+--+-- Validates Milestone 5.1 of Phase 5 (Ecosystem Plan Governance & Rollback per ~/src/PLAN.md §1.A).+-- Tests detached bare Git repository lifecycle, non-interference invariants,+-- governed document tracking, dirty status detection, and commit metadata.+module Main (main) where++import Control.Exception (SomeException, bracket, catch)+import Control.Monad (forM_)+import qualified Data.Text as T+import qualified Data.Text.IO as TIO+import Data.Time.Clock.POSIX (getPOSIXTime)+import System.Directory+ ( createDirectoryIfMissing+ , doesDirectoryExist+ , getTemporaryDirectory+ , removeDirectoryRecursive+ )+import System.FilePath ((</>))+import Test.Hspec++import Gachi.Plan+ ( PlanStore(..)+ , PlanStoreStatus(..)+ , commitStore+ , defaultGovernedFiles+ , getPlanStoreDiff+ , governedFilesExist+ , initPlanStore+ , isPlanStoreClean+ , isStoreInitialized+ , listTrackedFiles+ , queryPlanStore+ , resolvePlanStorePath+ , stageFiles+ , trackGovernedFiles+ )++-- | Helper executing an action within an isolated temporary directory.+withTempDir :: String -> (FilePath -> IO a) -> IO a+withTempDir prefix action = do+ base <- getTemporaryDirectory+ t <- getPOSIXTime+ let dirPath = base </> (prefix ++ "-" ++ show (round (t * 1000) :: Integer))+ bracket+ (createDirectoryIfMissing True dirPath >> pure dirPath)+ (\p -> catch (removeDirectoryRecursive p) (\(_ :: SomeException) -> pure ()))+ action++main :: IO ()+main = hspec $ do+ describe "Gachi.Plan.Store (Detached Git Store Lifecycle)" $ do+ it "initializes a fresh bare Git store in a temporary directory" $ do+ withTempDir "gachi-plan-init" $ \tmpDir -> do+ let storePath = tmpDir </> "store.git"+ workPath = tmpDir </> "work"+ res <- initPlanStore storePath workPath+ case res of+ Left err -> expectationFailure ("initPlanStore failed: " ++ show err)+ Right store -> do+ planGitDir store `shouldBe` storePath+ planWorkTree store `shouldBe` workPath+ planGovernedFiles store `shouldBe` defaultGovernedFiles+ isInit <- isStoreInitialized storePath+ isInit `shouldBe` True++ it "idempotently re-initializes an already existing bare store" $ do+ withTempDir "gachi-plan-reinit" $ \tmpDir -> do+ let storePath = tmpDir </> "store.git"+ workPath = tmpDir </> "work"+ res1 <- initPlanStore storePath workPath+ case res1 of+ Left err -> expectationFailure ("First init failed: " ++ show err)+ Right _ -> do+ res2 <- initPlanStore storePath workPath+ case res2 of+ Left err -> expectationFailure ("Second init failed: " ++ show err)+ Right store2 -> do+ isInit <- isStoreInitialized (planGitDir store2)+ isInit `shouldBe` True++ it "resolves explicit store path to an absolute path" $ do+ withTempDir "gachi-plan-resolve" $ \tmpDir -> do+ let explicitPath = tmpDir </> "custom.git"+ resolved <- resolvePlanStorePath (Just explicitPath)+ resolved `shouldBe` explicitPath++ it "reports false for non-existent store directory" $ do+ withTempDir "gachi-plan-missing" $ \tmpDir -> do+ let bogusPath = tmpDir </> "does-not-exist.git"+ isInit <- isStoreInitialized bogusPath+ isInit `shouldBe` False++ describe "Gachi.Plan.Store (Non-Interference & Worktree Isolation Invariants)" $ do+ it "strictly avoids creating .git in worktree root" $ do+ withTempDir "gachi-plan-isolation" $ \tmpDir -> do+ let storePath = tmpDir </> "store.git"+ workPath = tmpDir </> "work"+ createDirectoryIfMissing True workPath+ _ <- initPlanStore storePath workPath+ -- Verify no .git directory or file was created in workPath+ hasDotGit <- doesDirectoryExist (workPath </> ".git")+ hasDotGit `shouldBe` False++ it "preserves child repository .git checkouts without interference" $ do+ withTempDir "gachi-plan-children" $ \tmpDir -> do+ let storePath = tmpDir </> "store.git"+ workPath = tmpDir </> "work"+ childA = workPath </> "gachi"+ childB = workPath </> "polytropos"+ -- Simulate pre-existing child repository workspaces+ createDirectoryIfMissing True (childA </> ".git")+ createDirectoryIfMissing True (childB </> ".git")+ TIO.writeFile (childA </> "Main.hs") "module Main where"+ TIO.writeFile (childB </> "Lib.hs") "module Lib where"++ -- Initialize detached plan store at worktree root+ res <- initPlanStore storePath workPath+ case res of+ Left err -> expectationFailure ("init failed: " ++ show err)+ Right store -> do+ -- Create top-level ecosystem plan files+ TIO.writeFile (workPath </> "PLAN.md") "# Ecosystem Plan"+ TIO.writeFile (workPath </> "STATE.md") "# Ecosystem State"++ -- Stage and commit governed files+ stageRes <- trackGovernedFiles store+ case stageRes of+ Left err -> expectationFailure ("trackGovernedFiles failed: " ++ show err)+ Right staged -> length staged `shouldBe` 2++ commitRes <- commitStore store "Initial plan commit"+ case commitRes of+ Left err -> expectationFailure ("commitStore failed: " ++ show err)+ Right commitSha -> T.length commitSha `shouldBe` 40++ -- Child repo .git directories MUST remain intact+ childAExists <- doesDirectoryExist (childA </> ".git")+ childBExists <- doesDirectoryExist (childB </> ".git")+ childAExists `shouldBe` True+ childBExists `shouldBe` True++ -- Worktree root MUST NOT have a .git directory+ rootDotGit <- doesDirectoryExist (workPath </> ".git")+ rootDotGit `shouldBe` False++ describe "Gachi.Plan.Store (Governed File Tracking & Dirty Detection)" $ do+ it "reports empty tracked files and clean state on fresh store" $ do+ withTempDir "gachi-plan-empty" $ \tmpDir -> do+ let storePath = tmpDir </> "store.git"+ workPath = tmpDir </> "work"+ Right store <- initPlanStore storePath workPath+ status <- queryPlanStore store+ statusHeadCommit status `shouldBe` Nothing+ statusLastCommitTime status `shouldBe` Nothing+ statusTrackedFiles status `shouldBe` []+ statusDirtyFiles status `shouldBe` []+ statusIsDirty status `shouldBe` False+ isPlanStoreClean status `shouldBe` True++ it "detects untracked governed planning files as dirty" $ do+ withTempDir "gachi-plan-dirty" $ \tmpDir -> do+ let storePath = tmpDir </> "store.git"+ workPath = tmpDir </> "work"+ Right store <- initPlanStore storePath workPath++ -- Create mock governed planning files+ TIO.writeFile (workPath </> "PLAN.md") "# Master Plan\n"+ TIO.writeFile (workPath </> "STATE.md") "# Operational Frontier\n"++ status <- queryPlanStore store+ statusIsDirty status `shouldBe` True+ isPlanStoreClean status `shouldBe` False+ statusDirtyFiles status `shouldContain` ["PLAN.md"]+ statusDirtyFiles status `shouldContain` ["STATE.md"]++ it "ignores untracked files in child directories during dirty queries" $ do+ withTempDir "gachi-plan-ignore-child" $ \tmpDir -> do+ let storePath = tmpDir </> "store.git"+ workPath = tmpDir </> "work"+ childDir = workPath </> "some-child-package"+ createDirectoryIfMissing True childDir+ Right store <- initPlanStore storePath workPath++ -- Write untracked file in child package+ TIO.writeFile (childDir </> "SomeCode.hs") "module SomeCode where"++ -- Status should remain clean because governed files do not exist and child files are ignored+ status <- queryPlanStore store+ statusIsDirty status `shouldBe` False+ statusDirtyFiles status `shouldBe` []++ it "transitions from dirty to clean upon staging and committing" $ do+ withTempDir "gachi-plan-commit" $ \tmpDir -> do+ let storePath = tmpDir </> "store.git"+ workPath = tmpDir </> "work"+ Right store <- initPlanStore storePath workPath++ -- Create all four canonical governed files+ createDirectoryIfMissing True (workPath </> "docs")+ TIO.writeFile (workPath </> "PLAN.md") "# Plan\n"+ TIO.writeFile (workPath </> "STATE.md") "# State\n"+ TIO.writeFile (workPath </> "INDEX.md") "# Index\n"+ TIO.writeFile (workPath </> "docs" </> "INDEX.md") "# Docs Index\n"++ -- Check physical file presence+ existList <- governedFilesExist store+ length existList `shouldBe` 4+ forM_ existList $ \(_, exists) -> exists `shouldBe` True++ -- Stage governed files+ stageRes <- stageFiles store ["PLAN.md", "STATE.md", "INDEX.md", "docs/INDEX.md"]+ case stageRes of+ Left err -> expectationFailure ("stageFiles failed: " ++ show err)+ Right () -> pure ()++ -- Files should now be tracked+ tracked <- listTrackedFiles store+ tracked `shouldContain` ["PLAN.md"]+ tracked `shouldContain` ["STATE.md"]+ tracked `shouldContain` ["INDEX.md"]+ tracked `shouldContain` ["docs/INDEX.md"]++ -- Commit changes+ commitRes <- commitStore store "Initial ecosystem governance checkpoint"+ case commitRes of+ Left err -> expectationFailure ("commitStore failed: " ++ show err)+ Right commitSha -> do+ T.length commitSha `shouldBe` 40++ -- Query updated status: should be clean with HEAD commit and timestamp+ status <- queryPlanStore store+ statusHeadCommit status `shouldBe` Just commitSha+ statusIsDirty status `shouldBe` False+ isPlanStoreClean status `shouldBe` True+ statusDirtyFiles status `shouldBe` []+ statusLastCommitTime status `shouldSatisfy` (/= Nothing)++ it "detects modifications to tracked planning documents and provides diff" $ do+ withTempDir "gachi-plan-diff" $ \tmpDir -> do+ let storePath = tmpDir </> "store.git"+ workPath = tmpDir </> "work"+ Right store <- initPlanStore storePath workPath++ -- Initialize and commit a plan+ TIO.writeFile (workPath </> "PLAN.md") "# Version 1.0\n"+ _ <- stageFiles store ["PLAN.md"]+ _ <- commitStore store "Baseline commit"++ -- Verify clean+ status1 <- queryPlanStore store+ statusIsDirty status1 `shouldBe` False++ -- Modify PLAN.md+ TIO.appendFile (workPath </> "PLAN.md") "Added Phase 5 milestone details.\n"++ -- Verify dirty+ status2 <- queryPlanStore store+ statusIsDirty status2 `shouldBe` True+ statusDirtyFiles status2 `shouldContain` ["PLAN.md"]++ -- Inspect diff+ diffRes <- getPlanStoreDiff store Nothing+ case diffRes of+ Left err -> expectationFailure ("diff failed: " ++ show err)+ Right diffText -> do+ T.isInfixOf "Added Phase 5 milestone details." diffText `shouldBe` True