diff --git a/gachi-sync.cabal b/gachi-sync.cabal new file mode 100644 --- /dev/null +++ b/gachi-sync.cabal @@ -0,0 +1,80 @@ +cabal-version: 3.0 +name: gachi-sync +version: 0.1.0.0 +synopsis: Cross-repository standardization matrix and configuration synchronization for Gachi +description: + Implements the 9-dimensional ecosystem standardization matrix (~/src/PLAN.md §1.A), + canonical shared asset catalog, repository audit engine, and harmonic configuration + propagation across ecosystem checkouts ('gachi sync'). +license: EUPL-1.2 +author: Nadia Yvette Chambers +maintainer: nadia.yvette.chambers@ik.me +category: Development, Tools +build-type: Simple +tested-with: + GHC == 9.10.3, + GHC == 9.12.4, + GHC == 9.14.1 + +library + exposed-modules: + Gachi.Sync + Gachi.Sync.Audit + Gachi.Sync.Catalog + Gachi.Sync.CI + Gachi.Sync.Engine + Gachi.Sync.Hash + Gachi.Sync.Matrix + Gachi.Sync.Remote + Gachi.Sync.Sheaf + Gachi.Sync.Types + hs-source-dirs: src + default-language: Haskell2010 + default-extensions: + OverloadedStrings + DerivingStrategies + ScopedTypeVariables + ghc-options: + -Wall + -Wcompat + -Wredundant-constraints + build-depends: + base >= 4.14 && < 5, + bytestring >= 0.10, + text >= 2.0, + containers >= 0.6, + directory >= 1.3, + filepath >= 1.4, + process >= 1.6, + gachi-core >= 0.1, + gachi-schema >= 0.1, + gachi-scaffold >= 0.1 + +test-suite tests + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: test + default-language: Haskell2010 + default-extensions: + OverloadedStrings + DerivingStrategies + ScopedTypeVariables + ghc-options: + -Wall + -Wcompat + -Wredundant-constraints + -threaded + build-depends: + base >= 4.14 && < 5, + gachi-sync, + gachi-core, + gachi-schema, + gachi-scaffold, + bytestring >= 0.10, + text >= 2.0, + containers >= 0.6, + directory >= 1.3, + filepath >= 1.4, + process >= 1.6, + time >= 1.9, + hspec >= 2.10 diff --git a/src/Gachi/Sync.hs b/src/Gachi/Sync.hs new file mode 100644 --- /dev/null +++ b/src/Gachi/Sync.hs @@ -0,0 +1,122 @@ +-- | Module: Gachi.Sync +-- Description: Root umbrella module for Gachi cross-repository standardization & synchronization +-- +-- This is the primary entry point for the @gachi-sync@ library. It exposes +-- the 9-dimensional Standardization Matrix (~/src/PLAN.md §1.A), canonical +-- shared asset generators, non-destructive audit engine, and diagnostic reporting. +-- +-- = Architectural Context & Invariants +-- +-- In accordance with Note [Ecosystem Standardization Invariants] +-- [ref:note-ecosystem-standardization] and Note [Cross-Repository Standardization Matrix and Audit Semantics] +-- [ref:note-standardization-matrix], all repositories across ~/src/* share an +-- authoritative structural skeleton. This library provides the declarative +-- contracts and inspection machinery that guarantee structural consistency. +-- +-- == The Four Standardization Subsystems +-- +-- The Gachi synchronization subsystem is organized into four complementary layers: +-- +-- 1. __Core Types and Models ("Gachi.Sync.Types"):__ +-- Formalizes the 9 dimensions as 'AssetCategory', individual asset models +-- as 'StandardAsset', composite matrices as 'StandardizationMatrix', and +-- inspection outcomes as 'AssetAuditStatus' and 'AuditReport'. +-- +-- 2. __Shared Asset Catalog ("Gachi.Sync.Catalog"):__ +-- Pure, total template generators for Fourmolu, rustfmt, clang-format, +-- strict HLint rules, Cabal project pinning, Git commit-msg and pre-commit +-- hooks, forge-tiered CI workflows, and AI agent instructions. +-- +-- 3. __Canonical Standardization Matrix ("Gachi.Sync.Matrix"):__ +-- The authoritative 'canonicalMatrix' registry aggregating all standardized +-- assets across the 9 dimensions, complete with category queries and filter +-- combinators ('assetsForCategory', 'requiredAssets', 'executableAssets'). +-- +-- 4. __Non-Destructive Audit Engine ("Gachi.Sync.Audit"):__ +-- Read-only filesystem analyzer ('auditRepository', 'auditRepositoryQuick') +-- evaluating checkouts against matrix contracts, detecting content and +-- permission drift, and rendering diagnostic ASCII tables ('formatAuditReport'). +-- +-- 5. __Forge-Tiered CI Matrix Synthesis ("Gachi.Sync.CI"):__ +-- Declarative models ('ForgeType', 'CITier', 'CISpec') and deterministic +-- generators synthesizing high-resource GitHub Actions workflows and lightweight +-- community CI pipelines (GitLab, Woodpecker, Forgejo, Radicle). +-- +-- 6. __Multi-Remote Replication Topology & Provider Compliance ("Gachi.Sync.Remote"):__ +-- Formal models ('RemoteCategory', 'ProviderPolicy', 'ConfiguredRemote', +-- 'RemoteTopologyReport', 'RemoteSyncPlan') and operational executors +-- enforcing the canonical 5-forge replication topology (Dimension 6: Radicle, +-- GitHub, GitCode, Framagit, Disroot) while filtering and purging non-compliant +-- hosting platforms (SourceHut, plaintext HTTP). +-- +-- == Operational Invariants +-- +-- All modules within @gachi-sync@ adhere to strict engineering guarantees: +-- * __Purity & Reproducibility:__ All generators evaluate from typed records +-- without reading environment variables or accessing the network. +-- * __Observational Non-Destruction:__ The audit engine evaluates disk checkouts +-- using read-only inspection primitives, guaranteeing zero accidental overwrites. +-- * __Toolchain Hermeticity:__ Pinned to GHC 9.14.1 and Cabal 3.18 under strict +-- compiler warnings (@-Wall -Wcompat -Wredundant-constraints@) and zero HLint hints. +-- +-- = Worked Example: Auditing a Target Checkout +-- +-- The following example demonstrates auditing an existing repository against +-- the canonical standardization matrix: +-- +-- >>> import Gachi.Schema.Project (defaultProject, Author(..)) +-- >>> import Gachi.Sync +-- >>> let auth = Author "Nadia Yvette Chambers" "nadia.yvette.chambers@ik.me" +-- >>> let proj = defaultProject "gachi" auth +-- >>> report <- auditRepository "/home/nyc/src/gachi" proj canonicalMatrix +-- >>> reportCompliantCount report > 0 +-- True +-- >>> length (filterMissingResults report) == 0 +-- True +-- +-- = Worked Example: Quick Audit Without Explicit Project +-- +-- When project specifications are not known upfront, 'auditRepositoryQuick' +-- automatically infers the project name from the checkout path or @project.dhall@: +-- +-- >>> res <- auditRepositoryQuick "/home/nyc/src/gachi" +-- >>> case res of { Right rep -> reportCompliancePct rep >= 50.0; Left _ -> False } +-- True +module Gachi.Sync + ( -- * Core Standardization Types + module Gachi.Sync.Types + + -- * Canonical Standardization Matrix + , module Gachi.Sync.Matrix + + -- * Shared Asset Catalog + , module Gachi.Sync.Catalog + + -- * Non-Destructive Audit Engine + , module Gachi.Sync.Audit + + -- * Harmonic Chattering Synchronization Engine + , module Gachi.Sync.Engine + + -- * Differential Cryptographic Hashing + , module Gachi.Sync.Hash + + -- * Forge-Tiered CI Matrix Synthesis + , module Gachi.Sync.CI + + -- * Multi-Remote Replication Topology & Provider Compliance + , module Gachi.Sync.Remote + + -- * Cellular Sheaf Cohomology & Ecosystem Coherence + , module Gachi.Sync.Sheaf + ) where + +import Gachi.Sync.Audit +import Gachi.Sync.Catalog +import Gachi.Sync.CI +import Gachi.Sync.Engine +import Gachi.Sync.Hash +import Gachi.Sync.Matrix +import Gachi.Sync.Remote +import Gachi.Sync.Sheaf +import Gachi.Sync.Types diff --git a/src/Gachi/Sync/Audit.hs b/src/Gachi/Sync/Audit.hs new file mode 100644 --- /dev/null +++ b/src/Gachi/Sync/Audit.hs @@ -0,0 +1,389 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Module: Gachi.Sync.Audit +-- Description: Non-destructive repository audit engine and diagnostic reporter +-- +-- This module implements the read-only audit engine for inspecting local +-- checkouts against the canonical Standardization Matrix (~/src/PLAN.md §1.A). +-- +-- = Architectural Context & Invariants +-- +-- In accordance with Note [Ecosystem Standardization Invariants] +-- [ref:note-ecosystem-standardization] and Note [Cross-Repository Standardization Matrix and Audit Semantics] +-- [ref:note-standardization-matrix], audits are strictly read-only and non-destructive. +-- They evaluate physical file existence, exact textual content matching against +-- canonical generators, and POSIX executable permissions (@+x@) without mutating +-- any filesystem state. +-- +-- == Audit Classification Rules +-- +-- For each asset registered in the 'StandardizationMatrix', the audit engine produces +-- exactly one 'AssetAuditResult' containing an 'AssetAuditStatus': +-- +-- * 'StatusCompliant': +-- The file exists at the expected path, its textual content matches the canonical +-- generator byte-for-byte, and its executable bits conform to the specification. +-- +-- * 'StatusMissing': +-- The file does not exist on disk. For required assets, this is flagged as an +-- audit violation; for optional assets (e.g. polyglot formatting rules), it is +-- recorded without failing the verification gate. +-- +-- * 'StatusContentDrift': +-- The file exists on disk, but its content differs from the output produced by +-- the canonical generator. The lengths of actual and expected contents are recorded. +-- +-- * 'StatusPermissionDrift': +-- The file exists and its content matches, but its executable bit differs from +-- 'assetExecutable' (e.g. a script in @bin/@ lacking executable permissions). +-- +-- * 'StatusIOError': +-- An unexpected filesystem exception occurred while attempting to read the file. +-- +-- == Read-Only & Non-Destructive Invariant +-- +-- The audit engine strictly adheres to the principle of observational purity: +-- 1. __Zero Mutations:__ No files, symlinks, or directories are created, modified, +-- or deleted during audit execution. +-- 2. __Exception Containment:__ I/O exceptions (e.g., permission denied, broken symlinks, +-- dangling filesystem nodes) are captured and reported as 'StatusIOError' rather +-- than aborting the audit process abruptly. +-- 3. __Differential Hashing:__ Content comparisons are performed in memory against +-- pure generator outputs, ensuring that audits require no network access or external +-- database queries. +-- +-- = Worked Example +-- +-- >>> import Gachi.Schema.Project (defaultProject, Author(..)) +-- >>> import Gachi.Sync.Matrix (canonicalMatrix) +-- >>> let auth = Author "Nadia Yvette Chambers" "nadia.yvette.chambers@ik.me" +-- >>> let proj = defaultProject "gachi" auth +-- >>> report <- auditRepository "/home/nyc/src/gachi" proj canonicalMatrix +-- >>> reportTotalAssets report >= 20 +-- True +-- >>> reportCompliancePct report >= 50.0 +-- True +module Gachi.Sync.Audit + ( -- * Repository Audit Operations + auditRepository + , auditAsset + , auditRepositoryQuick + + -- * Diagnostic Report Formatting + , formatAuditReport + , formatAuditReportString + + -- * Result Filter Helpers + , filterCompliantResults + , filterDriftResults + , filterMissingResults + ) where + +import Control.Exception (SomeException, catch, displayException) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import System.Directory (doesFileExist, getPermissions, executable) +import System.FilePath ((), takeFileName) + +import Gachi.Schema.Dhall (decodeProjectFile) +import Gachi.Schema.Project (Author(..), Project, projectName, defaultProject) +import Gachi.Sync.Matrix (canonicalMatrix) +import Gachi.Sync.Types + ( AssetAuditResult(..) + , AssetAuditStatus(..) + , AuditReport(..) + , StandardAsset(..) + , StandardizationMatrix(..) + , categoryName + , isCompliant + , isDrift + , isMissing + , resolveAssetPath + ) + +-------------------------------------------------------------------------------- +-- 1. Single Asset Audit +-------------------------------------------------------------------------------- + +-- | Inspects an individual standardized asset against a target workspace. +-- +-- Resolves the asset's concrete path using 'resolveAssetPath', checks for file +-- existence, reads the file's textual contents, checks executable permissions, +-- and compares the actual state against the expected generator output. +-- +-- This operation is strictly read-only and catches all filesystem exceptions, +-- returning 'StatusIOError' upon failure rather than throwing unhandled exceptions. +-- +-- === Evaluation Steps +-- +-- 1. Resolves concrete relative path via 'resolveAssetPath' (substituting @:name:@ tokens). +-- 2. Checks existence using 'System.Directory.doesFileExist'. +-- 3. If file does not exist, returns 'StatusMissing'. +-- 4. If file exists, reads text content using 'TIO.readFile'. +-- 5. Evaluates the pure generator 'assetGenerator' against 'proj'. +-- 6. If textual contents diverge, returns 'StatusContentDrift'. +-- 7. If contents match, inspects POSIX executable permissions. +-- 8. If executable requirements differ, returns 'StatusPermissionDrift'. +-- 9. If everything matches, returns 'StatusCompliant'. +-- +-- === Worked Example +-- +-- >>> import Gachi.Schema.Project (defaultProject, Author(..)) +-- >>> let proj = defaultProject "gachi" (Author "Nadia" "nadia@example.com") +-- >>> let asset = StandardAsset ".hlint.yaml" Gachi.Sync.Types.CategoryLinter True False "HLint" (const "") +-- >>> result <- auditAsset "/home/nyc/src/gachi" proj asset +-- >>> resultAsset result == asset +-- True +auditAsset :: FilePath -> Project -> StandardAsset -> IO AssetAuditResult +auditAsset repoRoot proj asset = do + let relPath = resolveAssetPath proj asset + absPath = repoRoot relPath + exists <- doesFileExist absPath + if not exists + then pure (AssetAuditResult asset StatusMissing) + else checkContentAndPerms absPath + where + checkContentAndPerms absPath = (do + actualContent <- TIO.readFile absPath + let expectedContent = assetGenerator asset proj + if actualContent /= expectedContent + then + let actualLen = T.length actualContent + expectedLen = T.length expectedContent + in pure (AssetAuditResult asset (StatusContentDrift actualLen expectedLen)) + else do + perms <- getPermissions absPath + let actualExec = executable perms + expectedExec = assetExecutable asset + if expectedExec && not actualExec + then pure (AssetAuditResult asset (StatusPermissionDrift actualExec expectedExec)) + else pure (AssetAuditResult asset StatusCompliant) + ) `catch` (\(e :: SomeException) -> + pure (AssetAuditResult asset (StatusIOError (T.pack (displayException e))))) + +-------------------------------------------------------------------------------- +-- 2. Complete Repository Audit +-------------------------------------------------------------------------------- + +-- | Audits an entire repository workspace against a 'StandardizationMatrix'. +-- +-- Evaluates each asset registered in 'matrixAssets', tabulates compliance and +-- discrepancy metrics, and constructs a comprehensive 'AuditReport' summarizing +-- findings across all standardization dimensions. +-- +-- === Metrics Computed +-- +-- * 'reportTotalAssets': Total count of assets evaluated. +-- * 'reportCompliantCount': Assets matching content and permissions exactly. +-- * 'reportDriftCount': Assets present on disk with differing text or permissions. +-- * 'reportMissingCount': Required assets absent from the filesystem. +-- * 'reportCompliancePct': Ratio of compliant assets to total assets (0.0% to 100.0%). +-- +-- === Worked Example +-- +-- >>> import Gachi.Schema.Project (defaultProject, Author(..)) +-- >>> import Gachi.Sync.Matrix (canonicalMatrix) +-- >>> let proj = defaultProject "gachi" (Author "Nadia" "nadia@example.com") +-- >>> report <- auditRepository "/home/nyc/src/gachi" proj canonicalMatrix +-- >>> reportTotalAssets report >= 20 +-- True +auditRepository :: FilePath -> Project -> StandardizationMatrix -> IO AuditReport +auditRepository repoRoot proj matrix = do + results <- traverse (auditAsset repoRoot proj) (matrixAssets matrix) + let total = length results + compliant = length (filter (isCompliant . resultStatus) results) + drift = length (filter (isDrift . resultStatus) results) + missing = length (filter (\r -> isMissing (resultStatus r) && assetRequired (resultAsset r)) results) + pct = if total == 0 + then 100.0 + else (fromIntegral compliant / fromIntegral total) * 100.0 + pure AuditReport + { reportTargetDir = repoRoot + , reportProjectName = projectName proj + , reportResults = results + , reportTotalAssets = total + , reportCompliantCount = compliant + , reportDriftCount = drift + , reportMissingCount = missing + , reportCompliancePct = pct + } + +-- | Fast, zero-configuration repository audit. +-- +-- Attempts to locate and evaluate @project.dhall@ within 'repoRoot'. If present, +-- decodes the declarative specification via 'decodeProjectFile' and executes +-- 'auditRepository'. If absent, infers project metadata from the directory name +-- and standard author information, auditing against 'canonicalMatrix'. +-- +-- Guarantees total evaluation: catches Dhall decoding exceptions and returns +-- a descriptive 'Left' error text rather than crashing. +-- +-- === Worked Example +-- +-- >>> res <- auditRepositoryQuick "/home/nyc/src/gachi" +-- >>> case res of { Right rep -> reportCompliancePct rep >= 50.0; Left _ -> False } +-- True +auditRepositoryQuick :: FilePath -> IO (Either Text AuditReport) +auditRepositoryQuick repoRoot = do + let dhallPath = repoRoot "project.dhall" + hasDhall <- doesFileExist dhallPath + if hasDhall + then (do + proj <- decodeProjectFile dhallPath + report <- auditRepository repoRoot proj canonicalMatrix + pure (Right report) + ) `catch` (\(e :: SomeException) -> + pure (Left ("Failed to decode project.dhall: " <> T.pack (displayException e)))) + else do + let inferredName = T.pack (takeFileName repoRoot) + defaultAuthor = Author "Nadia Yvette Chambers" "nadia.yvette.chambers@ik.me" + proj = defaultProject inferredName defaultAuthor + report <- auditRepository repoRoot proj canonicalMatrix + pure (Right report) + +-------------------------------------------------------------------------------- +-- 3. Result Filters +-------------------------------------------------------------------------------- + +-- | Filters an 'AuditReport' to only include compliant assets. +-- +-- Useful for generating green status checklists and compliance confirmations. +filterCompliantResults :: AuditReport -> [AssetAuditResult] +filterCompliantResults = filter (isCompliant . resultStatus) . reportResults + +-- | Filters an 'AuditReport' to only include assets exhibiting content or permission drift. +-- +-- Used by synchronization engines ('gachi sync') to identify files requiring differential updates. +filterDriftResults :: AuditReport -> [AssetAuditResult] +filterDriftResults = filter (isDrift . resultStatus) . reportResults + +-- | Filters an 'AuditReport' to only include missing required assets. +-- +-- Identifies critical ecosystem gaps that must be populated during repository retrofitting. +filterMissingResults :: AuditReport -> [AssetAuditResult] +filterMissingResults = + filter (\r -> isMissing (resultStatus r) && assetRequired (resultAsset r)) . reportResults + +-------------------------------------------------------------------------------- +-- 4. Diagnostic Report Formatting +-------------------------------------------------------------------------------- + +-- | Formats an 'AuditReport' as human-readable plain text with ASCII diagnostic tables. +-- +-- Displays: +-- 1. Header banner with repository target path and compliance percentage. +-- 2. Summary statistics (compliant, drift, missing counts). +-- 3. Per-asset tabular evaluation detailing status, category, and relative path. +-- 4. Granular drift or missing asset diagnostics. +-- +-- === Output Format Example +-- +-- @ +-- ================================================================================ +-- Gachi Standardization Matrix Audit Report +-- ================================================================================ +-- Target Directory: /home/nyc/src/gachi +-- Project Name: gachi +-- Total Assets: 25 +-- Compliant: 22 +-- Drift Detected: 1 +-- Missing Required: 2 +-- Compliance Rate: 88.0% +-- -------------------------------------------------------------------------------- +-- Status | Dimension | Path +-- ------------+------------------------+------------------------------------------ +-- OK | Code Formatters | fourmolu.yaml +-- DRIFT | Linters & Guardrails | .hlint.yaml +-- MISSING | Git Governance | .githooks/commit-msg +-- ================================================================================ +-- @ +formatAuditReport :: AuditReport -> Text +formatAuditReport report = T.unlines $ + [ "================================================================================" + , " Gachi Standardization Matrix Audit Report" + , "================================================================================" + , " Target Directory: " <> T.pack (reportTargetDir report) + , " Project Name: " <> reportProjectName report + , " Total Assets: " <> T.show (reportTotalAssets report) + , " Compliant: " <> T.show (reportCompliantCount report) + , " Drift Detected: " <> T.show (reportDriftCount report) + , " Missing Required: " <> T.show (reportMissingCount report) + , " Compliance Rate: " <> formatPct (reportCompliancePct report) + , "--------------------------------------------------------------------------------" + , " Status | Dimension | Path" + , "------------+------------------------+------------------------------------------" + ] + ++ map formatRow (reportResults report) + ++ formatDriftSection (filterDriftResults report) + ++ formatMissingSection (filterMissingResults report) + ++ + [ "================================================================================" ] + where + formatPct :: Double -> Text + formatPct val = + let whole = floor val :: Int + dec = floor (val * 10) `mod` 10 :: Int + in T.show whole <> "." <> T.show dec <> "%" + + formatRow :: AssetAuditResult -> Text + formatRow res = + let stat = formatStatus (resultStatus res) + cat = padRight 22 (categoryName (assetCategory (resultAsset res))) + path = T.pack (assetPath (resultAsset res)) + in " " <> padRight 10 stat <> " | " <> cat <> " | " <> path + + formatStatus :: AssetAuditStatus -> Text + formatStatus StatusCompliant = "OK" + formatStatus StatusMissing = "MISSING" + formatStatus (StatusContentDrift _ _) = "DRIFT" + formatStatus (StatusPermissionDrift _ _) = "PERM-DRIFT" + formatStatus (StatusIOError _) = "ERROR" + + padRight :: Int -> Text -> Text + padRight n txt = + let len = T.length txt + in if len >= n + then txt + else txt <> T.replicate (n - len) " " + + formatDriftSection :: [AssetAuditResult] -> [Text] + formatDriftSection [] = [] + formatDriftSection drifts = + [ "--------------------------------------------------------------------------------" + , " Content & Permission Drift Details:" + ] ++ map explainDrift drifts + + explainDrift :: AssetAuditResult -> Text + explainDrift res = + let p = T.pack (assetPath (resultAsset res)) + in case resultStatus res of + StatusContentDrift actual expected -> + " * " <> p <> ": content divergence (actual len: " <> T.show actual + <> " chars, expected: " <> T.show expected <> " chars)" + StatusPermissionDrift actual expected -> + " * " <> p <> ": permission mismatch (actual exec: " <> T.show actual + <> ", expected: " <> T.show expected <> ")" + StatusIOError err -> + " * " <> p <> ": I/O error (" <> err <> ")" + _ -> " * " <> p + + formatMissingSection :: [AssetAuditResult] -> [Text] + formatMissingSection [] = [] + formatMissingSection missings = + [ "--------------------------------------------------------------------------------" + , " Missing Required Assets:" + ] ++ map explainMissing missings + + explainMissing :: AssetAuditResult -> Text + explainMissing res = + let p = T.pack (assetPath (resultAsset res)) + desc = assetDescription (resultAsset res) + in " * " <> p <> " — " <> desc + +-- | Convenience helper rendering 'formatAuditReport' to a 'String'. +-- +-- Facilitates output to standard terminal streams via 'putStrLn'. +formatAuditReportString :: AuditReport -> String +formatAuditReportString = T.unpack . formatAuditReport diff --git a/src/Gachi/Sync/CI.hs b/src/Gachi/Sync/CI.hs new file mode 100644 --- /dev/null +++ b/src/Gachi/Sync/CI.hs @@ -0,0 +1,810 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Module: Gachi.Sync.CI +-- Description: Forge-tiered CI matrix synthesis and asymmetric runner resource allocation +-- +-- This module implements Milestone 3.3 of the Gachi strategic roadmap (~/src/PLAN.md §1.A). +-- It provides pure declarative models and deterministic generators for multi-forge +-- continuous integration (CI) workflows, partitioning physical verification gates +-- across asymmetric runner capabilities. +-- +-- = Architectural Context & Invariants +-- +-- In accordance with Note [Ecosystem Standardization Invariants] +-- [ref:note-ecosystem-standardization], Note [Cross-Repository Standardization Matrix and Audit Semantics] +-- [ref:note-standardization-matrix], and Note [Forge-Tiered CI Resource Allocation and Static Gate Partitioning] +-- [ref:note-forge-tiered-ci], ecosystem repositories replicate across heterogeneous +-- hosting providers (commercial forges like GitHub, community forges like GitLab/Framagit/Disroot, +-- and sovereign self-hosted instances like Forgejo/Woodpecker/Radicle). +-- +-- == Note [Forge-Tiered CI Resource Allocation and Static Gate Partitioning] +-- [tag:note-forge-tiered-ci] +-- +-- Modern Haskell toolchains impose heavy compute and memory demands. Compiling +-- an interconnected multi-package workspace under GHC 9.14 with Template Haskell, +-- unboxed primitive arrays, and advanced type families requires multi-gigabyte RAM +-- footprints and significant CPU time. +-- +-- Commercial hosting providers (e.g., GitHub Actions) provide high-capacity +-- container runners equipped with 4+ virtual CPUs, 16 GB RAM, generous monthly +-- compute allowances, and global artifact caching services (@actions/cache@). +-- Conversely, community-run and self-hosted forges (e.g., Framagit, Disroot, +-- Codeberg, sourcehut) operate on modest, shared virtual servers where running +-- a full GHC compilation pipeline on every push triggers runner timeouts, CPU +-- throttling, and out-of-memory kernel kills (OOM 137). +-- +-- To achieve universal verification without depleting community resources or +-- failing due to runner memory constraints, Gachi establishes an __asymmetric +-- forge-tiered CI matrix__: +-- +-- 1. __High-Resource Commercial Runners ('TierHighResource'):__ +-- Allocated to GitHub Actions (@.github/workflows/ci.yml@) and dedicated +-- enterprise Forgejo instances. Executes the complete, heavyweight physical +-- verification suite: +-- * Installs system runtime dependencies (bubblewrap, sqlite3, z3). +-- * Configures AppArmor namespace profiles for bubblewrap container isolation. +-- * Deploys pinned GHC (9.14.1) and Cabal (3.18.1.0) toolchains. +-- * Restores cryptographic Cabal store caches (@~/.cabal/store@, @dist-newstyle@). +-- * Compiles all workspace packages with @--enable-tests@. +-- * Executes HLint static analysis under the zero-hint policy. +-- * Executes all unit, property, and integration test suites. +-- * Verifies comment density thresholds via @./bin/-cloc --check@. +-- * Executes the turnkey five-gate script: @./bin/-verify@. +-- +-- 2. __Resource-Constrained Community Runners ('TierLightweightStatic'):__ +-- Allocated to community GitLab instances (Framagit, Disroot: @.gitlab-ci.yml@), +-- Woodpecker CI (@.woodpecker.yml@), and Radicle local verification. +-- Executes fast, deterministic static analysis gates inside a minimal +-- container (@debian:bookworm-slim@) without GHC compilation: +-- * Installs lightweight utilities (curl, git, python3) and Tagref binary. +-- * Verifies Tagref cross-reference integrity (0 dangling references). +-- * Verifies Markdown link integrity and anchor slug resolution (0 broken links). +-- * Verifies in-code comment density thresholds (@bin/-cloc --check@). +-- * Finishes execution in < 15 seconds with < 100 MB memory footprint. +-- +-- This division guarantees that community infrastructure remains protected +-- from resource starvation while ensuring every repository maintains zero broken +-- links, zero dangling reference tags, and zero documentation drift on every commit. +-- +-- == Economic & Operational Invariants +-- +-- The forge-tiered CI matrix adheres to four non-negotiable operational rules: +-- +-- * __Purity & Determinism:__ CI configuration files are synthesized purely from +-- the project specification ('Project') and CI specification ('CISpec'). +-- No ambient environment variables, timestamps, or network requests are consulted. +-- +-- * __Zero Dangling Pointers:__ Every script reference within synthesized CI files +-- (such as @./bin/-verify@ or @./bin/-tagref@) resolves +-- to an executable script generated by the Gachi scaffolding engine. +-- +-- * __Cache Key Hermeticity:__ Cache keys on high-resource runners incorporate +-- cryptographic hashes of @cabal.project@ and all @**/*.cabal@ package files, +-- ensuring caches invalidate immediately upon dependency or compiler changes. +-- +-- * __Sandbox Isolation:__ High-resource runners execute sandboxed test harnesses +-- under Bubblewrap (@bwrap@). To prevent Ubuntu 24.04 AppArmor user namespace +-- restrictions from aborting builds, synthesized workflows explicitly configure +-- unprivileged user namespace allowances and AppArmor profiles. +-- +-- = Worked Example: High-Resource Workflow Generation +-- +-- >>> import Gachi.Schema.Project (defaultProject, Author(..)) +-- >>> import Gachi.Sync.CI +-- >>> let auth = Author "Nadia Yvette Chambers" "nadia.yvette.chambers@ik.me" +-- >>> let proj = defaultProject "gongju" auth +-- >>> let githubWf = generateGitHubWorkflow defaultGitHubSpec proj +-- >>> "cabal build all --enable-tests" `Data.Text.isInfixOf` githubWf +-- True +-- >>> "ubuntu-latest" `Data.Text.isInfixOf` githubWf +-- True +-- +-- = Worked Example: Lightweight Community Workflow Generation +-- +-- >>> let gitlabWf = generateGitLabWorkflow defaultGitLabSpec proj +-- >>> "debian:bookworm-slim" `Data.Text.isInfixOf` gitlabWf +-- True +-- >>> "./bin/gongju-tagref" `Data.Text.isInfixOf` gitlabWf +-- True +-- >>> "cabal build" `Data.Text.isInfixOf` gitlabWf +-- False +module Gachi.Sync.CI + ( -- * Forge and CI Tier Data Models + ForgeType(..) + , CITier(..) + , CISpec(..) + + -- * Pre-Configured Default Specifications + , defaultGitHubSpec + , defaultGitLabSpec + , defaultWoodpeckerSpec + , defaultForgejoSpec + , defaultRadicleSpec + , canonicalForgeSpecs + , forgeDefaultSpec + + -- * Predicates & Classification Helpers + , forgeName + , tierName + , isHighResource + , isLightweight + , classifyForge + , classifyTier + + -- * Deterministic Workflow Generators + , generateWorkflow + , generateGitHubWorkflow + , generateGitLabWorkflow + , generateWoodpeckerWorkflow + , generateForgejoWorkflow + , generateRadicleWorkflow + + -- * Matrix Synthesis Combinators + , forgeAssetForSpec + , synthesizeCIAssets + , canonicalCIAssets + ) where + +import Data.List (isPrefixOf) +import Data.Text (Text) +import qualified Data.Text as T +import GHC.Generics (Generic) + +import Gachi.Schema.Project (Project, projectName) +import Gachi.Sync.Types + ( AssetCategory(..) + , StandardAsset(..) + ) + +-------------------------------------------------------------------------------- +-- 1. Forge and CI Tier Data Models +-------------------------------------------------------------------------------- + +-- | Target hosting forge or CI engine platform. +-- +-- Distinguishes commercial clouds with abundant runner quotas from shared +-- community instances and sovereign peer-to-peer repositories. +-- +-- Architectural Roles: +-- * 'ForgeGitHub': Commercial cloud runners with 4+ vCPUs, 16 GB RAM, caching. +-- * 'ForgeGitLab': Community shared runners with strict memory and CPU limits. +-- * 'ForgeWoodpecker': Lightweight container pipelines for Forgejo / Codeberg. +-- * 'ForgeForgejo': Self-hosted Git server workflows using Docker runners. +-- * 'ForgeRadicle': Sovereign peer-to-peer identity verification prior to sync. +data ForgeType + = ForgeGitHub + -- ^ GitHub Actions (@.github/workflows/ci.yml@): Commercial high-capacity runners. + | ForgeGitLab + -- ^ GitLab CI (@.gitlab-ci.yml@): Community runners (Framagit, Disroot, gitlab.com). + | ForgeWoodpecker + -- ^ Woodpecker CI (@.woodpecker.yml@): Lightweight container pipelines for Forgejo/Gitea. + | ForgeForgejo + -- ^ Forgejo / Gitea Actions (@.forgejo/workflows/ci.yml@): Self-hosted Git server workflows. + | ForgeRadicle + -- ^ Radicle P2P (@.radicle/ci.yaml@): Local verification broker for sovereign peer nodes. + deriving stock (Eq, Show, Ord, Enum, Bounded, Generic) + +-- | Resource capability tier assigned to a CI workflow pipeline. +-- +-- Governs whether a forge executes the full heavyweight GHC build suite or +-- restricts execution to lightweight static verification gates. +-- +-- The allocation strategy guarantees that high-resource runners handle compiler +-- overhead while community runners remain responsive and protected from OOM errors. +data CITier + = TierHighResource + -- ^ Heavyweight execution: Full GHC compilation, test suites, Cabal store caching, + -- AppArmor namespace configuration, and complete physical verification script execution. + | TierLightweightStatic + -- ^ Lightweight execution: Fast static gates (Tagref, linkcheck, CLOC audit) + -- inside a slim container without GHC compiler toolchains (< 15 seconds runtime). + deriving stock (Eq, Show, Ord, Enum, Bounded, Generic) + +-- | Declarative specification governing continuous integration generation. +-- +-- Encapsulates the target platform, resource tier, filesystem workflow destination, +-- toolchain versions, container images, and test flags. +-- +-- All fields are pure and deterministic, permitting total reproducibility. +data CISpec = CISpec + { ciForge :: !ForgeType + -- ^ Target hosting forge or runner platform. + , ciTier :: !CITier + -- ^ Resource tier governing execution depth (high-resource vs lightweight). + , ciWorkflowPath :: !FilePath + -- ^ Relative workflow path in repository root (e.g. @".github/workflows/ci.yml"@). + , ciGhcVersion :: !Text + -- ^ Target GHC compiler version string (e.g. @"9.14.1"@). + , ciCabalVersion :: !Text + -- ^ Target Cabal specification version string (e.g. @"3.18.1.0"@). + , ciSystemDependencies :: ![Text] + -- ^ System apt packages required by high-resource builds (e.g. @["bubblewrap", "sqlite3", "z3"]@). + , ciContainerImage :: !Text + -- ^ Minimal container image for lightweight static runners (e.g. @"debian:bookworm-slim"@). + , ciEnableTests :: !Bool + -- ^ Whether to configure @--enable-tests@ during Cabal compilation. + , ciEnableDocCheck :: !Bool + -- ^ Whether to perform comment density and documentation verification. + } deriving stock (Eq, Show, Generic) + +-------------------------------------------------------------------------------- +-- 2. Pre-Configured Default Specifications +-------------------------------------------------------------------------------- + +-- | Canonical high-resource GitHub Actions specification. +-- +-- Configured for full physical verification on Ubuntu latest runners with +-- GHC 9.14.1, Cabal 3.18.1.0, system dependencies, and Cabal store caching. +-- +-- Key Properties: +-- * Platform: GitHub Actions (@.github/workflows/ci.yml@). +-- * Resource Tier: 'TierHighResource'. +-- * Compiler: GHC 9.14.1. +-- * Build Tool: Cabal 3.18.1.0. +-- * System Packages: @bubblewrap@, @sqlite3@, @z3@. +-- * Tests Enabled: 'True'. +-- * Doc Check Enabled: 'True'. +defaultGitHubSpec :: CISpec +defaultGitHubSpec = CISpec + { ciForge = ForgeGitHub + , ciTier = TierHighResource + , ciWorkflowPath = ".github/workflows/ci.yml" + , ciGhcVersion = "9.14.1" + , ciCabalVersion = "3.18.1.0" + , ciSystemDependencies = ["bubblewrap", "sqlite3", "z3"] + , ciContainerImage = "ubuntu-latest" + , ciEnableTests = True + , ciEnableDocCheck = True + } + +-- | Canonical lightweight GitLab CI specification for community runners. +-- +-- Configured for Framagit and Disroot using @debian:bookworm-slim@. +-- Runs Tagref, linkcheck, and CLOC audit in < 15 seconds without GHC. +-- +-- Key Properties: +-- * Platform: GitLab CI (@.gitlab-ci.yml@). +-- * Resource Tier: 'TierLightweightStatic'. +-- * Image: @debian:bookworm-slim@. +-- * System Packages: @curl@, @git@, @python3@. +-- * Tests Enabled: 'False' (avoids GHC compilation). +-- * Doc Check Enabled: 'True' (executes @bin/*-cloc --check@). +defaultGitLabSpec :: CISpec +defaultGitLabSpec = CISpec + { ciForge = ForgeGitLab + , ciTier = TierLightweightStatic + , ciWorkflowPath = ".gitlab-ci.yml" + , ciGhcVersion = "9.14.1" + , ciCabalVersion = "3.18.1.0" + , ciSystemDependencies = ["curl", "git", "python3"] + , ciContainerImage = "debian:bookworm-slim" + , ciEnableTests = False + , ciEnableDocCheck = True + } + +-- | Canonical lightweight Woodpecker CI specification. +-- +-- Used on self-hosted Woodpecker servers connected to Forgejo or Codeberg. +-- +-- Key Properties: +-- * Platform: Woodpecker CI (@.woodpecker.yml@). +-- * Resource Tier: 'TierLightweightStatic'. +-- * Image: @debian:bookworm-slim@. +-- * System Packages: @curl@, @git@, @python3@. +defaultWoodpeckerSpec :: CISpec +defaultWoodpeckerSpec = CISpec + { ciForge = ForgeWoodpecker + , ciTier = TierLightweightStatic + , ciWorkflowPath = ".woodpecker.yml" + , ciGhcVersion = "9.14.1" + , ciCabalVersion = "3.18.1.0" + , ciSystemDependencies = ["curl", "git", "python3"] + , ciContainerImage = "debian:bookworm-slim" + , ciEnableTests = False + , ciEnableDocCheck = True + } + +-- | Canonical Forgejo Actions specification. +-- +-- High-resource containerized pipeline for sovereign Forgejo instances. +-- +-- Key Properties: +-- * Platform: Forgejo Actions (@.forgejo/workflows/ci.yml@). +-- * Resource Tier: 'TierHighResource'. +-- * Compiler: GHC 9.14.1. +-- * Image: @node:20-bookworm@. +defaultForgejoSpec :: CISpec +defaultForgejoSpec = CISpec + { ciForge = ForgeForgejo + , ciTier = TierHighResource + , ciWorkflowPath = ".forgejo/workflows/ci.yml" + , ciGhcVersion = "9.14.1" + , ciCabalVersion = "3.18.1.0" + , ciSystemDependencies = ["bubblewrap", "sqlite3", "z3"] + , ciContainerImage = "node:20-bookworm" + , ciEnableTests = True + , ciEnableDocCheck = True + } + +-- | Canonical Radicle P2P local verification broker specification. +-- +-- Lightweight static check script invoked by Radicle node post-receive hooks. +-- +-- Key Properties: +-- * Platform: Radicle P2P (@.radicle/ci.yaml@). +-- * Resource Tier: 'TierLightweightStatic'. +-- * Verification Scope: Tagref, Linkcheck, Comment Density. +defaultRadicleSpec :: CISpec +defaultRadicleSpec = CISpec + { ciForge = ForgeRadicle + , ciTier = TierLightweightStatic + , ciWorkflowPath = ".radicle/ci.yaml" + , ciGhcVersion = "9.14.1" + , ciCabalVersion = "3.18.1.0" + , ciSystemDependencies = ["curl", "git", "python3"] + , ciContainerImage = "debian:bookworm-slim" + , ciEnableTests = False + , ciEnableDocCheck = True + } + +-- | List of authoritative CI specifications registered across standard ecosystem forges. +-- +-- Represents the default triad: +-- 1. GitHub Actions (Commercial High-Resource) +-- 2. GitLab CI (Community Lightweight Static) +-- 3. Woodpecker CI (Self-Hosted Lightweight Static) +canonicalForgeSpecs :: [CISpec] +canonicalForgeSpecs = + [ defaultGitHubSpec + , defaultGitLabSpec + , defaultWoodpeckerSpec + ] + +-- | Returns the canonical default 'CISpec' for a given 'ForgeType' and 'CITier'. +-- +-- Enables parameterized lookup when generating tailored workflows for custom targets. +forgeDefaultSpec :: ForgeType -> CITier -> CISpec +-- GitHub Actions: High resource (default) or lightweight override +forgeDefaultSpec ForgeGitHub TierHighResource = defaultGitHubSpec +forgeDefaultSpec ForgeGitHub TierLightweightStatic = + defaultGitHubSpec { ciTier = TierLightweightStatic, ciEnableTests = False } +-- GitLab CI: Lightweight static (default) or high resource container override +forgeDefaultSpec ForgeGitLab TierLightweightStatic = defaultGitLabSpec +forgeDefaultSpec ForgeGitLab TierHighResource = + defaultGitLabSpec { ciTier = TierHighResource, ciEnableTests = True, ciContainerImage = "haskell:9.14" } +-- Woodpecker CI: Lightweight static (default) or high resource container override +forgeDefaultSpec ForgeWoodpecker TierLightweightStatic = defaultWoodpeckerSpec +forgeDefaultSpec ForgeWoodpecker TierHighResource = + defaultWoodpeckerSpec { ciTier = TierHighResource, ciEnableTests = True, ciContainerImage = "haskell:9.14" } +-- Forgejo Actions: High resource (default) or lightweight static override +forgeDefaultSpec ForgeForgejo TierHighResource = defaultForgejoSpec +forgeDefaultSpec ForgeForgejo TierLightweightStatic = + defaultForgejoSpec { ciTier = TierLightweightStatic, ciEnableTests = False } +-- Radicle P2P: Sovereign static verification broker +forgeDefaultSpec ForgeRadicle _ = defaultRadicleSpec + +-------------------------------------------------------------------------------- +-- 3. Predicates & Classification Helpers +-------------------------------------------------------------------------------- + +-- | Human-readable name of a 'ForgeType'. +-- +-- Used in diagnostic banners and synchronization audit reports. +forgeName :: ForgeType -> Text +forgeName ForgeGitHub = "GitHub Actions" +forgeName ForgeGitLab = "GitLab CI (Framagit, Disroot)" +forgeName ForgeWoodpecker = "Woodpecker CI" +forgeName ForgeForgejo = "Forgejo Actions" +forgeName ForgeRadicle = "Radicle P2P CI" + +-- | Human-readable description of a 'CITier'. +-- +-- Highlights whether a pipeline executes heavyweight GHC verification or fast static gates. +tierName :: CITier -> Text +tierName TierHighResource = "High-Resource (Full Physical Verification)" +tierName TierLightweightStatic = "Lightweight (Static Gates Only)" + +-- | Predicate checking if a specification belongs to the high-resource tier. +isHighResource :: CISpec -> Bool +isHighResource spec = ciTier spec == TierHighResource + +-- | Predicate checking if a specification belongs to the lightweight tier. +isLightweight :: CISpec -> Bool +isLightweight spec = ciTier spec == TierLightweightStatic + +-- | Infers the 'ForgeType' from a workflow file path. +-- +-- Inspects standard file names and directories: +-- * @.github/workflows/*@ -> 'ForgeGitHub' +-- * @.gitlab-ci.yml@ -> 'ForgeGitLab' +-- * @.woodpecker.yml@ or @.woodpecker/*@ -> 'ForgeWoodpecker' +-- * @.forgejo/workflows/*@ -> 'ForgeForgejo' +-- * @.radicle/*@ -> 'ForgeRadicle' +-- +-- Returns 'Nothing' if the path does not match recognized CI conventions. +classifyForge :: FilePath -> Maybe ForgeType +classifyForge path + -- GitHub Actions workflow directory + | ".github/workflows/" `isPrefixOf` path = Just ForgeGitHub + -- GitLab CI configuration file in root + | path == ".gitlab-ci.yml" = Just ForgeGitLab + -- Woodpecker CI single file configuration + | path == ".woodpecker.yml" = Just ForgeWoodpecker + -- Woodpecker CI pipeline directory + | ".woodpecker/" `isPrefixOf` path = Just ForgeWoodpecker + -- Forgejo Actions workflow directory + | ".forgejo/" `isPrefixOf` path = Just ForgeForgejo + -- Radicle P2P CI verification directory + | ".radicle/" `isPrefixOf` path = Just ForgeRadicle + -- Unrecognized path + | otherwise = Nothing + +-- | Infers the expected 'CITier' from a standard workflow path. +-- +-- Recognizes high-resource vs lightweight tiers based on repository path conventions. +classifyTier :: FilePath -> Maybe CITier +classifyTier path + -- GitHub Actions executes full verification suite + | ".github/" `isPrefixOf` path = Just TierHighResource + -- GitLab CI community runners execute static gates only + | path == ".gitlab-ci.yml" = Just TierLightweightStatic + -- Woodpecker CI executes lightweight container steps + | path == ".woodpecker.yml" = Just TierLightweightStatic + -- Forgejo enterprise runners execute full suite + | ".forgejo/" `isPrefixOf` path = Just TierHighResource + -- Radicle local node broker executes static gates + | ".radicle/" `isPrefixOf` path = Just TierLightweightStatic + -- Unrecognized path + | otherwise = Nothing + +-------------------------------------------------------------------------------- +-- 4. Deterministic Workflow Generators +-------------------------------------------------------------------------------- + +-- | Pure dispatcher synthesizing the appropriate CI configuration text for a 'CISpec'. +-- +-- Evaluates the target forge platform and invokes the corresponding deterministic generator. +generateWorkflow :: CISpec -> Project -> Text +generateWorkflow spec proj = case ciForge spec of + ForgeGitHub -> generateGitHubWorkflow spec proj + ForgeGitLab -> generateGitLabWorkflow spec proj + ForgeWoodpecker -> generateWoodpeckerWorkflow spec proj + ForgeForgejo -> generateForgejoWorkflow spec proj + ForgeRadicle -> generateRadicleWorkflow spec proj + +-- | Generates GitHub Actions workflow configuration (@.github/workflows/ci.yml@). +-- +-- Implements the high-resource physical verification pipeline: +-- +-- 1. __Checkout Step:__ +-- Uses @actions/checkout@v4@ to clone the repository with full git history. +-- +-- 2. __Tagref Installation & Check:__ +-- Downloads the authoritative Tagref binary and executes @./bin/-tagref@ +-- to verify that zero dangling reference tags or duplicate tag definitions exist. +-- +-- 3. __Markdown Link & Anchor Gate:__ +-- Executes @./bin/-linkcheck@ to verify 100% of intra-corpus relative +-- links and section heading anchors across all markdown documentation files. +-- +-- 4. __System Dependencies & AppArmor Setup:__ +-- Installs system runtime libraries (@bubblewrap@, @sqlite3@, @z3@). +-- Configures unconfined AppArmor profile for Bubblewrap (@bwrap@) to enable +-- unprivileged user namespace creation on Ubuntu 24.04 runner environments. +-- +-- 5. __Git Submodule Protocol Rewriting:__ +-- Configures Git to rewrite @git@github.com:@ SSH URLs to HTTPS for clean submodule pulls. +-- +-- 6. __Haskell Toolchain Provisioning:__ +-- Invokes @haskell-actions/setup@v2@ with pinned GHC (9.14.1) and Cabal (3.18.1.0). +-- +-- 7. __HLint Static Analysis Installation:__ +-- Installs the recommended HLint binary via GHCup and runs under zero-hint cleanliness. +-- +-- 8. __Cryptographic Artifact Caching:__ +-- Invokes @actions/cache@v4@ caching @~/.cabal/store@ and @dist-newstyle@ keyed on +-- the combined cryptographic hash of @cabal.project@ and all @**/*.cabal@ manifests. +-- +-- 9. __Compilation & Test Build:__ +-- Executes @cabal build all --enable-tests@ compiling all workspace packages and test suites. +-- +-- 10. __Comment Density Audit:__ +-- Executes @./bin/-cloc --check@ enforcing documentation thresholds. +-- +-- 11. __Turnkey Verification Harness:__ +-- Executes @./bin/-verify@ ensuring all 5 physical gates pass in unison. +generateGitHubWorkflow :: CISpec -> Project -> Text +generateGitHubWorkflow spec proj = + let pName = projectName proj + ghcVer = ciGhcVersion spec + cabalVer = ciCabalVersion spec + deps = T.unwords (ciSystemDependencies spec) + in T.unlines + [ -- SPDX License identifier declaring legal terms + "# SPDX-License-Identifier: EUPL-1.2" + -- Canonical repository metadata comment + , "# Canonical GitHub Actions CI Workflow for " <> pName + -- Cross-reference pointer grounding the Note in the CI asset + , "# Note [Forge-Tiered CI Resource Allocation and Static Gate Partitioning] [ref:note-forge-tiered-ci]" + , "" + -- Top-level workflow descriptive name + , "name: CI Verification Harness" + , "" + -- Trigger definitions: executed on push and pull-request events targeting master + , "on:" + , " push:" + , " branches: [ master ]" + , " pull_request:" + , " branches: [ master ]" + , "" + -- Job definition block + , "jobs:" + , " verify:" + , " name: Tagref & Verification Gates" + -- Host runner operating system targeting Ubuntu LTS + , " runs-on: ubuntu-latest" + , " steps:" + -- Step 1: Check out git working tree + , " - name: Check out repository" + , " uses: actions/checkout@v4" + , "" + -- Step 2: Download and install Tagref cross-reference binary + , " - name: Install Tagref" + , " run: |" + , " mkdir -p \"${HOME}/.local/bin\"" + , " PREFIX=\"${HOME}/.local/bin\" curl https://raw.githubusercontent.com/stepchowfun/tagref/main/install.sh -LSfs | sh" + , " echo \"${HOME}/.local/bin\" >> $GITHUB_PATH" + , "" + -- Step 3: Run static Tagref verification gate + , " - name: Verify Tagref Cross-References" + , " run: ./bin/" <> pName <> "-tagref" + , "" + -- Step 4: Run intra-corpus Markdown hyperlink and heading anchor verification + , " - name: Verify Markdown Links & Anchors" + , " run: ./bin/" <> pName <> "-linkcheck" + , "" + -- Step 5: Install runtime system dependencies and configure AppArmor sandbox profiles + , " - name: Install System Dependencies" + , " run: |" + , " sudo apt-get update" + , " sudo apt-get install -y " <> deps + -- Disable Ubuntu 24.04 kernel restriction on unprivileged user namespaces + , " sudo sysctl -w kernel.apparmor_restrict_unprivileged_userns=0 2>/dev/null || true" + -- Create unconfined AppArmor profile for Bubblewrap if profile directory exists + , " if [ -d /etc/apparmor.d ]; then" + , " printf 'abi ,\\ninclude \\nprofile bwrap /usr/bin/bwrap flags=(unconfined) {\\n userns,\\n include if exists \\n}\\n' | sudo tee /etc/apparmor.d/bwrap >/dev/null || true" + , " sudo apparmor_parser -r /etc/apparmor.d/bwrap 2>/dev/null || true" + , " fi" + , "" + -- Step 6: Rewrite SSH Git submodule URLs to HTTPS to avoid unauthenticated SSH failures + , " - name: Configure Git for HTTPS submodules" + , " run: git config --global url.\"https://github.com/\".insteadOf \"git@github.com:\"" + , "" + -- Step 7: Configure pinned GHC and Cabal toolchain via official Haskell action + , " - name: Set up Haskell Toolchain" + , " uses: haskell-actions/setup@v2" + , " with:" + , " ghc-version: '" <> ghcVer <> "'" + , " cabal-version: '" <> cabalVer <> "'" + , "" + -- Step 8: Install HLint binary + , " - name: Install HLint" + , " run: |" + , " mkdir -p \"${HOME}/.local/bin\"" + , " if ! command -v hlint >/dev/null 2>&1; then" + , " curl -sSL https://github.com/ndmitchell/hlint/releases/download/v3.10/hlint-3.10-x86_64-linux.tar.gz | tar -xz -C \"${HOME}/.local\"" + , " ln -sf \"${HOME}/.local/hlint-3.10/hlint\" \"${HOME}/.local/bin/hlint\"" + , " fi" + , " echo \"${HOME}/.local/bin\" >> $GITHUB_PATH" + , "" + -- Step 9: Restore and save Cabal store caches keyed by project manifests + , " - name: Cache Cabal artifacts" + , " uses: actions/cache@v4" + , " with:" + , " path: |" + , " ~/.cabal/store" + , " dist-newstyle" + , " key: ${{ runner.os }}-cabal-${{ hashFiles('cabal.project', '**/*.cabal') }}" + , " restore-keys: |" + , " ${{ runner.os }}-cabal-" + , "" + -- Step 10: Compile all workspace packages and test harnesses + , " - name: Build All Packages & Dependencies" + , " run: cabal build all" <> (if ciEnableTests spec then " --enable-tests" else "") + , "" + -- Step 11: Execute documentation comment density audit + , " - name: Verify Comment Density Audit" + , " run: ./bin/" <> pName <> "-cloc --check" + , "" + -- Step 12: Run complete 5-gate physical verification harness + , " - name: Run Full Physical Verification Gates" + , " run: ./bin/" <> pName <> "-verify" + ] + +-- | Generates GitLab CI configuration (@.gitlab-ci.yml@). +-- +-- Tailored to protect resource-constrained community runners (Framagit, Disroot). +-- Runs fast static analysis gates inside @debian:bookworm-slim@ without GHC overhead. +-- +-- The pipeline executes in under 15 seconds, verifying Tagref cross-references, +-- Markdown links, and CLOC comment density while consuming negligible compute quota. +generateGitLabWorkflow :: CISpec -> Project -> Text +generateGitLabWorkflow spec proj = + let pName = projectName proj + cImage = ciContainerImage spec + in if ciTier spec == TierLightweightStatic + then T.unlines + [ -- SPDX license header + "# SPDX-License-Identifier: EUPL-1.2" + -- Target forge and provider documentation + , "# GitLab CI configuration for " <> pName <> " (Framagit, Disroot)" + -- Canonical Note reference + , "# Note [Forge-Tiered CI Resource Allocation and Static Gate Partitioning] [ref:note-forge-tiered-ci]" + , "" + -- Verification stage list + , "stages:" + , " - verify" + , "" + -- Static verification job definition + , "tagref-check:" + , " stage: verify" + -- Lean base container image + , " image: " <> cImage + -- Pre-flight script installing curl, git, python3, and Tagref + , " before_script:" + , " - apt-get update && apt-get install -y curl git python3" + , " - mkdir -p /usr/local/bin" + , " - PREFIX=/usr/local/bin curl https://raw.githubusercontent.com/stepchowfun/tagref/main/install.sh -LSfs | sh" + -- Static gate commands: Tagref, Linkcheck, and CLOC density check + , " script:" + , " - ./bin/" <> pName <> "-tagref" + , " - ./bin/" <> pName <> "-linkcheck" + , " - ./bin/" <> pName <> "-cloc --check" + ] + else T.unlines + [ -- SPDX license header + "# SPDX-License-Identifier: EUPL-1.2" + -- Target forge documentation + , "# High-Resource GitLab CI configuration for " <> pName + -- Canonical Note reference + , "# Note [Forge-Tiered CI Resource Allocation and Static Gate Partitioning] [ref:note-forge-tiered-ci]" + , "" + -- Stage definition + , "stages:" + , " - verify" + , "" + -- Full verification job definition + , "full-verify:" + , " stage: verify" + -- Haskell container image + , " image: " <> cImage + -- Pre-flight script installing system libraries and Tagref + , " before_script:" + , " - apt-get update && apt-get install -y curl git python3 bubblewrap sqlite3 z3" + , " - mkdir -p /usr/local/bin" + , " - PREFIX=/usr/local/bin curl https://raw.githubusercontent.com/stepchowfun/tagref/main/install.sh -LSfs | sh" + -- Full build and turnkey verification commands + , " script:" + , " - cabal build all --enable-tests" + , " - ./bin/" <> pName <> "-verify" + ] + +-- | Generates Woodpecker CI pipeline configuration (@.woodpecker.yml@). +-- +-- Used on lightweight, containerized Woodpecker agents attached to Forgejo. +-- +-- Executes the three lightweight static verification gates inside @debian:bookworm-slim@. +generateWoodpeckerWorkflow :: CISpec -> Project -> Text +generateWoodpeckerWorkflow spec proj = + let pName = projectName proj + cImage = ciContainerImage spec + in T.unlines + [ -- SPDX license header + "# SPDX-License-Identifier: EUPL-1.2" + -- Target forge documentation + , "# Woodpecker CI pipeline for " <> pName + -- Canonical Note reference + , "# Note [Forge-Tiered CI Resource Allocation and Static Gate Partitioning] [ref:note-forge-tiered-ci]" + , "" + -- Woodpecker pipeline root stanza + , "pipeline:" + , " static-verify:" + -- Container image specification + , " image: " <> cImage + -- Pipeline command sequence + , " commands:" + , " - apt-get update && apt-get install -y curl git python3" + , " - mkdir -p /usr/local/bin" + , " - PREFIX=/usr/local/bin curl https://raw.githubusercontent.com/stepchowfun/tagref/main/install.sh -LSfs | sh" + , " - ./bin/" <> pName <> "-tagref" + , " - ./bin/" <> pName <> "-linkcheck" + , " - ./bin/" <> pName <> "-cloc --check" + ] + +-- | Generates Forgejo Actions workflow configuration (@.forgejo/workflows/ci.yml@). +-- +-- Compatible with GitHub Actions workflow syntax for self-hosted runners. +-- +-- Executes containerized verification pipelines in sovereign forge deployments. +generateForgejoWorkflow :: CISpec -> Project -> Text +generateForgejoWorkflow = + -- Reuses GitHub Actions syntax engine with Forgejo specification + generateGitHubWorkflow + +-- | Generates Radicle P2P local verification broker configuration (@.radicle/ci.yaml@). +-- +-- Executed locally on peer developer nodes prior to peer-to-peer patch distribution. +-- +-- Ensures patches meet strict Tagref, linkcheck, and comment density standards before dissemination. +generateRadicleWorkflow :: CISpec -> Project -> Text +generateRadicleWorkflow _spec proj = + let pName = projectName proj + in T.unlines + [ -- SPDX license header + "# SPDX-License-Identifier: EUPL-1.2" + -- Radicle verification broker documentation + , "# Radicle P2P CI Verification Configuration for " <> pName + -- Canonical Note reference + , "# Note [Forge-Tiered CI Resource Allocation and Static Gate Partitioning] [ref:note-forge-tiered-ci]" + , "" + -- Radicle pipeline schema version + , "version: 1" + , "pipelines:" + , " - name: static-gates" + -- Event triggers: runs on branch pushes and patch publications + , " trigger: [ push, patch ]" + , " steps:" + -- Step 1: Run Tagref cross-reference verification + , " - name: Tagref" + , " command: ./bin/" <> pName <> "-tagref" + -- Step 2: Run Markdown link and anchor verification + , " - name: Linkcheck" + , " command: ./bin/" <> pName <> "-linkcheck" + -- Step 3: Run comment density audit + , " - name: CLOC" + , " command: ./bin/" <> pName <> "-cloc --check" + ] + +-------------------------------------------------------------------------------- +-- 5. Matrix Synthesis Combinators +-------------------------------------------------------------------------------- + +-- | Converts a 'CISpec' into a canonical 'StandardAsset' in 'CategoryCIWorkflow'. +-- +-- Sets requirement flags: +-- * GitHub (@.github/workflows/ci.yml@) and GitLab (@.gitlab-ci.yml@) are mandatory ('assetRequired' = True). +-- * Ancillary forges (Woodpecker, Forgejo, Radicle) are optional ('assetRequired' = False). +forgeAssetForSpec :: CISpec -> StandardAsset +forgeAssetForSpec spec = + let path = ciWorkflowPath spec + -- Mandatory assets enforced across every ecosystem repository + isReq = path `elem` [".github/workflows/ci.yml", ".gitlab-ci.yml"] + -- Human-readable asset description + desc = case ciForge spec of + ForgeGitHub -> "High-resource GitHub Actions workflow running complete physical gates" + ForgeGitLab -> "Lightweight GitLab CI workflow for resource-constrained community forges" + ForgeWoodpecker -> "Lightweight Woodpecker CI workflow for Forgejo/Gitea runners" + ForgeForgejo -> "Self-hosted Forgejo Actions workflow running containerized verification" + ForgeRadicle -> "Radicle sovereign peer-to-peer verification pipeline" + in StandardAsset + { assetPath = path + , assetCategory = CategoryCIWorkflow + , assetRequired = isReq + , assetExecutable = False + , assetDescription = desc + , assetGenerator = generateWorkflow spec + } + +-- | Synthesizes a list of 'StandardAsset' records from a collection of 'CISpec' configurations. +-- +-- Maps each specification into a standard matrix asset ready for auditing and propagation. +synthesizeCIAssets :: [CISpec] -> [StandardAsset] +synthesizeCIAssets = map forgeAssetForSpec + +-- | The canonical list of standard CI workflow assets registered across all ecosystem checkouts. +-- +-- Encompasses GitHub Actions, GitLab CI, and Woodpecker CI pipelines. +canonicalCIAssets :: [StandardAsset] +canonicalCIAssets = synthesizeCIAssets canonicalForgeSpecs diff --git a/src/Gachi/Sync/Catalog.hs b/src/Gachi/Sync/Catalog.hs new file mode 100644 --- /dev/null +++ b/src/Gachi/Sync/Catalog.hs @@ -0,0 +1,355 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Module: Gachi.Sync.Catalog +-- Description: Canonical shared asset catalog for cross-repository synchronization +-- +-- This module implements pure, deterministic template generators for shared +-- ecosystem assets conforming to the Standardization Matrix (~/src/PLAN.md §1.A). +-- +-- = Architectural Context & Invariants +-- +-- In accordance with Note [Ecosystem Standardization Invariants] +-- [ref:note-ecosystem-standardization], all checkouts in ~/src/* maintain +-- bit-identical formatting profiles, zero-hint linter policies, Git hooks, +-- forge-tiered CI configurations, and AI agent advisory context. +-- +-- == Invariant: Deterministic Configuration Synthesis +-- +-- Configuration drift is the primary vector for friction in multi-package and +-- multi-repository ecosystems. When different repositories maintain slightly +-- divergent formatting configurations or compiler warning levels: +-- +-- 1. __Diff Noise:__ Cross-cutting refactors touching multiple repositories +-- produce massive cosmetic diffs caused by differing indentation, import +-- sorting rules, or column limits. +-- 2. __Toolchain Inconsistencies:__ A code pattern accepted by one repository's +-- linter or compiler invocation triggers fatal warnings in another. +-- 3. __Agent Cognitive Overhead:__ AI assistants waste context tokens discovering +-- local quirks rather than focusing on domain-specific logic. +-- +-- This catalog resolves configuration drift by providing an authoritative, +-- single-source-of-truth implementation for all shared configuration assets. +-- All functions in this module are referentially transparent, total, and free of +-- ambient I/O side effects: they evaluate strictly from a 'Project' specification +-- to 'Text' (or are constant 'Text' stanzas). +-- +-- = When to Use This Module +-- +-- * Inspecting canonical configuration stanzas during repository audits ('Gachi.Sync.Audit'). +-- * Synchronizing shared infrastructure files across ecosystem checkouts ('gachi sync'). +-- * Initializing new repositories with turnkey toolchain stanzas ('gachi init'). +-- +-- = Worked Example +-- +-- >>> import Gachi.Schema.Project (defaultProject, Author(..)) +-- >>> import Gachi.Sync.Catalog +-- >>> let proj = defaultProject "gongju" (Author "Nadia" "nadia@example.com") +-- >>> "indentation: 2" `Data.Text.isInfixOf` fourmoluTemplate +-- True +-- >>> "./bin/gongju-verify" `Data.Text.isInfixOf` githubCiTemplate proj +-- True +module Gachi.Sync.Catalog + ( -- * Code Formatting Profiles (Dimension 2) + fourmoluTemplate + , rustfmtTemplate + , clangFormatTemplate + + -- * Static Analysis & Linters (Dimension 3) + , hlintTemplate + + -- * Build System Conventions (Dimension 4) + , cabalProjectTemplate + , cabalProjectLocalTemplate + + -- * Git Governance & Hooks (Dimension 5) + , gitmessageTemplate + , tagrefConfigTemplate + , commitMsgHookTemplate + , preCommitHookTemplate + + -- * Forge-Tiered CI Workflows (Dimension 7) + , githubCiTemplate + , gitlabCiTemplate + , woodpeckerCiTemplate + + -- * Agent Advisory & Rules (Dimension 9) + , agentsTemplate + , claudeTemplate + , commitAttributionRuleTemplate + , codeNavigationRuleTemplate + , compilerVerificationRuleTemplate + , documentationPrecedenceRuleTemplate + + -- * Physical Verification Harnesses + , verifyScriptTemplate + , tagrefScriptTemplate + , linkcheckScriptTemplate + , clocScriptTemplate + , generateTagsTemplate + ) where + +import Data.Text (Text) +import qualified Data.Text as T + +import Gachi.Schema.Project (Project) +import Gachi.Sync.CI + ( defaultGitHubSpec + , defaultGitLabSpec + , defaultWoodpeckerSpec + , generateGitHubWorkflow + , generateGitLabWorkflow + , generateWoodpeckerWorkflow + ) +import Gachi.Scaffold.Templates + ( agentsTemplate + , cabalProjectLocalTemplate + , cabalProjectTemplate + , claudeTemplate + , clocScriptTemplate + , commitMsgHookTemplate + , generateTagsTemplate + , gitmessageTemplate + , hlintTemplate + , linkcheckScriptTemplate + , preCommitHookTemplate + , tagrefConfigTemplate + , tagrefScriptTemplate + , verifyScriptTemplate + ) + +-------------------------------------------------------------------------------- +-- 1. Code Formatting Profiles (Dimension 2) +-------------------------------------------------------------------------------- + +-- | Canonical Fourmolu configuration enforcing deterministic, AST-preserving Haskell layout. +-- +-- == Formatting Invariants & Design Decisions +-- +-- * __Indentation:__ Fixed 2-space indentation depth across all syntactic forms. +-- * __Column Limit:__ Pinned to 100 characters, striking a balance between wide-screen +-- readability and side-by-side terminal diffing. +-- * __Function Arrows:__ Trailing arrows (@->@ at the end of lines) preserving +-- visual alignment in multi-argument type signatures. +-- * __Comma Style:__ Leading commas in multi-line export lists, record updates, +-- and tuple literals to minimize git diff noise during item additions. +-- * __Record Style:__ Aligned record field declarations ensuring vertical alignment +-- of field names, colons, and types. +-- * __Custom Infix Fixities:__ Registers custom row-polymorphism operator fixities +-- (@:=@, @.==@, @.#@) used throughout the polytropos engine to prevent Fourmolu +-- from breaking natural mathematical expression grouping. +fourmoluTemplate :: Text +fourmoluTemplate = T.unlines + [ "# Fourmolu configuration for standardized ecosystem Haskell repositories" + , "# Enforces AST-preserving layout for open row lists, record syntax, and operator fixities." + , "" + , "indentation: 2" + , "column-limit: 100" + , "function-arrows: trailing" + , "comma-style: leading" + , "record-style: aligned" + , "import-export-style: diff-friendly" + , "import-grouping: legacy" + , "indent-wheres: true" + , "record-brace-space: true" + , "newlines-between-decls: 1" + , "haddock-style: multi-line" + , "let-style: auto" + , "in-style: right-align" + , "if-style: indented" + , "single-constraint-parens: never" + , "single-deriving-parens: always" + , "sort-constraints: false" + , "sort-derived-classes: false" + , "sort-deriving-clauses: false" + , "trailing-section-operators: true" + , "unicode: never" + , "respectful: true" + , "" + , "fixities:" + , " - \"infixr 5 :=\"" + , " - \"infixr 5 .==\"" + , " - \"infixl 8 .#\"" + ] + +-- | Canonical rustfmt configuration for polyglot Rust components (e.g. asterinas, surd). +-- +-- == Polyglot Formatting Invariants +-- +-- * __Line Width:__ Pinned to 100 characters to match Haskell and C/C++ limits. +-- * __Tab Spaces:__ 4-space tab indentation conforming to standard Rust idioms. +-- * __Edition:__ Edition 2021/2024 idioms with modern closure and macro formatting. +-- * __Import Sorting:__ Deterministic lexicographical reordering of @use@ stanzas. +-- * __Module Reordering:__ Canonical module declaration ordering. +rustfmtTemplate :: Text +rustfmtTemplate = T.unlines + [ "# rustfmt.toml — Ecosystem formatting conventions for Rust components" + , "max_width = 100" + , "tab_spaces = 4" + , "edition = \"2021\"" + , "newline_style = \"Unix\"" + , "use_small_heuristics = \"Default\"" + , "reorder_imports = true" + , "reorder_modules = true" + ] + +-- | Canonical .clang-format configuration based on Linux kernel and LLVM style. +-- +-- == Low-Level Systems Code Formatting +-- +-- Applied to C, C++, and CUDA components across low-level operating system trees: +-- * __Style Base:__ Derived from LLVM standard style. +-- * __Indentation:__ 4 spaces with tabs strictly forbidden. +-- * __Brace Placement:__ Attached braces preserving vertical density. +-- * __Include Sorting:__ Deterministic alphabetical sorting of header @#include@ directives. +clangFormatTemplate :: Text +clangFormatTemplate = T.unlines + [ "# .clang-format — Ecosystem formatting conventions for C/C++ components" + , "BasedOnStyle: LLVM" + , "IndentWidth: 4" + , "ColumnLimit: 100" + , "UseTab: Never" + , "BreakBeforeBraces: Attach" + , "AllowShortFunctionsOnASingleLine: Inline" + , "SortIncludes: true" + ] + +-------------------------------------------------------------------------------- +-- 2. Forge-Tiered CI Workflows (Dimension 7) +-------------------------------------------------------------------------------- + +-- | GitHub Actions CI workflow for high-resource runners. +-- +-- == Asymmetric CI Resource Strategy +-- +-- In accordance with Note [Forge-Tiered CI Resource Allocation and Static Gate Partitioning] +-- [ref:note-forge-tiered-ci], commercial forges like GitHub provide high-capacity +-- container runners with ample RAM, multi-core virtual CPUs, and generous monthly +-- allowances. This template evaluates 'generateGitHubWorkflow' using 'defaultGitHubSpec', +-- compiling all packages under GHC 9.14.1 with @--enable-tests@ and running all 5 physical gates. +githubCiTemplate :: Project -> Text +githubCiTemplate = generateGitHubWorkflow defaultGitHubSpec + +-- | GitLab CI configuration tailored for resource-constrained community runners. +-- +-- == Community Forge Resource Preservation +-- +-- Community forges (Framagit, Disroot, etc.) operate on shared infrastructure with +-- limited shared runner compute time and strict memory quotas. Running full GHC +-- compilation on every push would deplete shared runner quotas. +-- +-- Per Note [Forge-Tiered CI Resource Allocation and Static Gate Partitioning] +-- [ref:note-forge-tiered-ci], this configuration establishes an asymmetric, +-- lightweight verification pipeline inside @debian:bookworm-slim@: +-- * Executes fast static verification gates (Tagref cross-references and Markdown link check). +-- * Runs the lightweight CLOC comment density audit. +-- * Completely bypasses heavy GHC compilation and link stages, finishing in < 15 seconds. +gitlabCiTemplate :: Project -> Text +gitlabCiTemplate = generateGitLabWorkflow defaultGitLabSpec + +-- | Woodpecker CI pipeline configuration for lightweight self-hosted runners. +-- +-- == Self-Hosted Container Pipeline +-- +-- Generates @.woodpecker.yml@ tailored for Forgejo or Codeberg runners. +-- Executes Tagref, Markdown linkcheck, and CLOC audit inside @debian:bookworm-slim@. +-- +-- See Note [Forge-Tiered CI Resource Allocation and Static Gate Partitioning] +-- [ref:note-forge-tiered-ci]. +woodpeckerCiTemplate :: Project -> Text +woodpeckerCiTemplate = generateWoodpeckerWorkflow defaultWoodpeckerSpec + +-------------------------------------------------------------------------------- +-- 3. Modular Agent Advisory Rules (Dimension 9) +-------------------------------------------------------------------------------- + +-- | Rule: Linux kernel RFC 2822 trailer format ('Assisted-by:') and DCO boundaries. +-- +-- Establishes the non-negotiable legal and provenance boundary for AI contributions: +-- * __Attribution Format:__ Uses @Assisted-by: Tool (Provider / Model)@ git trailers. +-- * __DCO Invariant:__ AI agents NEVER sign off on Developer Certificate of Origin (@Signed-off-by:@) +-- or claim legal co-authorship (@Co-authored-by:@). +commitAttributionRuleTemplate :: Text +commitAttributionRuleTemplate = T.unlines + [ "" + , "# Commit Authoring & AI Attribution Rules" + , "" + , "**Status:** ACTIVE RULE · Bounded Context Extension" + , "**Enforcement:** `.githooks/commit-msg` · `.gitmessage`" + , "" + , "## 1. Linux Kernel RFC 2822 Trailer Schema" + , "" + , "AI coding assistant attribution must strictly use RFC 2822 trailer format:" + , "" + , "1. `Assisted-by:` (Required when AI assisted):" + , " - Format: `Assisted-by: ( / )` or bare `Assisted-by: `" + , "2. `Orchestrated-by:` (Optional when an orchestration framework directed the task):" + , " - Format: `Orchestrated-by: `" + , "" + , "## 2. Legal Boundary: The Developer Certificate of Origin" + , "" + , "- NEVER use `Co-authored-by:` or `Co-developed-by:` for AI assistants." + , "- NEVER add `Signed-off-by:` on an AI's behalf." + ] + +-- | Rule: Token-saving code navigation funnel (tags, ripgrep, ast-grep, slicing). +-- +-- Guides AI agents to conserve context window tokens through hierarchical exploration: +-- 1. Symbol jump via generated @./tags@ (cheapest token cost). +-- 2. Precision line slicing via @view_file@ with @StartLine@ and @EndLine@. +-- 3. Avoid indiscriminate full-file views that exhaust context budgets. +codeNavigationRuleTemplate :: Text +codeNavigationRuleTemplate = T.unlines + [ "" + , "# Token-Saving Code Navigation Funnel" + , "" + , "**Status:** ACTIVE RULE · Bounded Context Extension" + , "" + , "Always follow the token-conservation funnel when exploring code:" + , "1. `./tags` symbol jump via ripgrep/grep (cheapest token cost)." + , "2. Targeted file slice viewing (view_file with StartLine/EndLine)." + , "3. Avoid full-file reading when symbol lookups suffice." + ] + +-- | Rule: Zero-log compiler verification and zero-contamination policy. +-- +-- Mandates complete mechanical verification before every commit: +-- * Zero warnings tolerated under @-Wall -Wcompat -Wredundant-constraints@. +-- * All five physical verification gates (@./bin/-verify@) must pass cleanly. +-- * Strict prohibition against unverified code commits or broken tests. +compilerVerificationRuleTemplate :: Text +compilerVerificationRuleTemplate = T.unlines + [ "" + , "# Compiler Verification & Zero-Contamination Rules" + , "" + , "**Status:** ACTIVE RULE · Bounded Context Extension" + , "" + , "- Zero warnings tolerated under `-Wall -Wcompat -Wredundant-constraints`." + , "- All 5 physical verification gates (`./bin/-verify`) must pass." + , "- Never commit broken builds, failing tests, or unverified changes." + ] + +-- | Rule: Precedence rule and the two-file operational loop. +-- +-- Specifies the relationship between code, documentation, and session state: +-- * __Precedence:__ Code wins at runtime; notes corrected regardless. +-- * __Two-File Loop:__ Always update @PLAN.md@ and @STATE.md@ before concluding sessions. +-- * __Design Canonicity:__ Design documents are load-bearing engineering artifacts. +documentationPrecedenceRuleTemplate :: Text +documentationPrecedenceRuleTemplate = T.unlines + [ "" + , "# Documentation Precedence & Operational Loop" + , "" + , "**Status:** ACTIVE RULE · Bounded Context Extension" + , "" + , "1. Precedence rule: Code wins at runtime; notes corrected regardless." + , "2. Two-file loop: Always update `PLAN.md` and `STATE.md` before concluding sessions." + , "3. Design documents are load-bearing; keep anchors and references synchronized." + ] diff --git a/src/Gachi/Sync/Engine.hs b/src/Gachi/Sync/Engine.hs new file mode 100644 --- /dev/null +++ b/src/Gachi/Sync/Engine.hs @@ -0,0 +1,643 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Module: Gachi.Sync.Engine +-- Description: Harmonic chattering synchronization and differential propagation engine +-- +-- This module implements the core propagation engine of @gachi sync@. It evaluates +-- differential changes across ecosystem checkouts against the canonical Standardization +-- Matrix (~/src/PLAN.md §1.A), computes atomic synchronization plans, applies non-destructive +-- updates to missing or drifted files, and guarantees mathematical idempotency. +-- +-- = Architectural Context & Invariants +-- +-- In accordance with Note [Ecosystem Standardization Invariants] +-- [ref:note-ecosystem-standardization], Note [Cross-Repository Standardization Matrix and Audit Semantics] +-- [ref:note-standardization-matrix], and Note [Harmonic Chattering Synchronization and Differential Propagation] +-- [ref:note-harmonic-sync], this module is the operational engine that transforms +-- observational audit findings into safe, automated filesystem repairs. +-- +-- = Note [Harmonic Chattering Synchronization and Differential Propagation] +-- [tag:note-harmonic-sync] +-- +-- In the mythos of Gachi, the *gashadokuro* phantom is assembled from the scattered +-- bones of those fallen across many battles. When the phantom awakens, its collected +-- teeth chatter and click (*gachi-gachi*) in eerie unison—a resonant harmonic rhythm +-- that coordinates the entire skeletal body without centralized nervous signaling. +-- +-- In modern software engineering, multi-repository architectures suffer from structural +-- desynchronization: improvements made to one repository's formatting profile (Fourmolu), +-- compiler warning flags, Git commit hooks, or AI agent guidance fail to propagate to +-- sibling repositories. Over time, repositories drift into incompatible silos. +-- +-- The Harmonic Chattering Synchronization engine resolves this through three core principles: +-- +-- 1. __Observational Planning Before Mutation:__ +-- Before modifying a single byte on disk, the engine computes a 'SyncPlan' +-- classifying every standardized asset into an explicit 'SyncAction': +-- * 'ActionCreate': The file is absent; it must be materialized with correct permissions. +-- * 'ActionUpdate': The file exists, but its content diverges from canonical generators. +-- * 'ActionChmod': The content matches, but its POSIX executable permissions differ. +-- * 'ActionNoOp': The file is already compliant; zero disk I/O is performed. +-- +-- 2. __Strict Mathematical Idempotency:__ +-- The synchronization function is mathematically idempotent: +-- \[ +-- \text{sync}(\text{sync}(W)) = \text{sync}(W) +-- \] +-- Executing @gachi sync@ once repairs all discrepancies. Executing @gachi sync@ +-- immediately afterward produces an empty change set (0 creates, 0 updates, 0 chmods). +-- +-- 3. __Non-Destructive Safety & Dry-Run Preview:__ +-- The engine supports 'DryRun' mode, enabling developers and CI harnesses to inspect +-- all planned filesystem modifications and unified diffs before applying changes. +-- +-- 4. __Multi-Repository Ecosystem Orchestration:__ +-- Through 'discoverEcosystemRepositories' and 'syncEcosystem', a single command +-- can harmonize all checkouts across @~/src/*@ in lockstep. +-- +-- = Worked Example +-- +-- >>> import Gachi.Schema.Project (defaultProject, Author(..)) +-- >>> import Gachi.Sync.Matrix (canonicalMatrix) +-- >>> let proj = defaultProject "gachi" (Author "Nadia" "nadia@example.com") +-- >>> plan <- computeSyncPlan "/home/nyc/src/gachi" proj canonicalMatrix +-- >>> planProjectName plan +-- "gachi" +module Gachi.Sync.Engine + ( -- * Synchronization Execution Modes + SyncMode(..) + + -- * Synchronization Action Models + , SyncAction(..) + , isNoOpAction + , isMutatingAction + + -- * Synchronization Planning + , SyncPlan(..) + , isPlanClean + , computeSyncPlan + + -- * Synchronization Execution + , SyncResult(..) + , executeSyncPlan + , syncRepository + , syncRepositoryQuick + + -- * Multi-Repository Ecosystem Orchestration + , discoverEcosystemRepositories + , syncEcosystem + + -- * Diagnostic Plan & Result Formatting + , formatSyncPlan + , formatSyncResult + ) where + +import Control.Exception (SomeException, catch, displayException) +import Control.Monad (forM, when) +import Data.Maybe (catMaybes) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import System.Directory + ( canonicalizePath + , createDirectoryIfMissing + , doesDirectoryExist + , doesFileExist + , executable + , getPermissions + , listDirectory + , setOwnerExecutable + , setPermissions + ) +import System.FilePath (takeDirectory, takeFileName, ()) + +import Gachi.Schema.Dhall (decodeProjectFile) +import Gachi.Schema.Project (Author(..), Project, defaultProject, projectName) +import Gachi.Sync.Hash (sha256Text) +import Gachi.Sync.Matrix (canonicalMatrix) +import Gachi.Sync.Types + ( StandardAsset(..) + , StandardizationMatrix(..) + , SyncMode(..) + , resolveAssetPath + ) + +-------------------------------------------------------------------------------- +-- 1. Synchronization Modes & Actions +-------------------------------------------------------------------------------- + +-- | Explicit atomic action planned for an individual standardized asset. +-- +-- Represents the fine-grained decision made for a single asset during the evaluation +-- phase of 'computeSyncPlan'. Every standardized asset maps to exactly one action. +data SyncAction + = ActionCreate !FilePath !Text !Bool + -- ^ The asset is completely absent on disk. + -- Parameters: + -- 1. Relative destination file path (e.g. @"fourmolu.yaml"@ or @"bin/gachi-verify"@). + -- 2. Complete canonical text content produced by the asset generator. + -- 3. Boolean flag indicating whether POSIX owner executable bit (+x) must be set. + | ActionUpdate !FilePath !Text !Text !Bool + -- ^ The asset exists on disk, but its SHA-256 checksum diverges from the generator. + -- Parameters: + -- 1. Relative destination file path. + -- 2. Pre-existing file content currently residing on disk. + -- 3. Canonical replacement content produced by the asset generator. + -- 4. Target POSIX owner executable bit requirement. + | ActionChmod !FilePath !Bool !Bool + -- ^ The asset content is bit-identical, but its POSIX executable bit differs. + -- Parameters: + -- 1. Relative destination file path. + -- 2. Current executable permission detected on disk. + -- 3. Target executable permission required by the asset specification. + | ActionNoOp !FilePath + -- ^ The asset is fully compliant: exists, matches SHA-256 hash, and has correct permissions. + -- Parameters: + -- 1. Relative destination file path. + | ActionError !FilePath !Text + -- ^ An unexpected filesystem I/O exception occurred during inspection. + -- Parameters: + -- 1. Relative destination file path where inspection failed. + -- 2. Human-readable diagnostic description of the caught exception. + deriving stock (Eq, Show) + +-- | Returns 'True' if the action represents an already-compliant asset requiring no changes. +-- +-- No-op actions imply that the file on disk is bit-identical and has conforming permissions. +isNoOpAction :: SyncAction -> Bool +isNoOpAction (ActionNoOp _) = True +isNoOpAction _ = False + +-- | Returns 'True' if the action would modify the filesystem (create, update, or chmod). +-- +-- Mutating actions are executed during 'ApplySync' and simulated during 'DryRun'. +isMutatingAction :: SyncAction -> Bool +isMutatingAction ActionCreate {} = True +isMutatingAction ActionUpdate {} = True +isMutatingAction ActionChmod {} = True +isMutatingAction _ = False + +-------------------------------------------------------------------------------- +-- 2. Synchronization Planning +-------------------------------------------------------------------------------- + +-- | Comprehensive pre-mutation plan detailing all actions required across a repository. +-- +-- The 'SyncPlan' represents the pure evaluation outcome of comparing a repository's +-- on-disk state against the canonical 'StandardizationMatrix'. It serves as an immutable, +-- inspectable specification of all proposed mutations prior to disk execution. +-- +-- === Structural Invariants +-- +-- 1. __Completeness:__ Exactly one 'SyncAction' exists for every asset declared in +-- the input 'StandardizationMatrix'. No assets are skipped or duplicated. +-- 2. __Partitioning:__ The action counts ('planCreatedCount', 'planUpdatedCount', +-- 'planChmodCount', 'planNoOpCount') sum to the total length of 'planActions'. +-- 3. __Cleanliness Predicate:__ 'isPlanClean' holds if and only if no mutating +-- actions are scheduled (i.e. created, updated, and chmod counts are all 0). +data SyncPlan = SyncPlan + { planTargetDir :: !FilePath + -- ^ Target repository workspace path. + , planProjectName :: !Text + -- ^ Name of the target project being synchronized. + , planActions :: ![SyncAction] + -- ^ Complete list of planned per-asset actions. + , planCreatedCount :: !Int + -- ^ Number of missing files planned for creation. + , planUpdatedCount :: !Int + -- ^ Number of drifted files planned for content update. + , planChmodCount :: !Int + -- ^ Number of files requiring permission correction. + , planNoOpCount :: !Int + -- ^ Number of files already compliant. + } deriving stock (Eq, Show) + +-- | Checks whether a plan requires zero mutations (all assets compliant). +-- +-- Returns 'True' when a repository is in perfect resonance with the standardization +-- matrix, meaning no files need to be created, updated, or chmodded. +isPlanClean :: SyncPlan -> Bool +isPlanClean plan = + planCreatedCount plan == 0 + && planUpdatedCount plan == 0 + && planChmodCount plan == 0 + +-- | Computes a 'SyncPlan' for a target repository without modifying any files. +-- +-- Evaluates each asset registered in the 'StandardizationMatrix', compares current +-- disk state with expected generator output, and categorizes required actions. +-- +-- === Four-Phase Differential Inspection Pipeline +-- +-- For each asset in the matrix, the planning algorithm executes the following +-- deterministic decision procedure: +-- +-- 1. __Path Resolution:__ +-- Resolves parameterized path tokens (@:name:@, @:project:@) against the target +-- 'Project' specification via 'resolveAssetPath'. +-- +-- 2. __Existence Inspection:__ +-- Checks whether the target file exists on disk via 'doesFileExist'. +-- If absent, plans 'ActionCreate' containing the generator's expected output +-- and executable flag requirement. +-- +-- 3. __Cryptographic Differential Scanning:__ +-- If present, reads the file strictly and computes SHA-256 digests of both the +-- disk content and the generator output. +-- * If the hashes diverge, plans 'ActionUpdate' preserving the existing content +-- for diff generation and supplying the canonical replacement content. +-- +-- 4. __POSIX Mode Verification:__ +-- If the hashes match bit-for-bit, inspects the file's owner executable bit via +-- 'getPermissions'. +-- * If the executable permission disagrees with 'assetExecutable', plans 'ActionChmod'. +-- * If permissions match, plans 'ActionNoOp', indicating clean compliance. +-- +-- === Worked Example +-- +-- >>> import Gachi.Schema.Project (defaultProject, Author(..)) +-- >>> import Gachi.Sync.Matrix (canonicalMatrix) +-- >>> let proj = defaultProject "gachi" (Author "Nadia" "nadia@example.com") +-- >>> plan <- computeSyncPlan "/home/nyc/src/gachi" proj canonicalMatrix +-- >>> planNoOpCount plan > 0 +-- True +computeSyncPlan :: FilePath -> Project -> StandardizationMatrix -> IO SyncPlan +computeSyncPlan repoRoot proj matrix = do + actions <- forM (matrixAssets matrix) $ \asset -> do + let relPath = resolveAssetPath proj asset + absPath = repoRoot relPath + exists <- doesFileExist absPath + if not exists + then + let expectedContent = assetGenerator asset proj + execBit = assetExecutable asset + in pure (ActionCreate relPath expectedContent execBit) + else (do + actualContent <- TIO.readFile absPath + let expectedContent = assetGenerator asset proj + execBit = assetExecutable asset + if actualContent /= expectedContent + then pure (ActionUpdate relPath actualContent expectedContent execBit) + else do + perms <- getPermissions absPath + let actualExec = executable perms + if actualExec /= execBit + then pure (ActionChmod relPath actualExec execBit) + else pure (ActionNoOp relPath) + ) `catch` (\(e :: SomeException) -> + pure (ActionError relPath (T.pack (displayException e)))) + + let creates = length [() | ActionCreate {} <- actions] + updates = length [() | ActionUpdate {} <- actions] + chmods = length [() | ActionChmod {} <- actions] + noops = length [() | ActionNoOp _ <- actions] + + pure SyncPlan + { planTargetDir = repoRoot + , planProjectName = projectName proj + , planActions = actions + , planCreatedCount = creates + , planUpdatedCount = updates + , planChmodCount = chmods + , planNoOpCount = noops + } + +-------------------------------------------------------------------------------- +-- 3. Synchronization Execution +-------------------------------------------------------------------------------- + +-- | Result summary produced by executing a 'SyncPlan'. +data SyncResult = SyncResult + { resultTargetDir :: !FilePath + -- ^ Target repository path. + , resultProjectName :: !Text + -- ^ Name of the synchronized project. + , resultMode :: !SyncMode + -- ^ Mode under which synchronization executed ('DryRun' or 'ApplySync'). + , resultCreated :: ![FilePath] + -- ^ List of file paths created. + , resultUpdated :: ![FilePath] + -- ^ List of file paths updated. + , resultChmodded :: ![FilePath] + -- ^ List of file paths whose permissions were corrected. + , resultUnchanged :: ![FilePath] + -- ^ List of file paths left untouched. + , resultErrors :: ![(FilePath, Text)] + -- ^ List of errors encountered during execution. + , resultSuccess :: !Bool + -- ^ Whether all actions executed without error. + } deriving stock (Eq, Show) + +-- | Executes a computed 'SyncPlan' under the specified 'SyncMode'. +-- +-- === Operational Modes & Safety Invariants +-- +-- * __'DryRun' Mode:__ +-- Evaluates all actions declared in the plan, extracts summary statistics, and +-- constructs a 'SyncResult' representing the planned mutations without performing +-- any filesystem writes or permission modifications. +-- +-- * __'ApplySync' Mode:__ +-- Applies all mutating actions sequentially to the destination repository: +-- 1. __Parent Directory Synthesis:__ Automatically creates any missing parent +-- directories (via 'createDirectoryIfMissing True') prior to writing file contents. +-- 2. __Atomic Content Materialization:__ Writes canonical UTF-8 text contents to +-- disk for both 'ActionCreate' and 'ActionUpdate' operations. +-- 3. __Permission Enforcement:__ When an asset requires executable permissions +-- (e.g., verification harnesses, Git hooks, tag generation scripts), explicitly +-- sets the owner executable bit via 'setOwnerExecutable True'. +-- 4. __Exception Containment:__ Wraps each individual filesystem mutation in an +-- isolated exception handler. If a write fails (due to permissions, disk space, +-- or locks), the error is recorded in 'resultErrors' while continuing execution +-- for remaining assets. +-- 5. __Idempotent Resonance:__ After successful execution under 'ApplySync', the +-- repository is mathematically stable: immediately calling 'computeSyncPlan' +-- produces 'isPlanClean plan == True'. +executeSyncPlan :: SyncMode -> SyncPlan -> IO SyncResult +executeSyncPlan mode plan = do + case mode of + DryRun -> do + -- In DryRun mode, return planned changes without mutating disk + let created = [p | ActionCreate p _ _ <- planActions plan] + updated = [p | ActionUpdate p _ _ _ <- planActions plan] + chmodded = [p | ActionChmod p _ _ <- planActions plan] + unchanged = [p | ActionNoOp p <- planActions plan] + errs = [(p, msg) | ActionError p msg <- planActions plan] + pure SyncResult + { resultTargetDir = planTargetDir plan + , resultProjectName = planProjectName plan + , resultMode = DryRun + , resultCreated = created + , resultUpdated = updated + , resultChmodded = chmodded + , resultUnchanged = unchanged + , resultErrors = errs + , resultSuccess = null errs + } + ApplySync -> do + -- In ApplySync mode, apply mutations to disk safely + resActions <- forM (planActions plan) $ \action -> do + case action of + ActionCreate relPath content isExec -> (do + let absPath = planTargetDir plan relPath + createDirectoryIfMissing True (takeDirectory absPath) + TIO.writeFile absPath content + when isExec $ do + perms <- getPermissions absPath + setPermissions absPath (setOwnerExecutable True perms) + pure (ExecCreated relPath) + ) `catch` (\(e :: SomeException) -> + pure (ExecFailed relPath (T.pack (displayException e)))) + + ActionUpdate relPath _ newContent isExec -> (do + let absPath = planTargetDir plan relPath + createDirectoryIfMissing True (takeDirectory absPath) + TIO.writeFile absPath newContent + when isExec $ do + perms <- getPermissions absPath + setPermissions absPath (setOwnerExecutable True perms) + pure (ExecUpdated relPath) + ) `catch` (\(e :: SomeException) -> + pure (ExecFailed relPath (T.pack (displayException e)))) + + ActionChmod relPath _ targetExec -> (do + let absPath = planTargetDir plan relPath + perms <- getPermissions absPath + setPermissions absPath (setOwnerExecutable targetExec perms) + pure (ExecChmodded relPath) + ) `catch` (\(e :: SomeException) -> + pure (ExecFailed relPath (T.pack (displayException e)))) + + ActionNoOp relPath -> + pure (ExecUnchanged relPath) + + ActionError relPath msg -> + pure (ExecFailed relPath msg) + + let created = [p | ExecCreated p <- resActions] + updated = [p | ExecUpdated p <- resActions] + chmodded = [p | ExecChmodded p <- resActions] + unchanged = [p | ExecUnchanged p <- resActions] + errs = [(p, msg) | ExecFailed p msg <- resActions] + + pure SyncResult + { resultTargetDir = planTargetDir plan + , resultProjectName = planProjectName plan + , resultMode = ApplySync + , resultCreated = created + , resultUpdated = updated + , resultChmodded = chmodded + , resultUnchanged = unchanged + , resultErrors = errs + , resultSuccess = null errs + } + +-- | Internal tracking of single action execution outcome during 'ApplySync'. +data ActionExecOutcome + = ExecCreated !FilePath + | ExecUpdated !FilePath + | ExecChmodded !FilePath + | ExecUnchanged !FilePath + | ExecFailed !FilePath !Text + +-- | High-level synchronization: computes plan and executes under 'SyncMode'. +syncRepository + :: SyncMode + -> FilePath + -> Project + -> StandardizationMatrix + -> IO SyncResult +syncRepository mode repoRoot proj matrix = do + plan <- computeSyncPlan repoRoot proj matrix + executeSyncPlan mode plan + +-- | Fast zero-configuration synchronization for a single repository checkout. +-- +-- Automatically locates and decodes @project.dhall@ if present. If absent, derives +-- a default 'Project' model using the folder's canonical basename and standard ecosystem +-- author metadata. Synchronizes the checkout against 'canonicalMatrix'. +-- +-- === Error Isolation +-- +-- Returns 'Left' with diagnostic text if @project.dhall@ fails to parse or decode. +-- On successful plan execution, returns 'Right' containing the complete 'SyncResult'. +syncRepositoryQuick :: SyncMode -> FilePath -> IO (Either Text SyncResult) +syncRepositoryQuick mode repoRoot = do + absRoot <- canonicalizePath repoRoot + let dhallPath = absRoot "project.dhall" + hasDhall <- doesFileExist dhallPath + if hasDhall + then (do + proj <- decodeProjectFile dhallPath + res <- syncRepository mode absRoot proj canonicalMatrix + pure (Right res) + ) `catch` (\(e :: SomeException) -> + pure (Left ("Failed to decode project.dhall: " <> T.pack (displayException e)))) + else do + let inferredName = T.pack (takeFileName absRoot) + defaultAuthor = Author "Nadia Yvette Chambers" "nadia.yvette.chambers@ik.me" + proj = defaultProject inferredName defaultAuthor + res <- syncRepository mode absRoot proj canonicalMatrix + pure (Right res) + +-------------------------------------------------------------------------------- +-- 4. Multi-Repository Ecosystem Orchestration +-------------------------------------------------------------------------------- + +-- | Discovers sibling ecosystem repositories residing within a parent directory. +-- +-- Scans immediate child directories in 'parentDir' and identifies candidates that +-- exhibit repository traits: +-- * Presence of a @.git@ directory (VCS root). +-- * Presence of a @cabal.project@ manifest (Cabal multi-package workspace root). +-- * Presence of a @project.dhall@ specification (Gachi schema specification). +-- +-- Ignores plain directories that lack all three indicators, preventing inadvertent +-- modification of unrelated scratch folders or temporary data. +-- +-- === Worked Example +-- +-- >>> repos <- discoverEcosystemRepositories "/home/nyc/src" +-- >>> any (\p -> takeFileName p == "gachi") repos +-- True +discoverEcosystemRepositories :: FilePath -> IO [FilePath] +discoverEcosystemRepositories parentDir = do + exists <- doesDirectoryExist parentDir + if not exists + then pure [] + else do + entries <- listDirectory parentDir + repos <- forM entries $ \entry -> do + let candidate = parentDir entry + isDir <- doesDirectoryExist candidate + if not isDir + then pure Nothing + else do + hasGit <- doesDirectoryExist (candidate ".git") + hasCabalProj <- doesFileExist (candidate "cabal.project") + hasDhall <- doesFileExist (candidate "project.dhall") + if hasGit || hasCabalProj || hasDhall + then pure (Just candidate) + else pure Nothing + pure (catMaybes repos) + +-- | Harmonically synchronizes all discovered repositories within an ecosystem directory. +-- +-- Sequentially iterates over all checkouts discovered via 'discoverEcosystemRepositories', +-- evaluating and applying synchronization under the given 'SyncMode'. +-- +-- === Failure Isolation & Reporting +-- +-- Execution is resilient: if one repository fails to evaluate its @project.dhall@ or +-- encounters I/O errors during synchronization, the failure is captured as 'Left' +-- in the resulting association list while synchronization continues across all other +-- repositories. +syncEcosystem + :: SyncMode + -> FilePath + -> StandardizationMatrix + -> IO [(FilePath, Either Text SyncResult)] +syncEcosystem mode parentDir matrix = do + repoPaths <- discoverEcosystemRepositories parentDir + forM repoPaths $ \repoPath -> do + let dhallPath = repoPath "project.dhall" + hasDhall <- doesFileExist dhallPath + if hasDhall + then (do + proj <- decodeProjectFile dhallPath + res <- syncRepository mode repoPath proj matrix + pure (repoPath, Right res) + ) `catch` (\(e :: SomeException) -> + pure (repoPath, Left ("Failed to decode project.dhall: " <> T.pack (displayException e)))) + else do + let inferredName = T.pack (takeFileName repoPath) + defaultAuthor = Author "Nadia Yvette Chambers" "nadia.yvette.chambers@ik.me" + proj = defaultProject inferredName defaultAuthor + res <- syncRepository mode repoPath proj matrix + pure (repoPath, Right res) + +-------------------------------------------------------------------------------- +-- 5. Diagnostic Plan & Result Formatting +-------------------------------------------------------------------------------- + +-- | Renders a 'SyncPlan' as a formatted plain-text ASCII table. +-- +-- Produces an aligned, terminal-friendly diagnostic report containing: +-- * Workspace root directory and target project name. +-- * Aggregate action summary counters (Created, Updated, Chmod, No-Op). +-- * Tabular inventory of every evaluated asset: +-- * @CREATE@: Missing files scheduled for creation, marked with @(+x)@ if executable. +-- * @UPDATE@: Drifted files showing 8-character SHA-256 prefixes (@oldHash -> newHash@). +-- * @CHMOD@: Permission fixes indicating transition (@exec: False -> True@). +-- * @NO-OP@: Cleanly compliant files left untouched. +-- * @ERROR@: Diagnostic message for files where I/O inspection failed. +-- +-- === Output Stability +-- +-- Suitable for stdout terminal streaming, CI log capture, or regression testing. +formatSyncPlan :: SyncPlan -> Text +formatSyncPlan plan = T.unlines $ + [ "================================================================================" + , " Gachi Synchronization Plan (Pre-Mutation Preview)" + , "================================================================================" + , " Target Directory: " <> T.pack (planTargetDir plan) + , " Project Name: " <> planProjectName plan + , " Actions Planned: " + <> "Create: " <> T.show (planCreatedCount plan) + <> " | Update: " <> T.show (planUpdatedCount plan) + <> " | Chmod: " <> T.show (planChmodCount plan) + <> " | No-Op: " <> T.show (planNoOpCount plan) + , "--------------------------------------------------------------------------------" + , " Action | Path" + , "------------+-------------------------------------------------------------------" + ] + ++ map formatActionRow (planActions plan) + ++ + [ "================================================================================" ] + where + formatActionRow (ActionCreate p _ isExec) = + " CREATE | " <> T.pack p <> (if isExec then " (+x)" else "") + formatActionRow (ActionUpdate p oldTxt newTxt isExec) = + let oldHash = T.take 8 (sha256Text oldTxt) + newHash = T.take 8 (sha256Text newTxt) + in " UPDATE | " <> T.pack p <> " (" <> oldHash <> " -> " <> newHash <> ")" + <> (if isExec then " (+x)" else "") + formatActionRow (ActionChmod p actual expected) = + " CHMOD | " <> T.pack p <> " (exec: " <> T.show actual <> " -> " <> T.show expected <> ")" + formatActionRow (ActionNoOp p) = + " NO-OP | " <> T.pack p <> " (compliant)" + formatActionRow (ActionError p msg) = + " ERROR | " <> T.pack p <> " (" <> msg <> ")" + +-- | Renders a 'SyncResult' as a formatted plain-text ASCII summary banner. +-- +-- Formats the final disposition of a completed or simulated synchronization run: +-- * Destination directory and project identification slug. +-- * Active execution mode: @DRY RUN (Preview Only)@ vs @APPLIED@. +-- * Status verdict: @SUCCESS@ (zero errors) or @FAILED@ (one or more I/O errors). +-- * Exact counts of created, updated, chmodded, and unchanged files. +-- * Dedicated error section listing failing relative paths and exception messages. +formatSyncResult :: SyncResult -> Text +formatSyncResult res = T.unlines $ + [ "================================================================================" + , " Gachi Synchronization Execution Summary" + , "================================================================================" + , " Target Directory: " <> T.pack (resultTargetDir res) + , " Project Name: " <> resultProjectName res + , " Execution Mode: " <> (if resultMode res == DryRun then "DRY RUN (Preview Only)" else "APPLIED") + , " Status: " <> (if resultSuccess res then "SUCCESS" else "FAILED") + , " Files Created: " <> T.show (length (resultCreated res)) + , " Files Updated: " <> T.show (length (resultUpdated res)) + , " Permissions Fixed:" <> T.show (length (resultChmodded res)) + , " Files Unchanged: " <> T.show (length (resultUnchanged res)) + ] + ++ formatErrorSection (resultErrors res) + ++ + [ "================================================================================" ] + where + formatErrorSection [] = [] + formatErrorSection errs = + [ "--------------------------------------------------------------------------------" + , " Errors Encountered:" + ] ++ map (\(p, msg) -> " * " <> T.pack p <> ": " <> msg) errs diff --git a/src/Gachi/Sync/Hash.hs b/src/Gachi/Sync/Hash.hs new file mode 100644 --- /dev/null +++ b/src/Gachi/Sync/Hash.hs @@ -0,0 +1,298 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Module: Gachi.Sync.Hash +-- Description: Pure, self-contained SHA-256 differential hashing engine +-- +-- This module implements FIPS 180-2 compliant Secure Hash Algorithm (SHA-256) +-- in pure Haskell with zero external cryptographic dependencies. +-- +-- = Architectural Context & Invariants +-- +-- In accordance with Note [Harmonic Chattering Synchronization and Differential Propagation] +-- [ref:note-harmonic-sync], the synchronization engine must rapidly verify +-- content identity across dozens of workspace files without triggering unnecessary +-- disk writes or external process invocations. +-- +-- == Invariant: Pure Referential Transparency +-- +-- * __Totality:__ Hashing functions are pure and total across all inputs. +-- * __Zero-Dependency:__ Implemented using standard @base@ and @bytestring@ primitives. +-- * __FIPS 180-2 Compliance:__ Satisfies standard NIST test vectors, including the empty string +-- digest (@e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855@). +-- +-- == Algorithmic Overview (FIPS 180-2 SHA-256) +-- +-- SHA-256 operates on 512-bit message blocks through a sequence of mathematical +-- transformations structured across four stages: +-- +-- 1. __Preprocessing and Padding:__ +-- The arbitrary-length input bitstream \( M \) of length \( L \) bits is padded +-- by appending a single '1' bit, followed by \( k \) '0' bits, where \( k \) +-- is the smallest non-negative integer satisfying: +-- \[ +-- L + 1 + k \equiv 448 \pmod{512} +-- \] +-- Finally, the 64-bit big-endian representation of \( L \) is appended, yielding +-- an exact multiple of 512 bits (16 32-bit words). +-- +-- 2. __Message Schedule Expansion:__ +-- Each 16-word block \( W_{0..15} \) is expanded into a 64-word schedule \( W_{0..63} \): +-- \[ +-- W_t = \sigma_1(W_{t-2}) + W_{t-7} + \sigma_0(W_{t-15}) + W_{t-16} +-- \] +-- where the lower-case sigma functions apply rotational and right-shift mixing: +-- \[ +-- \sigma_0(x) = \text{RotR}(x, 7) \oplus \text{RotR}(x, 18) \oplus \text{ShR}(x, 3) +-- \] +-- \[ +-- \sigma_1(x) = \text{RotR}(x, 17) \oplus \text{RotR}(x, 19) \oplus \text{ShR}(x, 10) +-- \] +-- +-- 3. __64-Round Compression Loop:__ +-- Eight 32-bit working state variables (\( a, b, c, d, e, f, g, h \)) are initialized +-- from the intermediate hash values \( H^{(i-1)} \). In each step \( t \in [0, 63] \): +-- \[ +-- T_1 = h + \Sigma_1(e) + \text{Ch}(e, f, g) + K_t + W_t +-- \] +-- \[ +-- T_2 = \Sigma_0(a) + \text{Maj}(a, b, c) +-- \] +-- \[ +-- h \leftarrow g, \quad g \leftarrow f, \quad f \leftarrow e, \quad e \leftarrow d + T_1 +-- \] +-- \[ +-- d \leftarrow c, \quad c \leftarrow b, \quad b \leftarrow a, \quad a \leftarrow T_1 + T_2 +-- \] +-- where the non-linear bitwise choice and majority combinators are defined as: +-- \[ +-- \text{Ch}(x, y, z) = (x \wedge y) \oplus (\neg x \wedge z) +-- \] +-- \[ +-- \text{Maj}(x, y, z) = (x \wedge y) \oplus (x \wedge z) \oplus (y \wedge z) +-- \] +-- +-- 4. __Intermediate State Accumulation:__ +-- The updated working variables are summed modulo \( 2^{32} \) into the running state: +-- \[ +-- H_j^{(i)} = H_j^{(i-1)} + \text{Var}_j \quad \forall j \in \{0..7\} +-- \] +-- +-- = Worked Example +-- +-- >>> import Gachi.Sync.Hash +-- >>> sha256Text "" +-- "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" +-- >>> sha256Text "gachi" +-- "e43b177d6118bfa6b6f7097eb586ef291f5a5a92cf6d62ea09c0fa168e312521" +module Gachi.Sync.Hash + ( -- * Pure SHA-256 Digest Functions + sha256Text + , sha256ByteString + , sha256File + ) where + +import Data.Bits (complement, rotateR, shiftL, shiftR, xor, (.&.), (.|.)) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import Data.Word (Word32, Word64) +import Numeric (showHex) + +-------------------------------------------------------------------------------- +-- 1. Initial State & Round Constants (FIPS 180-2) +-------------------------------------------------------------------------------- + +-- | Initial 256-bit hash values representing first 32 bits of fractional parts +-- of the square roots of the first 8 prime numbers (2..19). +initialHash :: (Word32, Word32, Word32, Word32, Word32, Word32, Word32, Word32) +initialHash = + ( 0x6a09e667 + , 0xbb67ae85 + , 0x3c6ef372 + , 0xa54ff53a + , 0x510e527f + , 0x9b05688c + , 0x1f83d9ab + , 0x5be0cd19 + ) + +-- | Sixty-four 32-bit round constants representing the first 32 bits of the +-- fractional parts of the cube roots of the first 64 prime numbers (2..311). +roundConstants :: [Word32] +roundConstants = + [ 0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5 + , 0x3956c25b, 0x59f111f1, 0x923f82a4, 0xab1c5ed5 + , 0xd807aa98, 0x12835b01, 0x243185be, 0x550c7dc3 + , 0x72be5d74, 0x80deb1fe, 0x9bdc06a7, 0xc19bf174 + , 0xe49b69c1, 0xefbe4786, 0x0fc19dc6, 0x240ca1cc + , 0x2de92c6f, 0x4a7484aa, 0x5cb0a9dc, 0x76f988da + , 0x983e5152, 0xa831c66d, 0xb00327c8, 0xbf597fc7 + , 0xc6e00bf3, 0xd5a79147, 0x06ca6351, 0x14292967 + , 0x27b70a85, 0x2e1b2138, 0x4d2c6dfc, 0x53380d13 + , 0x650a7354, 0x766a0abb, 0x81c2c92e, 0x92722c85 + , 0xa2bfe8a1, 0xa81a664b, 0xc24b8b70, 0xc76c51a3 + , 0xd192e819, 0xd6990624, 0xf40e3585, 0x106aa070 + , 0x19a4c116, 0x1e376c08, 0x2748774c, 0x34b0bcb5 + , 0x391c0cb3, 0x4ed8aa4a, 0x5b9cca4f, 0x682e6ff3 + , 0x748f82ee, 0x78a5636f, 0x84c87814, 0x8cc70208 + , 0x90befffa, 0xa4506ceb, 0xbef9a3f7, 0xc67178f2 + ] + +-------------------------------------------------------------------------------- +-- 2. Bitwise Logical Functions +-------------------------------------------------------------------------------- + +-- | Bitwise choice: (x AND y) XOR (NOT x AND z). +ch :: Word32 -> Word32 -> Word32 -> Word32 +ch !x !y !z = (x .&. y) `xor` (complement x .&. z) +{-# INLINE ch #-} + +-- | Bitwise majority: (x AND y) XOR (x AND z) XOR (y AND z). +maj :: Word32 -> Word32 -> Word32 -> Word32 +maj !x !y !z = (x .&. y) `xor` (x .&. z) `xor` (y .&. z) +{-# INLINE maj #-} + +-- | Upper-case Sigma 0: RotR(x, 2) XOR RotR(x, 13) XOR RotR(x, 22). +sigmaUpper0 :: Word32 -> Word32 +sigmaUpper0 !x = rotateR x 2 `xor` rotateR x 13 `xor` rotateR x 22 +{-# INLINE sigmaUpper0 #-} + +-- | Upper-case Sigma 1: RotR(x, 6) XOR RotR(x, 11) XOR RotR(x, 25). +sigmaUpper1 :: Word32 -> Word32 +sigmaUpper1 !x = rotateR x 6 `xor` rotateR x 11 `xor` rotateR x 25 +{-# INLINE sigmaUpper1 #-} + +-- | Lower-case Sigma 0: RotR(x, 7) XOR RotR(x, 18) XOR ShiftR(x, 3). +sigmaLower0 :: Word32 -> Word32 +sigmaLower0 !x = rotateR x 7 `xor` rotateR x 18 `xor` shiftR x 3 +{-# INLINE sigmaLower0 #-} + +-- | Lower-case Sigma 1: RotR(x, 17) XOR RotR(x, 19) XOR ShiftR(x, 10). +sigmaLower1 :: Word32 -> Word32 +sigmaLower1 !x = rotateR x 17 `xor` rotateR x 19 `xor` shiftR x 10 +{-# INLINE sigmaLower1 #-} + +-------------------------------------------------------------------------------- +-- 3. Message Padding & Block Preparation +-------------------------------------------------------------------------------- + +-- | Pads message bytes according to FIPS 180-2: +-- 1. Appends bit 1 (single byte 0x80). +-- 2. Appends k zero bytes such that (length + 1 + k) == 56 mod 64. +-- 3. Appends 64-bit big-endian representation of original bit length. +padMessage :: BS.ByteString -> BL.ByteString +padMessage input = + let lenBytes = fromIntegral (BS.length input) :: Word64 + lenBits = lenBytes * 8 + padLen = (55 - fromIntegral (lenBytes `mod` 64)) `mod` 64 + zeros = BS.replicate padLen 0 + lenEncoding = BS.pack + [ fromIntegral (shiftR lenBits 56 .&. 0xFF) + , fromIntegral (shiftR lenBits 48 .&. 0xFF) + , fromIntegral (shiftR lenBits 40 .&. 0xFF) + , fromIntegral (shiftR lenBits 32 .&. 0xFF) + , fromIntegral (shiftR lenBits 24 .&. 0xFF) + , fromIntegral (shiftR lenBits 16 .&. 0xFF) + , fromIntegral (shiftR lenBits 8 .&. 0xFF) + , fromIntegral (lenBits .&. 0xFF) + ] + in BL.fromChunks [input, BS.singleton 0x80, zeros, lenEncoding] + +-- | Parses a 64-byte block into 16 32-bit big-endian words. +parseBlock :: BS.ByteString -> [Word32] +parseBlock bs = go (BS.unpack bs) + where + go [] = [] + go (b0:b1:b2:b3:rest) = + let !w0 = fromIntegral b0 `shiftL` 24 + !w1 = fromIntegral b1 `shiftL` 16 + !w2 = fromIntegral b2 `shiftL` 8 + !w3 = fromIntegral b3 + !w = w0 .|. w1 .|. w2 .|. w3 + in w : go rest + go _ = [] + +-- | Expands the 16 words of a block into a full 64-word message schedule. +expandSchedule :: [Word32] -> [Word32] +expandSchedule w16 = go 16 (w16 ++ replicate 48 0) + where + go !t !ws + | t == 64 = ws + | otherwise = + let s0 = sigmaLower0 (ws !! (t - 15)) + s1 = sigmaLower1 (ws !! (t - 2)) + newW = (ws !! (t - 16)) + s0 + (ws !! (t - 7)) + s1 + updated = take t ws ++ [newW] ++ drop (t + 1) ws + in go (t + 1) updated + +-------------------------------------------------------------------------------- +-- 4. Compression Function & Main Loop +-------------------------------------------------------------------------------- + +-- | Processes a single 64-byte block, updating the internal 8-word hash state. +compressBlock + :: (Word32, Word32, Word32, Word32, Word32, Word32, Word32, Word32) + -> BS.ByteString + -> (Word32, Word32, Word32, Word32, Word32, Word32, Word32, Word32) +compressBlock (!h0, !h1, !h2, !h3, !h4, !h5, !h6, !h7) blockBytes = + let wSchedule = expandSchedule (parseBlock blockBytes) + (!a, !b, !c, !d, !e, !f, !g, !h) = + foldl step (h0, h1, h2, h3, h4, h5, h6, h7) (zip roundConstants wSchedule) + in (h0 + a, h1 + b, h2 + c, h3 + d, h4 + e, h5 + f, h6 + g, h7 + h) + where + step (!a, !b, !c, !d, !e, !f, !g, !h) (!k, !w) = + let !t1 = h + sigmaUpper1 e + ch e f g + k + w + !t2 = sigmaUpper0 a + maj a b c + in (t1 + t2, a, b, c, d + t1, e, f, g) + +-- | Computes the raw 8-word SHA-256 state from lazy byte stream. +hashByteString :: BL.ByteString -> (Word32, Word32, Word32, Word32, Word32, Word32, Word32, Word32) +hashByteString lazyBytes = + let chunks = splitBlocks (BL.toStrict lazyBytes) + in foldl compressBlock initialHash chunks + where + splitBlocks bs + | BS.null bs = [] + | otherwise = BS.take 64 bs : splitBlocks (BS.drop 64 bs) + +-- | Formats an 8-word hash state into a 64-character lowercase hexadecimal string. +formatDigest :: (Word32, Word32, Word32, Word32, Word32, Word32, Word32, Word32) -> Text +formatDigest (h0, h1, h2, h3, h4, h5, h6, h7) = + T.pack $ concatMap padHex [h0, h1, h2, h3, h4, h5, h6, h7] + where + padHex w = + let s = showHex w "" + in replicate (8 - length s) '0' ++ s + +-------------------------------------------------------------------------------- +-- 5. Public API +-------------------------------------------------------------------------------- + +-- | Computes the SHA-256 hex digest of a UTF-8 'Text' string. +-- +-- === Worked Example +-- +-- >>> sha256Text "" +-- "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" +sha256Text :: Text -> Text +sha256Text = sha256ByteString . TE.encodeUtf8 + +-- | Computes the SHA-256 hex digest of a strict 'BS.ByteString'. +-- +-- === Worked Example +-- +-- >>> sha256ByteString "hello" +-- "2cf24dba5fb0a30e26e83b2ac5b9e29e1b161e5c1fa7425e73043362938b9824" +sha256ByteString :: BS.ByteString -> Text +sha256ByteString bs = formatDigest (hashByteString (padMessage bs)) + +-- | Computes the SHA-256 hex digest of a file on disk. +-- +-- Reads the file contents strictly as binary and computes the digest. +sha256File :: FilePath -> IO Text +sha256File path = do + content <- BS.readFile path + pure (sha256ByteString content) diff --git a/src/Gachi/Sync/Matrix.hs b/src/Gachi/Sync/Matrix.hs new file mode 100644 --- /dev/null +++ b/src/Gachi/Sync/Matrix.hs @@ -0,0 +1,597 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Module: Gachi.Sync.Matrix +-- Description: Canonical 9-dimensional Standardization Matrix definition and queries +-- +-- This module implements the authoritative Standardization Matrix defined in +-- ~/src/PLAN.md §1.A. It registers every standardized ecosystem asset across the +-- nine canonical dimensions, pairs them with pure deterministic generators, and +-- provides query combinators for repository audits and configuration propagation. +-- +-- = Architectural Context & Invariants +-- +-- In accordance with Note [Ecosystem Standardization Invariants] +-- [ref:note-ecosystem-standardization] and Note [Cross-Repository Standardization Matrix and Audit Semantics] +-- [ref:note-standardization-matrix], all repositories across ~/src/* share an +-- authoritative structural skeleton. This module provides the central matrix +-- registry from which audit tools and sync commands derive their expectations. +-- +-- = Note [Cross-Repository Standardization Matrix and Audit Semantics] +-- [tag:note-standardization-matrix] +-- +-- Multi-repository ecosystems face constant structural entropy. As individual +-- libraries evolve, their formatting configurations, compiler warning flags, +-- git commit hooks, CI workflows, and AI pair programming instructions diverge. +-- Over time, this divergence creates friction when developers or AI assistants +-- navigate across repositories. +-- +-- To prevent this fragmentation, Gachi defines a 9-dimensional Standardization +-- Matrix (~/src/PLAN.md §1.A) that is non-negotiably enforced across all checkouts: +-- +-- 1. __Workspace Layout (Dimension 1):__ +-- Standardized multi-package DAG (`packages/*/`), central documentation +-- corpus (`docs/INDEX.md`, `docs/notes/`), and the two-file operational +-- planning loop (`PLAN.md`, `STATE.md`). Ensures that any contributor or +-- automated agent arriving in any checkout can immediately locate documentation, +-- active milestones, and the operational frontier without cognitive disorientation. +-- +-- 2. __Code Formatters (Dimension 2):__ +-- Deterministic AST-preserving formatting profiles across Haskell +-- (@fourmolu.yaml@), Rust (@rustfmt.toml@), and C/C++ (@.clang-format@). +-- Prevents superficial whitespace and layout diffs from polluting code review +-- and git blame histories during cross-repository refactorings. +-- +-- 3. __Linters & Guardrails (Dimension 3):__ +-- Strict zero-hint HLint policy (@.hlint.yaml@) enforcing modern GHC +-- idioms such as @OverloadedRecordDot@. Prohibits outdated patterns and ensures +-- consistent language extension usage across all packages. +-- +-- 4. __Build Conventions (Dimension 4):__ +-- Toolchain pinning (@cabal.project@) targeting GHC 9.14.1 and Cabal 3.18, +-- with standard developer override stanzas (@cabal.project.local.example@). +-- Guarantees hermetic, reproducible builds across developer laptops and CI nodes. +-- +-- 5. __Git Governance (Dimension 5):__ +-- Linux kernel RFC 2822 commit trailer rules (@.gitmessage@), Tagref +-- configuration (@tagref.yml@), and executable git hooks (@.githooks/commit-msg@, +-- @.githooks/pre-commit@). Enforces legal DCO boundaries, transparent AI +-- attribution, and pre-commit verification before code leaves local workstations. +-- +-- 6. __Remote Topology (Dimension 6):__ +-- Multi-forge replication topology separating Radicle peer-to-peer from +-- commercial and community mirrors, documented in @docs/MAINTAINER_GUIDE.md@. +-- Guarantees sovereign, censorship-resistant repository distribution. +-- +-- 7. __Tiered CI Workflows (Dimension 7):__ +-- Asymmetric forge resource allocation: full physical verification on +-- high-resource GitHub Actions (@.github/workflows/ci.yml@) versus lightweight +-- static verification gates on community forges (@.gitlab-ci.yml@). +-- Conserves shared community runner quotas while enforcing rigorous testing. +-- See Note [Forge-Tiered CI Resource Allocation and Static Gate Partitioning] +-- [ref:note-forge-tiered-ci]. +-- +-- 8. __Polyglot Invariants (Dimension 8):__ +-- Cross-language FFI boundary invariants, C/C++ clang-format styling, +-- and rustfmt rules for non-Haskell components. Ensures consistent ergonomics +-- when Haskell interfaces with low-level systems code or Rust libraries. +-- +-- 9. __Agent Advisory Layer (Dimension 9):__ +-- Context-budgeted AI agent instructions (@AGENTS.md@, ~4 KB limit), +-- compatibility pointers (@CLAUDE.md@), and modular rules in @.agents/rules/@. +-- Prevents LLM context saturation and prompt drift across agent sessions. +-- +-- 10. __Physical Verification Harnesses:__ +-- Turnkey shell scripts in @bin/@ enforcing the five physical gates: +-- HLint cleanliness, Cabal test suite, Tagref cross-references, Markdown +-- link integrity, and CLOC comment density. +-- +-- == Audit Semantics +-- +-- The repository audit engine operates under strict invariants: +-- * __Read-Only Purity:__ Audits inspect disk state without mutating any files. +-- * __Total Classification:__ Every audited asset is classified into exactly one +-- 'AssetAuditStatus': 'StatusCompliant', 'StatusMissing', 'StatusContentDrift', +-- 'StatusPermissionDrift', or 'StatusIOError'. +-- * __Deterministic Generators:__ Expected contents are produced purely by +-- evaluating generators against the target repository's 'Project' schema. +-- +-- = Worked Example +-- +-- >>> import Gachi.Sync.Matrix +-- >>> length (matrixAssets canonicalMatrix) >= 20 +-- True +-- >>> length (matrixDimensions canonicalMatrix) == 10 +-- True +module Gachi.Sync.Matrix + ( -- * Canonical Standardization Matrix + canonicalMatrix + , canonicalAssets + , canonicalDimensions + + -- * Query & Filter Combinators + , assetsForCategory + , ciWorkflowAssets + , requiredAssets + , optionalAssets + , executableAssets + , findAssetByPath + , countByCategory + ) where + +import Data.List (find) + +import Gachi.Scaffold.Templates + ( docsCommitAttributionTemplate + , docsIndexTemplate + , docsMaintainerGuideTemplate + , docsStrategyTemplate + , planTemplate + , stateTemplate + ) +import Gachi.Sync.Catalog + ( agentsTemplate + , cabalProjectLocalTemplate + , cabalProjectTemplate + , clangFormatTemplate + , claudeTemplate + , clocScriptTemplate + , codeNavigationRuleTemplate + , commitAttributionRuleTemplate + , commitMsgHookTemplate + , compilerVerificationRuleTemplate + , documentationPrecedenceRuleTemplate + , fourmoluTemplate + , generateTagsTemplate + , githubCiTemplate + , gitlabCiTemplate + , gitmessageTemplate + , hlintTemplate + , linkcheckScriptTemplate + , preCommitHookTemplate + , rustfmtTemplate + , tagrefConfigTemplate + , tagrefScriptTemplate + , verifyScriptTemplate + ) +import Gachi.Sync.Types + ( AssetCategory(..) + , StandardAsset(..) + , StandardizationMatrix(..) + ) + +-------------------------------------------------------------------------------- +-- 1. Canonical Dimensions +-------------------------------------------------------------------------------- + +-- | The complete list of standardization dimensions enforced across the ecosystem. +-- +-- Covers all nine dimensions specified in ~/src/PLAN.md §1.A plus the physical +-- verification harness category. +-- +-- Dimensions are ordered logically from fundamental repository structure to +-- high-level tooling and verification: +-- +-- 1. 'CategoryLayout': Directory hierarchies and operational planning files. +-- 2. 'CategoryFormatter': Code layout and styling profiles across all languages. +-- 3. 'CategoryLinter': Static analysis policies and compiler guardrails. +-- 4. 'CategoryBuild': Build toolchain pinning and package manifest conventions. +-- 5. 'CategoryGitGovernance': Git commit hooks, commit templates, and tag references. +-- 6. 'CategoryRemoteTopology': Multi-forge replication and mirror definitions. +-- 7. 'CategoryCIWorkflow': Tiered continuous integration configurations. +-- 8. 'CategoryPolyglot': Multi-language FFI boundary invariants and foreign code. +-- 9. 'CategoryAgentAdvisory': AI pair programming instructions and context bounds. +-- 10. 'CategoryVerification': Physical gate test scripts and verification harnesses. +canonicalDimensions :: [AssetCategory] +canonicalDimensions = + [ CategoryLayout + , CategoryFormatter + , CategoryLinter + , CategoryBuild + , CategoryGitGovernance + , CategoryRemoteTopology + , CategoryCIWorkflow + , CategoryPolyglot + , CategoryAgentAdvisory + , CategoryVerification + ] + +-------------------------------------------------------------------------------- +-- 2. Canonical Assets Registry +-------------------------------------------------------------------------------- + +-- | Canonical list of standardized ecosystem assets. +-- +-- Each asset pairs its relative workspace path with its governing category, +-- necessity flag ('assetRequired'), executable permission requirement +-- ('assetExecutable'), descriptive synopsis, and pure generator function. +-- +-- === Rationale by Dimension +-- +-- * __Dimension 1 (Layout):__ +-- Provides the foundational documentation corpus (@docs/@) and the operational +-- two-file planning loop (@PLAN.md@, @STATE.md@) ensuring orientation. +-- +-- * __Dimension 2 (Formatters):__ +-- Deterministic styling via Fourmolu, rustfmt, and clang-format prevents +-- cosmetic git churn during refactoring across packages. +-- +-- * __Dimension 3 (Linters):__ +-- Zero-hint HLint policy eliminates dead code, enforces modern record dot syntax, +-- and ensures uniform GHC extension discipline. +-- +-- * __Dimension 4 (Build):__ +-- Hermetic Cabal project configuration pins GHC 9.14.1 and standardizes warnings +-- while allowing local machine overrides via @cabal.project.local@. +-- +-- * __Dimension 5 (Git Governance):__ +-- Enforces Linux kernel RFC 2822 trailer format for AI attribution, Tagref +-- cross-referencing, and pre-commit integrity checking. +-- +-- * __Dimension 6 (Remote Topology):__ +-- Maintainer guidance for 5-forge replication across Radicle, GitHub, GitCode, +-- Framagit, and Disroot. +-- +-- * __Dimension 7 (Tiered CI):__ +-- Resource-differentiated CI: heavy verification on GitHub Actions vs lightweight +-- static checks on community GitLab runners. +-- +-- * __Dimension 8 (Polyglot):__ +-- Ensures C/C++ components follow LLVM/Linux formatting standards without tab drift. +-- +-- * __Dimension 9 (Agent Advisory):__ +-- Token-budgeted pointer file (@AGENTS.md@, ~4 KB) and modular rules for AI assistants. +-- +-- * __Dimension 10 (Verification):__ +-- Self-contained executable scripts implementing the five physical verification gates. +canonicalAssets :: [StandardAsset] +canonicalAssets = + -- Dimension 1: Workspace Layout & Documentation Corpus + [ StandardAsset + "docs/INDEX.md" + CategoryLayout + True + False + "Central documentation index, reading order, and document map" + docsIndexTemplate + , StandardAsset + "docs/notes/DOC_STRATEGY.md" + CategoryLayout + True + False + "Documentation strategy, four canonical genres, and precedence rules" + docsStrategyTemplate + , StandardAsset + "docs/notes/COMMIT_ATTRIBUTION.md" + CategoryLayout + True + False + "Commit attribution specification for Linux kernel RFC 2822 trailers" + docsCommitAttributionTemplate + , StandardAsset + "PLAN.md" + CategoryLayout + True + False + "Strategic roadmap, phased milestones, and architecture deliverables" + planTemplate + , StandardAsset + "STATE.md" + CategoryLayout + True + False + "Operational frontier, active milestones, and two-file loop tracking" + stateTemplate + + -- Dimension 2: Code Formatters + , StandardAsset + "fourmolu.yaml" + CategoryFormatter + True + False + "Canonical Fourmolu configuration enforcing deterministic Haskell formatting" + (const fourmoluTemplate) + , StandardAsset + "rustfmt.toml" + CategoryFormatter + False + False + "Canonical rustfmt configuration for polyglot Rust components" + (const rustfmtTemplate) + , StandardAsset + ".clang-format" + CategoryFormatter + False + False + "Canonical .clang-format configuration based on LLVM/Linux style" + (const clangFormatTemplate) + + -- Dimension 3: Static Analysis & Linters + , StandardAsset + ".hlint.yaml" + CategoryLinter + True + False + "Strict zero-hint HLint static analysis configuration" + (const hlintTemplate) + + -- Dimension 4: Build Conventions + , StandardAsset + "cabal.project" + CategoryBuild + True + False + "Root Cabal project file pinning GHC 9.14.1 and compiler warning flags" + cabalProjectTemplate + , StandardAsset + "cabal.project.local.example" + CategoryBuild + True + False + "Developer local override configuration template" + (const cabalProjectLocalTemplate) + + -- Dimension 5: Git Governance & Hooks + , StandardAsset + ".gitmessage" + CategoryGitGovernance + True + False + "Git commit message template specifying RFC 2822 trailer format" + (const gitmessageTemplate) + , StandardAsset + "tagref.yml" + CategoryGitGovernance + True + False + "Tagref cross-reference configuration file" + tagrefConfigTemplate + , StandardAsset + ".githooks/commit-msg" + CategoryGitGovernance + True + True + "Git commit-msg hook enforcing AI attribution and commit message rules" + (const commitMsgHookTemplate) + , StandardAsset + ".githooks/pre-commit" + CategoryGitGovernance + True + True + "Git pre-commit hook guarding Tagref references and markdown links" + preCommitHookTemplate + + -- Dimension 6: Remote Topology & Multi-Forge Mirroring + , StandardAsset + "docs/MAINTAINER_GUIDE.md" + CategoryRemoteTopology + True + False + "Maintainer guide documenting the 5-remote topology and push mirrors" + docsMaintainerGuideTemplate + + -- Dimension 7: Forge-Tiered CI Workflows + , StandardAsset + ".github/workflows/ci.yml" + CategoryCIWorkflow + True + False + "High-resource GitHub Actions workflow running complete physical gates" + githubCiTemplate + , StandardAsset + ".gitlab-ci.yml" + CategoryCIWorkflow + True + False + "Lightweight GitLab CI workflow for resource-constrained community forges" + gitlabCiTemplate + + -- Dimension 8: Polyglot Invariants + , StandardAsset + ".clang-format" + CategoryPolyglot + False + False + "Polyglot C/C++ ABI formatting and style definition" + (const clangFormatTemplate) + + -- Dimension 9: Agent Advisory Layer + , StandardAsset + "AGENTS.md" + CategoryAgentAdvisory + True + False + "Context-budgeted AI coding assistant advisory guide (~4 KB limit)" + agentsTemplate + , StandardAsset + "CLAUDE.md" + CategoryAgentAdvisory + True + False + "Agent compatibility symlink/pointer to AGENTS.md" + claudeTemplate + , StandardAsset + ".agents/rules/commit-attribution.md" + CategoryAgentAdvisory + True + False + "Modular rule: Linux kernel RFC 2822 trailer format and DCO boundaries" + (const commitAttributionRuleTemplate) + , StandardAsset + ".agents/rules/code-navigation.md" + CategoryAgentAdvisory + True + False + "Modular rule: Token-conserving code navigation funnel" + (const codeNavigationRuleTemplate) + , StandardAsset + ".agents/rules/compiler-verification.md" + CategoryAgentAdvisory + True + False + "Modular rule: Zero-warning compiler verification and zero-contamination" + (const compilerVerificationRuleTemplate) + , StandardAsset + ".agents/rules/documentation-precedence.md" + CategoryAgentAdvisory + True + False + "Modular rule: Precedence rule and the two-file operational loop" + (const documentationPrecedenceRuleTemplate) + + -- Dimension 10: Physical Verification Harnesses + , StandardAsset + "bin/:name:-verify" + CategoryVerification + True + True + "Primary physical verification runner executing all 5 non-negotiable gates" + verifyScriptTemplate + , StandardAsset + "bin/:name:-tagref" + CategoryVerification + True + True + "Tagref cross-reference verification script" + tagrefScriptTemplate + , StandardAsset + "bin/:name:-linkcheck" + CategoryVerification + True + True + "Markdown relative link and section anchor integrity checker" + linkcheckScriptTemplate + , StandardAsset + "bin/:name:-cloc" + CategoryVerification + True + True + "CLOC comment density enforcement script requiring >= 50% comments" + clocScriptTemplate + , StandardAsset + "bin/generate-tags" + CategoryVerification + True + True + "Universal ctags symbol table generator for fast token-efficient lookup" + (const generateTagsTemplate) + ] + +-------------------------------------------------------------------------------- +-- 3. Canonical Matrix +-------------------------------------------------------------------------------- + +-- | Authoritative singleton Standardization Matrix for the Gachi ecosystem. +-- +-- Combines 'canonicalAssets' across all 'canonicalDimensions'. +-- +-- Serves as the primary reference matrix for: +-- * 'Gachi.Sync.Audit.auditRepository': Inspecting workspaces for drift or missing files. +-- * 'Gachi.Sync.Audit.auditRepositoryQuick': Fast, zero-argument workspace verification. +-- * 'Gachi.Sync': Differential synchronization across repository checkouts. +canonicalMatrix :: StandardizationMatrix +canonicalMatrix = StandardizationMatrix + { matrixAssets = canonicalAssets + , matrixDimensions = canonicalDimensions + } + +-------------------------------------------------------------------------------- +-- 4. Query & Filter Combinators +-------------------------------------------------------------------------------- + +-- | Extracts all standardized assets belonging to a specific 'AssetCategory'. +-- +-- Filters 'matrixAssets' by matching 'assetCategory'. +-- +-- === Worked Example +-- +-- >>> let formatters = assetsForCategory CategoryFormatter canonicalMatrix +-- >>> map assetPath formatters +-- ["fourmolu.yaml","rustfmt.toml",".clang-format"] +assetsForCategory :: AssetCategory -> StandardizationMatrix -> [StandardAsset] +assetsForCategory cat matrix = + filter (\a -> assetCategory a == cat) (matrixAssets matrix) + +-- | Extracts all forge-tiered CI workflow assets (Dimension 7) from a matrix. +-- +-- Filters assets belonging to 'CategoryCIWorkflow'. +-- +-- See Note [Forge-Tiered CI Resource Allocation and Static Gate Partitioning] +-- [ref:note-forge-tiered-ci]. +-- +-- === Worked Example +-- +-- >>> let ciAssets = ciWorkflowAssets canonicalMatrix +-- >>> map assetPath ciAssets +-- [".github/workflows/ci.yml",".gitlab-ci.yml"] +ciWorkflowAssets :: StandardizationMatrix -> [StandardAsset] +ciWorkflowAssets = assetsForCategory CategoryCIWorkflow + +-- | Extracts all required assets from a matrix. +-- +-- An asset is required if its absence from disk constitutes an audit violation. +-- Required assets must be present in every production repository checkout. +-- +-- === Worked Example +-- +-- >>> let reqs = requiredAssets canonicalMatrix +-- >>> all assetRequired reqs +-- True +requiredAssets :: StandardizationMatrix -> [StandardAsset] +requiredAssets matrix = + filter assetRequired (matrixAssets matrix) + +-- | Extracts all optional assets from a matrix. +-- +-- Optional assets (e.g. polyglot formatting rules for C/Rust) do not cause +-- audit failures when omitted from repositories that lack those language components. +-- +-- === Worked Example +-- +-- >>> let opts = optionalAssets canonicalMatrix +-- >>> all (not . assetRequired) opts +-- True +optionalAssets :: StandardizationMatrix -> [StandardAsset] +optionalAssets matrix = + filter (not . assetRequired) (matrixAssets matrix) + +-- | Extracts all assets requiring POSIX executable permissions (@+x@). +-- +-- Includes verification scripts in @bin/@ and git hooks in @.githooks/@. +-- The audit engine validates that files on disk have the executable bit set. +-- +-- === Worked Example +-- +-- >>> let execs = executableAssets canonicalMatrix +-- >>> all assetExecutable execs +-- True +executableAssets :: StandardizationMatrix -> [StandardAsset] +executableAssets matrix = + filter assetExecutable (matrixAssets matrix) + +-- | Looks up a standard asset by its relative file path. +-- +-- Searches 'matrixAssets' for an exact match against 'assetPath'. +-- Returns 'Nothing' if the path is not registered in the matrix. +-- +-- === Worked Example +-- +-- >>> let maybeHlint = findAssetByPath ".hlint.yaml" canonicalMatrix +-- >>> fmap assetCategory maybeHlint +-- Just CategoryLinter +findAssetByPath :: FilePath -> StandardizationMatrix -> Maybe StandardAsset +findAssetByPath path matrix = + find (\a -> assetPath a == path) (matrixAssets matrix) + +-- | Computes asset counts grouped by 'AssetCategory'. +-- +-- Returns a list of pairs associating each category with its total registered asset count. +-- Guarantees that every category in 'matrixDimensions' appears in the result list. +-- +-- === Worked Example +-- +-- >>> let counts = countByCategory canonicalMatrix +-- >>> all (\(_, c) -> c > 0) counts +-- True +countByCategory :: StandardizationMatrix -> [(AssetCategory, Int)] +countByCategory matrix = + map (\cat -> (cat, length (assetsForCategory cat matrix))) (matrixDimensions matrix) diff --git a/src/Gachi/Sync/Remote.hs b/src/Gachi/Sync/Remote.hs new file mode 100644 --- /dev/null +++ b/src/Gachi/Sync/Remote.hs @@ -0,0 +1,826 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Module: Gachi.Sync.Remote +-- Description: Multi-remote topology management, provider compliance auditing, and replication synchronization +-- +-- This module implements Milestone 3.4 of the Gachi strategic roadmap (~/src/PLAN.md §1.A). +-- It establishes declarative models and operational synchronization routines for +-- the 5-remote ecosystem replication topology (Dimension 6), enforcing sovereign +-- peer-to-peer distribution and provider compliance auditing across all checkouts. +-- +-- = Architectural Context & Invariants +-- +-- In accordance with Note [Ecosystem Standardization Invariants] +-- [ref:note-ecosystem-standardization], Note [Cross-Repository Standardization Matrix and Audit Semantics] +-- [ref:note-standardization-matrix], and Note [Multi-Remote Replication Topology and Provider Compliance] +-- [ref:note-remote-topology], all ecosystem repositories replicate across five +-- canonical remotes, balancing decentralized sovereignty, community resilience, +-- and global developer accessibility. +-- +-- == Note [Multi-Remote Replication Topology and Provider Compliance] +-- [tag:note-remote-topology] +-- +-- Relying on a single proprietary hosting forge (such as GitHub) introduces an +-- existential single point of failure, censorship vulnerability, and platform +-- lock-in. A healthy open-source ecosystem must maintain sovereign, automated +-- replication across heterogeneous governance tiers: +-- +-- 1. __Sovereign Peer-to-Peer Identity ('RemotePeerToPeer'):__ +-- Anchored on Radicle (@rad@: @rad://@). Uses cryptographic +-- DIDs and local gossip networks without centralized servers or single-entity +-- terms of service. Guarantees immutable ownership and censorship resistance. +-- +-- 2. __Community Non-Profit Forges ('RemoteCommunity'):__ +-- Mirrored to trusted non-profit community instances: +-- * __Framagit__ (@framagit@: @git@framagit.org:NadiaYvette/.git@): +-- GitLab Community Edition operated by the French digital commons non-profit Framasoft. +-- * __Disroot__ (@disroot@: @git@git.disroot.org:NadiaYvette/.git@): +-- Forgejo/Gitea instance operated by the privacy-centric Disroot Foundation. +-- +-- 3. __Global Commercial Mirrors ('RemoteCommercial'):__ +-- Maintained for discoverability, high-bandwidth package ingestion, and CI compute: +-- * __GitHub__ (@github@: @git@github.com:NadiaYvette/.git@): +-- High-resource commercial runner execution and global contributor visibility. +-- * __GitCode__ (@gitcode@: @git@gitcode.com:NadiaYvette/.git@): +-- High-speed regional mirror ensuring accessibility across global network partitions. +-- +-- 4. __Aggregate Multi-Target Push Remote ('RemoteAggregate'):__ +-- An optional convenience remote (@all@) configured with multiple push URLs +-- enabling a single command (@git push all master@) to broadcast changes +-- synchronously across all configured mirrors. +-- +-- == Provider Compliance & Exclusion Policy +-- +-- Not all Git hosting services are compatible with ecosystem governance invariants: +-- * __SourceHut Exclusion:__ Services such as SourceHut (@git.sr.ht@) enforce +-- restrictive terms of service prohibiting automated AI-assisted coding tools, +-- and require idiosyncratic email-only patch submission workflows that reject +-- standard Git push replication and pull request verification. Consequently, +-- SourceHut remotes are formally excluded and flagged as policy violations. +-- * __Plaintext Insecurity:__ Plaintext HTTP remotes (@http://@) without TLS +-- encryption are strictly prohibited to prevent man-in-the-middle attacks. +-- +-- The remote management engine automatically audits target repositories, flags +-- non-compliant remotes for removal, detects missing canonical remotes, and provides +-- atomic synchronization to restore the canonical 5-remote topology. +-- +-- == Operational Transition Pipeline +-- +-- Remote synchronization progresses through a three-stage functional pipeline: +-- +-- 1. __Inspection ('auditRemoteTopology' / 'auditRemoteTopologyQuick'):__ +-- Executes @git remote -v@ within the checkout, parses the output via +-- 'parseGitRemoteOutput', and compares existing remotes against expected +-- canonical specifications via 'evaluateRemoteTopology'. +-- +-- 2. __Planning ('computeRemoteSyncPlan'):__ +-- Purity-preserving step transforming 'RemoteTopologyReport' into an atomic +-- 'RemoteSyncPlan' composed of concrete 'RemoteSyncAction' mutations. +-- +-- 3. __Execution ('executeRemoteSyncPlan' / 'syncRemoteTopologyQuick'):__ +-- Applies the plan under 'SyncMode'. In 'DryRun', preview logs are produced; +-- in 'ApplySync', idempotent Git commands mutate the repository configuration. +-- +-- = Worked Example: Auditing Remote Topology +-- +-- >>> import Gachi.Schema.Project (defaultProject, Author(..)) +-- >>> import Gachi.Sync.Remote +-- >>> let proj = defaultProject "gachi" (Author "Nadia" "nadia@example.com") +-- >>> let existing = parseGitRemoteOutput "github\tgit@github.com:NadiaYvette/gachi.git (fetch)\n" +-- >>> let report = evaluateRemoteTopology "gachi" (defaultRemoteSpecsFor "gachi") existing +-- >>> remoteMissingCount report >= 4 +-- True +-- >>> isProviderCompliant "git@github.com:NadiaYvette/gachi.git" +-- True +-- >>> isProviderCompliant "git@git.sr.ht:~user/gachi" +-- False +module Gachi.Sync.Remote + ( -- * Remote Category & Compliance Types + RemoteCategory(..) + , ProviderPolicy(..) + , ConfiguredRemote(..) + , RemoteAuditStatus(..) + , RemoteAuditResult(..) + , RemoteTopologyReport(..) + , RemoteSyncAction(..) + , RemoteSyncPlan(..) + + -- * Provider Compliance & Policy Combinators + , classifyProvider + , isProviderCompliant + , filterCompliantRemotes + , filterNonCompliantRemotes + , normalizeRemoteUrl + , urlsMatch + + -- * Canonical Remote Topology Synthesis + , canonicalRemoteNames + , isCanonicalRemoteName + , canonicalRemoteSpecs + , defaultRemoteSpecsFor + , defaultOwnerName + + -- * Deterministic Parsing & Pure Evaluation + , parseGitRemoteOutput + , evaluateRemoteTopology + , computeRemoteSyncPlan + , formatRemoteReport + , formatRemoteSyncPlan + + -- * Live Filesystem IO Integration + , queryGitRemotes + , auditRemoteTopology + , auditRemoteTopologyQuick + , executeRemoteSyncPlan + , syncRemoteTopology + , syncRemoteTopologyQuick + ) where + +import Control.Exception (SomeException, catch) +import Data.Either (lefts, rights) +import qualified Data.Map.Strict as Map +import Data.Maybe (fromMaybe, mapMaybe) +import Data.Text (Text) +import qualified Data.Text as T +import GHC.Generics (Generic) +import System.Directory (canonicalizePath, doesFileExist) +import System.Exit (ExitCode(..)) +import System.FilePath ((), takeFileName) +import System.Process (readProcessWithExitCode) + +import Gachi.Schema.Dhall (decodeProjectFile) +import Gachi.Schema.Project + ( Author(..) + , Project + , RemoteSpec(..) + , defaultProject + , projectName + , projectRemotes + , remoteName + , remoteUrl + ) +import Gachi.Sync.Types (SyncMode(..)) + +-------------------------------------------------------------------------------- +-- 1. Remote Category & Compliance Types +-------------------------------------------------------------------------------- + +-- | Architectural category governing a Git remote in the replication topology. +-- +-- Categorizes remotes according to their cryptographic governance model, +-- funding substrate, and infrastructure reliability. +-- +-- === The Five Architectural Categories +-- +-- 1. __Sovereign Peer-to-Peer ('RemotePeerToPeer'):__ +-- Radicle decentralized nodes identified by cryptographic public key DIDs +-- (@rad://@). Guarantees censorship resistance and local availability +-- without reliance on centralized intermediary servers or commercial terms of service. +-- +-- 2. __Community Non-Profit ('RemoteCommunity'):__ +-- Open-source community forges operated by public-interest foundations (e.g. Framagit +-- by Framasoft, Disroot by Disroot Foundation). Guarantees data portability, privacy, +-- and community stewardship. +-- +-- 3. __Commercial Mirrors ('RemoteCommercial'):__ +-- High-bandwidth commercial Git hosting providers (e.g. GitHub, GitCode) offering +-- extensive CI compute capacity, edge CDN acceleration, and global discoverability. +-- +-- 4. __Aggregate Multi-Push Remote ('RemoteAggregate'):__ +-- Convenience remote identifier (typically @all@) configured with multiple push +-- URLs allowing a single @git push all master@ command to replicate commits across +-- all mirrors synchronously. +-- +-- 5. __Custom Endpoint ('RemoteCustom'):__ +-- User-defined remotes (such as private staging forges or personal home servers) +-- operating alongside the standard 5-remote topology. +data RemoteCategory + = RemotePeerToPeer + -- ^ Sovereign peer-to-peer storage (Radicle DIDs: @rad://@). + | RemoteCommunity + -- ^ Non-profit public-interest community instances (Framagit, Disroot). + | RemoteCommercial + -- ^ Global commercial cloud mirrors (GitHub, GitCode). + | RemoteAggregate + -- ^ Multi-target aggregate push remote (@all@). + | RemoteCustom + -- ^ User-defined custom remote outside the standard 5-forge topology. + deriving stock (Eq, Show, Ord, Enum, Bounded, Generic) + +-- | Hosting provider compliance classification result. +-- +-- Distinguishes permitted, policy-compliant repository hosting platforms from +-- excluded services that violate ecosystem governance rules. +-- +-- === Exclusion Rationale +-- +-- Hosting providers that enforce terms of service restricting automated AI pair +-- programming tooling (e.g. SourceHut) or require proprietary patch email workflows +-- that forbid Git push replication are classified under 'ProviderExcluded'. +-- Plaintext HTTP transport (@http://@) is similarly prohibited due to lack of encryption. +data ProviderPolicy + = ProviderAllowed !Text + -- ^ Compliant hosting provider with human-readable provider name (e.g., @"GitHub"@). + | ProviderExcluded !Text !Text + -- ^ Non-compliant provider name and detailed rationale for exclusion. + deriving stock (Eq, Show, Generic) + +-- | Represents a Git remote physically configured in a local checkout. +-- +-- Encapsulates the remote name, optional fetch URL, and a list of push URLs +-- as discovered via porcelain Git commands (@git remote -v@). +data ConfiguredRemote = ConfiguredRemote + { crName :: !Text + -- ^ Remote identifier string (e.g., @"github"@, @"rad"@, @"origin"@). + , crFetchUrl :: !(Maybe Text) + -- ^ Primary fetch URL configured for the remote. + , crPushUrls :: ![Text] + -- ^ List of push URLs associated with the remote. + } deriving stock (Eq, Show, Generic) + +-- | Detailed inspection status for an individual Git remote. +-- +-- Classified during repository remote topology auditing against expected canonical specs. +data RemoteAuditStatus + = RemoteCompliant + -- ^ Remote exists, points to compliant provider, and matches expected canonical URL. + | RemoteMissing + -- ^ Canonical remote is absent from the local repository Git configuration. + | RemoteUrlDrift !Text !Text + -- ^ Remote exists but configured URL diverges from expected canonical URL. + -- Carries (ActualUrl, ExpectedUrl). + | RemoteNonCompliant !Text !Text + -- ^ Remote points to a prohibited or non-compliant provider. + -- Carries (ProviderName, ExclusionRationale). + | RemoteUnknown + -- ^ Remote exists and is compliant, but is not part of the standard 5-remote topology. + deriving stock (Eq, Show, Generic) + +-- | Audit finding for a single evaluated remote. +data RemoteAuditResult = RemoteAuditResult + { resRemoteName :: !Text + -- ^ Name of the remote evaluated (e.g. @"github"@, @"srht"@). + , resExpectedUrl :: !(Maybe Text) + -- ^ Expected canonical URL if this remote is part of the standard topology. + , resActualUrl :: !(Maybe Text) + -- ^ Actual configured URL detected in Git metadata. + , resStatus :: !RemoteAuditStatus + -- ^ Audit classification outcome. + } deriving stock (Eq, Show, Generic) + +-- | Comprehensive audit report covering a repository's remote topology. +data RemoteTopologyReport = RemoteTopologyReport + { reportRepoDir :: !FilePath + -- ^ Filesystem path of the audited repository checkout. + , reportProject :: !Text + -- ^ Declared project name. + , reportRemotes :: ![RemoteAuditResult] + -- ^ List of findings across all audited remotes. + , reportCompliant :: !Bool + -- ^ Overall compliance flag (True iff all canonical remotes exist and 0 non-compliant remotes exist). + , remoteMissingCount :: !Int + -- ^ Total count of missing canonical remotes. + , remoteDriftCount :: !Int + -- ^ Total count of remotes exhibiting URL configuration drift. + , remoteNonCompliantCount :: !Int + -- ^ Total count of prohibited or non-compliant remotes detected. + } deriving stock (Eq, Show, Generic) + +-- | Atomic mutation action planned to reconcile remote topology drift. +data RemoteSyncAction + = ActionAddRemote !Text !Text + -- ^ Proposes executing @git remote add @. + | ActionSetUrl !Text !Text + -- ^ Proposes executing @git remote set-url @ to correct URL drift. + | ActionAddPushUrl !Text !Text + -- ^ Proposes executing @git remote set-url --add --push @ for multi-push remotes. + | ActionRemoveRemote !Text + -- ^ Proposes executing @git remote remove @ to purge non-compliant remotes. + | ActionRemoteNoOp !Text + -- ^ Remote is fully compliant; zero mutation required. + deriving stock (Eq, Show, Generic) + +-- | Operational plan containing atomic actions to align a repository's remotes. +data RemoteSyncPlan = RemoteSyncPlan + { planTargetRepo :: !FilePath + -- ^ Target repository path. + , planProject :: !Text + -- ^ Project identifier. + , planRemoteActions :: ![RemoteSyncAction] + -- ^ Ordered sequence of remote configuration actions. + , planAddCount :: !Int + -- ^ Number of remote addition actions planned. + , planUpdateCount :: !Int + -- ^ Number of URL update actions planned. + , planRemoveCount :: !Int + -- ^ Number of non-compliant remote removal actions planned. + } deriving stock (Eq, Show, Generic) + +-------------------------------------------------------------------------------- +-- 2. Provider Compliance & Policy Combinators +-------------------------------------------------------------------------------- + +-- | Default GitHub and multi-forge account organization name. +-- +-- The authoritative account identifier across commercial and community Git forges. +defaultOwnerName :: Text +defaultOwnerName = "NadiaYvette" + +-- | Classifies a remote URL according to ecosystem hosting provider compliance rules. +-- +-- === Evaluated Policies & Threat Model +-- +-- 1. __Plaintext HTTP Transport Security:__ +-- Any URL starting with @"http://"@ is rejected due to lack of cryptographic transport +-- security. In accordance with zero-trust network principles, unencrypted endpoints +-- are susceptible to credential harvesting, commit manipulation, and active +-- man-in-the-middle code injection. Compliant endpoints must employ either SSH +-- (@git\@@) or TLS-wrapped HTTPS (@https:\/\/@). +-- +-- 2. __SourceHut Platform Exclusion:__ +-- URLs matching @"sr.ht"@ or @"sourcehut"@ are formally prohibited. SourceHut's terms +-- of service restrict automated AI pair programming assistants, and the platform +-- mandates an email-driven patch workflow that deliberately rejects push-based Git +-- replication, branch tracking, and webhook-driven multi-forge CI automation. +-- +-- 3. __Approved Multi-Forge Targets:__ +-- * __GitHub__ (@github.com@): Commercial primary mirror for high-capacity runner CI. +-- * __GitCode__ (@gitcode.com@): Regional mirror guaranteeing high availability. +-- * __Framagit__ (@framagit.org@): Community GitLab mirror operated by Framasoft. +-- * __Disroot__ (@disroot.org@): Privacy-centric Forgejo mirror by Disroot Foundation. +-- * __Radicle__ (@rad://@): Sovereign decentralized peer-to-peer repository storage. +classifyProvider :: Text -> ProviderPolicy +classifyProvider rawUrl + -- Check plaintext transport insecurity + | "http://" `T.isPrefixOf` urlLower = + ProviderExcluded "Insecure Plaintext HTTP" + "Plaintext HTTP remotes are prohibited; use SSH (git@) or HTTPS (https://)." + -- Check SourceHut exclusion policy + | "sr.ht" `T.isInfixOf` urlLower || "sourcehut" `T.isInfixOf` urlLower = + ProviderExcluded "SourceHut (git.sr.ht)" + "SourceHut is prohibited due to terms restricting automated AI tooling and incompatible email-only workflows." + -- Approved canonical providers + | "github.com" `T.isInfixOf` urlLower = + ProviderAllowed "GitHub" + | "gitcode.com" `T.isInfixOf` urlLower = + ProviderAllowed "GitCode" + | "framagit.org" `T.isInfixOf` urlLower || "gitlab" `T.isInfixOf` urlLower = + ProviderAllowed "Framagit (GitLab CE)" + | "disroot.org" `T.isInfixOf` urlLower || "forgejo" `T.isInfixOf` urlLower || "gitea" `T.isInfixOf` urlLower = + ProviderAllowed "Disroot (Forgejo)" + | "rad://" `T.isPrefixOf` rawUrl = + ProviderAllowed "Radicle P2P" + -- Custom compliant host + | otherwise = + ProviderAllowed "Custom Compliant Host" + where + urlLower = T.toLower rawUrl + +-- | Predicate checking whether a remote URL satisfies provider compliance rules. +isProviderCompliant :: Text -> Bool +isProviderCompliant checkUrl = case classifyProvider checkUrl of + ProviderAllowed _ -> True + ProviderExcluded _ _ -> False + +-- | Filters a list of 'RemoteSpec' records, retaining only compliant remotes. +-- +-- Guaranteed to discard any remote pointing to prohibited services (such as +-- SourceHut) or insecure plaintext HTTP endpoints. +-- +-- === Invariants +-- +-- All remotes in the output satisfy 'isProviderCompliant'. +filterCompliantRemotes :: [RemoteSpec] -> [RemoteSpec] +filterCompliantRemotes = filter (isProviderCompliant . remoteUrl) + +-- | Extracts non-compliant 'RemoteSpec' records paired with their exclusion rationale. +-- +-- Returns a list of @(remote, rationale)@ pairs identifying prohibited remotes +-- that must be purged or updated during topology synchronization. +filterNonCompliantRemotes :: [RemoteSpec] -> [(RemoteSpec, Text)] +filterNonCompliantRemotes = mapMaybe extractExcluded + where + extractExcluded r = case classifyProvider (remoteUrl r) of + ProviderExcluded _ reason -> Just (r, reason) + ProviderAllowed _ -> Nothing + +-- | Normalizes a Git remote URL for semantic equivalence comparison. +-- +-- Strips trailing @.git@ suffixes, trailing slashes, and converts to lowercase. +-- +-- === Worked Example +-- +-- >>> normalizeRemoteUrl "git@github.com:NadiaYvette/gachi.git" +-- "git@github.com:nadiayvette/gachi" +-- >>> normalizeRemoteUrl "https://github.com/NadiaYvette/gachi/" +-- "https://github.com/nadiayvette/gachi" +normalizeRemoteUrl :: Text -> Text +normalizeRemoteUrl raw = + let lower = T.toLower (T.strip raw) + noSlash = if "/" `T.isSuffixOf` lower then T.dropEnd 1 lower else lower + noGit = if ".git" `T.isSuffixOf` noSlash then T.dropEnd 4 noSlash else noSlash + in noGit + +-- | Compares two Git remote URLs for semantic equivalence. +-- +-- Considers SSH and HTTPS URLs targeting the same repository on the same forge as equivalent, +-- and ignores trailing @.git@ extensions and trailing slashes. +urlsMatch :: Text -> Text -> Bool +urlsMatch u1 u2 = + let n1 = normalizeRemoteUrl u1 + n2 = normalizeRemoteUrl u2 + in n1 == n2 || stripProtocol n1 == stripProtocol n2 + where + stripProtocol u = + let dropPrefix' pfx t = if pfx `T.isPrefixOf` t then T.drop (T.length pfx) t else t + noScheme = dropPrefix' "https://" (dropPrefix' "http://" (dropPrefix' "ssh://" (dropPrefix' "rad://" u))) + noUser = dropPrefix' "git@" noScheme + in T.replace ":" "/" noUser + +-------------------------------------------------------------------------------- +-- 3. Canonical Remote Topology Synthesis +-------------------------------------------------------------------------------- + +-- | Canonical remote names comprising the authoritative 5-forge replication topology. +canonicalRemoteNames :: [Text] +canonicalRemoteNames = ["rad", "github", "gitcode", "framagit", "disroot"] + +-- | Predicate checking whether a remote name belongs to the canonical 5-forge topology. +isCanonicalRemoteName :: Text -> Bool +isCanonicalRemoteName candidateName = candidateName `elem` canonicalRemoteNames + +-- | Synthesizes the canonical 5-remote topology for a given account owner and project name. +-- +-- Constructs RemoteSpec entries for: +-- 1. @"rad"@: Radicle decentralized peer-to-peer URN. +-- 2. @"github"@: GitHub commercial mirror. +-- 3. @"gitcode"@: GitCode regional mirror. +-- 4. @"framagit"@: Framagit community GitLab mirror. +-- 5. @"disroot"@: Disroot community Forgejo mirror. +canonicalRemoteSpecs :: Text -> Text -> [RemoteSpec] +canonicalRemoteSpecs owner pName = + [ RemoteSpec "rad" ("rad://" <> pName) + , RemoteSpec "github" ("git@github.com:" <> owner <> "/" <> pName <> ".git") + , RemoteSpec "gitcode" ("git@gitcode.com:" <> owner <> "/" <> pName <> ".git") + , RemoteSpec "framagit" ("git@framagit.org:" <> owner <> "/" <> pName <> ".git") + , RemoteSpec "disroot" ("git@git.disroot.org:" <> owner <> "/" <> pName <> ".git") + ] + +-- | Synthesizes the default 5-remote topology using the standard owner (@NadiaYvette@). +defaultRemoteSpecsFor :: Text -> [RemoteSpec] +defaultRemoteSpecsFor = canonicalRemoteSpecs defaultOwnerName + +-------------------------------------------------------------------------------- +-- 4. Deterministic Parsing & Pure Evaluation +-------------------------------------------------------------------------------- + +-- | Pure parser transforming the output of @git remote -v@ into structured 'ConfiguredRemote' records. +-- +-- Handles multiple push URLs and separate fetch/push specifications cleanly. +-- +-- === Format Specification +-- +-- Expected input lines follow standard Git porcelain format: +-- @TABSPACE(fetch)@ or @TABSPACE(push)@ +parseGitRemoteOutput :: Text -> [ConfiguredRemote] +parseGitRemoteOutput raw = + let rawLines = filter (not . T.null . T.strip) (T.lines raw) + parsedEntries = mapMaybe parseLine rawLines + grouped = foldl insertEntry Map.empty parsedEntries + in map toConfigured (Map.toList grouped) + where + parseLine :: Text -> Maybe (Text, Text, Bool) + parseLine line = + let parts = T.words line + in case parts of + (rName : rUrl : rType : _) -> + let isPush = "(push)" `T.isPrefixOf` rType + in Just (rName, rUrl, isPush) + _ -> Nothing + + insertEntry acc (rName, rUrl, isPush) = + let (mFetch, pushes) = fromMaybe (Nothing, []) (Map.lookup rName acc) + updated = if isPush + then (mFetch, pushes ++ [rUrl | rUrl `notElem` pushes]) + else (Just rUrl, pushes) + in Map.insert rName updated acc + + toConfigured (rName, (mFetch, pushes)) = + ConfiguredRemote + { crName = rName + , crFetchUrl = mFetch + , crPushUrls = pushes + } + +-- | Pure evaluation routine assessing configured remotes against expected canonical specs. +-- +-- Detects: +-- * Missing canonical remotes that must be added. +-- * Remotes exhibiting URL drift requiring reconciliation. +-- * Non-compliant or prohibited remotes (e.g. SourceHut) that must be removed. +-- * Unknown remotes configured outside the canonical topology. +evaluateRemoteTopology + :: Text + -- ^ Project name identifier. + -> [RemoteSpec] + -- ^ Expected canonical remote specifications. + -> [ConfiguredRemote] + -- ^ Physically configured remotes parsed from Git. + -> RemoteTopologyReport +evaluateRemoteTopology pName expected configured = + let configMap = Map.fromList [(crName r, r) | r <- configured] + expectedNames = [remoteName r | r <- expected] + + -- 1. Evaluate expected canonical remotes + expectedResults = map (evaluateExpected configMap) expected + + -- 2. Evaluate extra/unknown configured remotes + extraConfigured = filter (\r -> crName r `notElem` expectedNames) configured + extraResults = map evaluateExtra extraConfigured + + allResults = expectedResults ++ extraResults + + missingC = length [() | r <- allResults, case resStatus r of RemoteMissing -> True; _ -> False] + driftC = length [() | r <- allResults, case resStatus r of RemoteUrlDrift {} -> True; _ -> False] + nonCompC = length [() | r <- allResults, case resStatus r of RemoteNonCompliant {} -> True; _ -> False] + + isCompliant = missingC == 0 && driftC == 0 && nonCompC == 0 + in RemoteTopologyReport + { reportRepoDir = "" + , reportProject = pName + , reportRemotes = allResults + , reportCompliant = isCompliant + , remoteMissingCount = missingC + , remoteDriftCount = driftC + , remoteNonCompliantCount = nonCompC + } + where + evaluateExpected configMap spec = + let rName = remoteName spec + expUrl = remoteUrl spec + in case Map.lookup rName configMap of + Nothing -> + RemoteAuditResult rName (Just expUrl) Nothing RemoteMissing + Just conf -> + let actUrl = fromMaybe "" (crFetchUrl conf) + in case classifyProvider actUrl of + ProviderExcluded pName' reason -> + RemoteAuditResult rName (Just expUrl) (Just actUrl) (RemoteNonCompliant pName' reason) + ProviderAllowed _ -> + if urlsMatch actUrl expUrl + then RemoteAuditResult rName (Just expUrl) (Just actUrl) RemoteCompliant + else RemoteAuditResult rName (Just expUrl) (Just actUrl) (RemoteUrlDrift actUrl expUrl) + + evaluateExtra conf = + let rName = crName conf + actUrl = fromMaybe "" (crFetchUrl conf) + in case classifyProvider actUrl of + ProviderExcluded pName' reason -> + RemoteAuditResult rName Nothing (Just actUrl) (RemoteNonCompliant pName' reason) + ProviderAllowed _ -> + RemoteAuditResult rName Nothing (Just actUrl) RemoteUnknown + +-- | Computes a deterministic 'RemoteSyncPlan' from a 'RemoteTopologyReport'. +-- +-- Translates audit findings into concrete Git actions: +-- * 'RemoteMissing' -> 'ActionAddRemote' +-- * 'RemoteUrlDrift' -> 'ActionSetUrl' +-- * 'RemoteNonCompliant' -> 'ActionRemoveRemote' +computeRemoteSyncPlan :: RemoteTopologyReport -> RemoteSyncPlan +computeRemoteSyncPlan report = + let actions = mapMaybe actionForResult (reportRemotes report) + adds = length [() | ActionAddRemote {} <- actions] + updates = length [() | ActionSetUrl {} <- actions] + removes = length [() | ActionRemoveRemote {} <- actions] + in RemoteSyncPlan + { planTargetRepo = reportRepoDir report + , planProject = reportProject report + , planRemoteActions = actions + , planAddCount = adds + , planUpdateCount = updates + , planRemoveCount = removes + } + where + actionForResult res = case resStatus res of + RemoteMissing -> + case resExpectedUrl res of + Just expUrl' -> Just (ActionAddRemote (resRemoteName res) expUrl') + Nothing -> Nothing + RemoteUrlDrift _ expUrl' -> + Just (ActionSetUrl (resRemoteName res) expUrl') + RemoteNonCompliant _ _ -> + Just (ActionRemoveRemote (resRemoteName res)) + RemoteCompliant -> + Just (ActionRemoteNoOp (resRemoteName res)) + RemoteUnknown -> + Nothing + +-- | Formats a 'RemoteTopologyReport' into a clean ASCII diagnostic table for CLI rendering. +formatRemoteReport :: RemoteTopologyReport -> Text +formatRemoteReport report = + let header = + [ "==========================================================================================" + , " Gachi Multi-Remote Topology Audit: " <> reportProject report + , " Note [Multi-Remote Replication Topology and Provider Compliance] [ref:note-remote-topology]" + , "==========================================================================================" + , " Remote Name | Status | Configured / Actual URL" + , "----------------+---------------+---------------------------------------------------------" + ] + rows = map formatResultRow (reportRemotes report) + summary = + [ "----------------+---------------+---------------------------------------------------------" + , " Total Evaluated: " <> T.pack (show (length (reportRemotes report))) + <> " | Missing: " <> T.pack (show (remoteMissingCount report)) + <> " | Drifted: " <> T.pack (show (remoteDriftCount report)) + <> " | Prohibited: " <> T.pack (show (remoteNonCompliantCount report)) + , " Compliance: " <> (if reportCompliant report then "PASS (Topology Fully Aligned)" else "DRIFT DETECTED") + , "==========================================================================================" + ] + in T.unlines (header ++ rows ++ summary) + where + formatResultRow res = + let nameCol = T.justifyLeft 14 ' ' (resRemoteName res) + statusCol = T.justifyLeft 13 ' ' (statusLabel (resStatus res)) + urlCol = fromMaybe "(none)" (resActualUrl res) + in " " <> nameCol <> " | " <> statusCol <> " | " <> urlCol + + statusLabel RemoteCompliant = "COMPLIANT" + statusLabel RemoteMissing = "MISSING" + statusLabel (RemoteUrlDrift {}) = "URL DRIFT" + statusLabel (RemoteNonCompliant {}) = "PROHIBITED" + statusLabel RemoteUnknown = "CUSTOM" + +-- | Formats a 'RemoteSyncPlan' into a clean ASCII summary table. +formatRemoteSyncPlan :: RemoteSyncPlan -> Text +formatRemoteSyncPlan plan = + let header = + [ "==========================================================================================" + , " Gachi Remote Synchronization Plan: " <> planProject plan + , "==========================================================================================" + ] + rows = map formatActionRow (planRemoteActions plan) + summary = + [ "------------------------------------------------------------------------------------------" + , " Planned Actions: " <> T.pack (show (length (planRemoteActions plan))) + <> " (Add: " <> T.pack (show (planAddCount plan)) + <> ", Update: " <> T.pack (show (planUpdateCount plan)) + <> ", Remove: " <> T.pack (show (planRemoveCount plan)) <> ")" + , "==========================================================================================" + ] + in T.unlines (header ++ rows ++ summary) + where + formatActionRow (ActionAddRemote rName targetUrl) = + " [ADD REMOTE] " <> rName <> " -> " <> targetUrl + formatActionRow (ActionSetUrl rName targetUrl) = + " [UPDATE URL] " <> rName <> " -> " <> targetUrl + formatActionRow (ActionAddPushUrl rName targetUrl) = + " [ADD PUSH URL] " <> rName <> " -> " <> targetUrl + formatActionRow (ActionRemoveRemote rName) = + " [REMOVE REMOTE] " <> rName <> " (Purging prohibited provider)" + formatActionRow (ActionRemoteNoOp rName) = + " [NO-OP] " <> rName <> " (Already aligned)" + +-------------------------------------------------------------------------------- +-- 5. Live Filesystem IO Integration +-------------------------------------------------------------------------------- + +-- | Queries Git remotes physically configured in a local repository checkout. +-- +-- Executes @git -C remote -v@ and parses the resulting output. +queryGitRemotes :: FilePath -> IO (Either Text [ConfiguredRemote]) +queryGitRemotes repoRoot = (do + (exitCode, stdout, stderr) <- readProcessWithExitCode "git" ["-C", repoRoot, "remote", "-v"] "" + case exitCode of + ExitSuccess -> pure (Right (parseGitRemoteOutput (T.pack stdout))) + ExitFailure code -> + pure (Left ("Git remote query failed with exit code " <> T.pack (show code) <> ": " <> T.pack stderr)) + ) `catch` (\(e :: SomeException) -> + pure (Left ("Exception querying git remotes: " <> T.pack (show e)))) + +-- | Audits the physical remote topology of a repository checkout against canonical expectations. +auditRemoteTopology :: FilePath -> Project -> IO RemoteTopologyReport +auditRemoteTopology repoRoot proj = do + let pName = projectName proj + expected = case projectRemotes proj of + [] -> defaultRemoteSpecsFor pName + rms -> filterCompliantRemotes rms + res <- queryGitRemotes repoRoot + case res of + Left _ -> + -- If git fails, report all expected as missing + pure (evaluateRemoteTopology pName expected []) + { reportRepoDir = repoRoot } + Right configured -> + pure (evaluateRemoteTopology pName expected configured) + { reportRepoDir = repoRoot } + +-- | Executes a 'RemoteSyncPlan' in either 'DryRun' or 'ApplySync' mode. +-- +-- In 'DryRun' mode: emits descriptive action logs without mutating Git configuration. +-- In 'ApplySync' mode: invokes Git commands to add, update, or remove remotes. +executeRemoteSyncPlan :: SyncMode -> RemoteSyncPlan -> IO (Either Text [Text]) +executeRemoteSyncPlan DryRun plan = + pure (Right [formatActionLog a | a <- planRemoteActions plan]) + where + formatActionLog (ActionAddRemote n u) = "DRY RUN: would execute 'git remote add " <> n <> " " <> u <> "'" + formatActionLog (ActionSetUrl n u) = "DRY RUN: would execute 'git remote set-url " <> n <> " " <> u <> "'" + formatActionLog (ActionAddPushUrl n u) = "DRY RUN: would execute 'git remote set-url --add --push " <> n <> " " <> u <> "'" + formatActionLog (ActionRemoveRemote n) = "DRY RUN: would execute 'git remote remove " <> n <> "'" + formatActionLog (ActionRemoteNoOp n) = "DRY RUN: no-op for " <> n + +executeRemoteSyncPlan ApplySync plan = do + let repo = planTargetRepo plan + results <- mapM (applyAction repo) (planRemoteActions plan) + let errors = lefts results + if null errors + then pure (Right (rights results)) + else pure (Left (T.intercalate "; " errors)) + where + -- Executes 'git remote add ' in target repository + applyAction repo (ActionAddRemote n u) = do + (c, _, err) <- readProcessWithExitCode "git" ["-C", repo, "remote", "add", T.unpack n, T.unpack u] "" + case c of + ExitSuccess -> pure (Right ("Added remote '" <> n <> "' pointing to " <> u)) + ExitFailure code -> pure (Left ("Failed to add remote '" <> n <> "' (code " <> T.pack (show code) <> "): " <> T.pack err)) + + -- Executes 'git remote set-url ' to reconcile URL drift + applyAction repo (ActionSetUrl n u) = do + (c, _, err) <- readProcessWithExitCode "git" ["-C", repo, "remote", "set-url", T.unpack n, T.unpack u] "" + case c of + ExitSuccess -> pure (Right ("Updated URL for remote '" <> n <> "' to " <> u)) + ExitFailure code -> pure (Left ("Failed to update remote '" <> n <> "' (code " <> T.pack (show code) <> "): " <> T.pack err)) + + -- Executes 'git remote set-url --add --push ' for multi-push targets + applyAction repo (ActionAddPushUrl n u) = do + (c, _, err) <- readProcessWithExitCode "git" ["-C", repo, "remote", "set-url", "--add", "--push", T.unpack n, T.unpack u] "" + case c of + ExitSuccess -> pure (Right ("Added push URL for remote '" <> n <> "': " <> u)) + ExitFailure _code -> pure (Left ("Failed to add push URL for remote '" <> n <> "': " <> T.pack err)) + + -- Executes 'git remote remove ' to purge prohibited or non-compliant providers + applyAction repo (ActionRemoveRemote n) = do + (c, _, err) <- readProcessWithExitCode "git" ["-C", repo, "remote", "remove", T.unpack n] "" + case c of + ExitSuccess -> pure (Right ("Removed prohibited remote '" <> n <> "'")) + ExitFailure _code -> pure (Left ("Failed to remove remote '" <> n <> "': " <> T.pack err)) + + -- No-op for already aligned remotes + applyAction _ (ActionRemoteNoOp n) = + pure (Right ("Remote '" <> n <> "' is already aligned.")) + +-- | High-level orchestrator auditing and synchronizing remote topology for a project. +-- +-- First audits the local checkout using 'auditRemoteTopology', derives an atomic +-- 'RemoteSyncPlan' via 'computeRemoteSyncPlan', and executes the planned mutations +-- under the specified 'SyncMode' ('DryRun' simulation or 'ApplySync' execution). +syncRemoteTopology :: SyncMode -> FilePath -> Project -> IO (Either Text [Text]) +syncRemoteTopology mode repoRoot proj = do + report <- auditRemoteTopology repoRoot proj + let plan = computeRemoteSyncPlan report + executeRemoteSyncPlan mode plan + +-- | Zero-configuration remote topology inspection routine with automatic project inference. +-- +-- Inspects the local checkout directory for @project.dhall@. When present, hermetically +-- decodes the declarative project specification to extract configured remotes. +-- When absent, derives a default project model using the checkout directory's canonical +-- basename and standard ecosystem owner conventions (@NadiaYvette@). +-- +-- === Operational Safety +-- +-- This operation is strictly read-only and will never alter Git configuration or +-- files on disk. +auditRemoteTopologyQuick :: FilePath -> IO RemoteTopologyReport +auditRemoteTopologyQuick repoRoot = do + absRoot <- canonicalizePath repoRoot + let dhallPath = absRoot "project.dhall" + hasDhall <- doesFileExist dhallPath + proj <- if hasDhall + then decodeProjectFile dhallPath `catch` (\(_ :: SomeException) -> do + let inferredName = T.pack (takeFileName absRoot) + pure (defaultProject inferredName (Author "Nadia Yvette Chambers" "nadia.yvette.chambers@ik.me"))) + else do + let inferredName = T.pack (takeFileName absRoot) + pure (defaultProject inferredName (Author "Nadia Yvette Chambers" "nadia.yvette.chambers@ik.me")) + auditRemoteTopology absRoot proj + +-- | High-level zero-configuration remote topology synchronization orchestrator. +-- +-- Automatically resolves project metadata via 'auditRemoteTopologyQuick', computes the +-- declarative synchronization plan, and applies or simulates the required remote +-- adjustments according to 'SyncMode'. +-- +-- Returns a tuple containing the evaluated 'RemoteTopologyReport' and the resulting +-- execution outcome (a list of descriptive log messages or an error string). +syncRemoteTopologyQuick + :: SyncMode + -> FilePath + -> IO (RemoteTopologyReport, Either Text [Text]) +syncRemoteTopologyQuick mode repoRoot = do + absRoot <- canonicalizePath repoRoot + report <- auditRemoteTopologyQuick absRoot + let plan = computeRemoteSyncPlan report + res <- executeRemoteSyncPlan mode plan + pure (report, res) diff --git a/src/Gachi/Sync/Sheaf.hs b/src/Gachi/Sync/Sheaf.hs new file mode 100644 --- /dev/null +++ b/src/Gachi/Sync/Sheaf.hs @@ -0,0 +1,932 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Module: Gachi.Sync.Sheaf +-- Description: 1-D cellular sheaf cohomology and cross-repository coherence auditor +-- +-- This module implements the 1-dimensional cellular sheaf model over the ecosystem +-- repositories (~/src/PLAN.md §1.A, Milestone 3.5). +-- +-- = Architectural Context & Homological Foundations +-- +-- In applied algebraic topology (Curry 2014, Ghrist 2014) and distributed systems +-- governance, consistency across heterogeneous multi-package repositories is formalized +-- as a 1-dimensional cellular sheaf \(\mathcal{F}\) over a cell complex \(G = (V, E)\). +-- +-- == The 1-Dimensional Cellular Sheaf Model +-- +-- 1. __0-Cells (Vertices \(v \in V\)):__ +-- Represent individual repository checkouts across @~/src/*@ (e.g. @polytropos@, +-- @gargamelle@, @sarutahiko@, @gachi@, @gongju@), augmented by an authoritative +-- canonical reference vertex (@"canonical"@) defined by the Standardization Matrix. +-- +-- 2. __1-Cells (Edges \(e = (u, v) \in E\)):__ +-- Represent shared contract obligations between repositories along ten standard +-- dimensions: compiler pinning (GHC 9.14.1), Cabal specification (3.0/3.18), +-- licensing (EUPL-1.2), Git commit trailers, pre-commit verification hooks, +-- HLint rules, CI workflows, and agent advisory context. +-- +-- 3. __Stalk Assignments:__ +-- * Vertex Stalk \(\mathcal{F}(v)\): 'RepoStalk' containing observed configuration +-- attributes extracted from the filesystem. +-- * Edge Stalk \(\mathcal{F}(e)\): 'ContractValue' representing projected contract states. +-- +-- 4. __Restriction Morphisms (\(\rho_{u \trianglelefteq e}\)):__ +-- Project the full repository state into the boundary contract language. +-- +-- 5. __Sheaf Coboundary Operator (\(\delta^0\)):__ +-- Maps 0-cochains \(C^0\) to 1-cochains \(C^1\), measuring boundary discrepancies: +-- \[ +-- \delta^0 : C^0(G; \mathcal{F}) \to C^1(G; \mathcal{F}) +-- \] +-- \[ +-- \delta^0(x)_e = (\rho_{u \trianglelefteq e}(x_u), \rho_{v \trianglelefteq e}(x_v)) +-- \] +-- +-- 6. __Cohomological Invariants:__ +-- * __0-th Cohomology \(H^0(G; \mathcal{F}) = \ker \delta^0\):__ +-- The space of harmonic global sections. When all boundary projections coincide, +-- \(\delta^0(x) = 0\), mathematically certifying total ecosystem equilibrium (0 drift). +-- * __1-st Cohomology \(H^1(G; \mathcal{F}) = \operatorname{coker} \delta^0\):__ +-- When \(\delta^0(x) \neq 0\), the non-vanishing cochains localize exact boundary +-- obstructions, pinpointing drifting repositories and breached contracts. +-- +-- See Note [Cellular Sheaf Coherence and Homological Obstruction Localization] +-- [ref:note-cellular-sheaf-coherence]. +-- +-- = Worked Example +-- +-- >>> import qualified Data.Map.Strict as Map +-- >>> let complex = buildCanonicalSheafComplex ["gachi"] +-- >>> let stalk = canonicalRepoStalk { stalkRepoName = "gachi" } +-- >>> let c0 = Cochain0 (Map.fromList [("canonical", canonicalRepoStalk), ("gachi", stalk)]) +-- >>> let (_, isHarmonic) = coboundary complex defaultEcosystemSheaf c0 +-- >>> isHarmonic +-- True +module Gachi.Sync.Sheaf + ( -- * Note Annotation + -- $note_cellular_sheaf + + -- * Cellular Complex Types + CellComplex(..) + , emptyComplex + , addVertex + , addEdge + , numVertices + , numEdges + , eulerCharacteristic + , Orientation(..) + , orientationSign + , Cell(..) + + -- * Cellular Sheaf & Cochains + , CellularSheaf(..) + , symmetricSheaf + , directionalSheaf + , Cochain0(..) + , Cochain1(..) + , CohomologyResult(..) + , SheafObstruction(..) + + -- * Sheaf Cohomology Operators + , coboundary + , isHarmonicCochain + , computeCohomology + , locateSheafObstructions + + -- * Ecosystem Domain Types + , ContractDimension(..) + , contractDimensionName + , contractDimensionRemediation + , SheafEdgeId(..) + , ContractValue(..) + , RepoStalk(..) + , SheafReport(..) + + -- * Ecosystem Sheaf Constructors & Evaluators + , canonicalRepoStalk + , restrictRepoStalk + , defaultEcosystemSheaf + , buildCanonicalSheafComplex + , buildPairwiseComplex + , evaluateSheafCoherence + , formatSheafReport + + -- * Live Filesystem Inspection + , inspectRepoStalk + , inspectRepoGhcVersion + , inspectRepoCabalVersion + , inspectRepoLicense + , findRepositoryRoot + , auditSheafTarget + , auditEcosystemSheaf + ) where + +import Control.Exception (SomeException, catch) +import Data.Char (isDigit) +import Data.List (nub) +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Maybe (mapMaybe) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import System.Directory + ( canonicalizePath + , doesDirectoryExist + , doesFileExist + , getPermissions + , executable + , listDirectory + ) +import System.FilePath ((), takeFileName, takeExtension, takeDirectory) + +import Gachi.Sync.Engine (discoverEcosystemRepositories) + +-- $note_cellular_sheaf +-- Note [Cellular Sheaf Coherence and Homological Obstruction Localization] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- [tag:note-cellular-sheaf-coherence] +-- In distributed software systems engineering and applied algebraic topology +-- (Curry 2014, Ghrist 2014), cross-repository consistency is formalized as a +-- 1-dimensional cellular sheaf F over a cell complex G = (V, E): +-- +-- 1. Topological Complex G = (V, E): +-- - 0-Cells (Vertices v ∈ V): Standalone repository checkouts across ~/src/* +-- (e.g., polytropos, gargamelle, sarutahiko, gachi, gongju) plus an +-- authoritative canonical reference vertex ("canonical"). +-- - 1-Cells (Edges e = (u, v) ∈ E): Shared interface boundaries governing +-- toolchain pinning, license terms, git governance, linter guardrails, +-- and CI matrix workflows. +-- +-- 2. Stalks and Restriction Morphisms: +-- - Stalk F(v) at vertex v: The local configuration state (RepoStalk) +-- extracted from disk at checkout v. +-- - Stalk F(e) on edge e: The projected contract value (ContractValue) along +-- dimension d. +-- - Restriction maps ρ_{u ⊴ e} : F(u) -> F(e) and ρ_{v ⊴ e} : F(v) -> F(e) +-- extract local configuration attributes into the contract boundary language. +-- +-- 3. Sheaf Coboundary Operator δ⁰: +-- - Maps 0-cochains (vertex states) to 1-cochains (edge boundary discrepancies): +-- δ⁰ : C⁰(G; F) -> C¹(G; F) +-- δ⁰(x)_e = (ρ_{u ⊴ e}(x_u), ρ_{v ⊴ e}(x_v)) +-- +-- 4. Cohomological Invariants: +-- - 0-th Cohomology H⁰(G; F) = ker δ⁰: +-- Represents the space of global sections. When all boundary projections +-- coincide across all edges (isHarmonicCochain == True), δ⁰(x) vanishes. +-- This certifies that all repositories satisfy the ecosystem contracts in +-- total harmonic equilibrium (0 drift). +-- - 1-st Cohomology H¹(G; F) = coker δ⁰: +-- When δ⁰(x) fails to vanish, the non-zero cochains localize the exact +-- cohomological obstructions to global consistency, pinpointing the +-- drifting repository, the breached contract dimension, and the observed +-- mismatch without requiring whole-ecosystem compilation. + +-------------------------------------------------------------------------------- +-- 1. Generic 1-D Cell Complex Primitives +-------------------------------------------------------------------------------- + +-- | A finite 1-dimensional cell complex (graph complex) \(G = (V, E)\). +-- +-- 0-cells represent repositories or configuration contexts, and 1-cells +-- represent shared contract interfaces connecting them. +data CellComplex vId eId = CellComplex + { complexVertices :: ![vId] + -- ^ Exhaustive list of 0-cells in the complex. + , complexEdges :: !(Map eId (vId, vId)) + -- ^ Map of 1-cells identifying @(source, target)@ endpoint incidence. + } deriving stock (Eq, Show) + +-- | Orientation of an incident 1-cell relative to a vertex 0-cell. +data Orientation + = Forward -- ^ Directed away from vertex (vertex is source: sign -1) + | Backward -- ^ Directed into vertex (vertex is target: sign +1) + deriving stock (Eq, Ord, Show) + +-- | Numeric homological sign for an orientation. +orientationSign :: Orientation -> Int +orientationSign Forward = -1 +orientationSign Backward = 1 + +-- | Graded cells of a 1-dimensional cell complex. +data Cell vId eId + = Cell0 !vId -- ^ 0-cell (vertex) + | Cell1 !eId -- ^ 1-cell (edge) + deriving stock (Eq, Ord, Show) + +-- | Empty cell complex with no vertices or edges. +emptyComplex :: CellComplex vId eId +emptyComplex = CellComplex + { complexVertices = [] + , complexEdges = Map.empty + } + +-- | Inserts a vertex into the cell complex if not already present. +addVertex :: (Eq vId) => vId -> CellComplex vId eId -> CellComplex vId eId +addVertex v complex + | v `elem` complexVertices complex = complex + | otherwise = complex { complexVertices = v : complexVertices complex } + +-- | Inserts a directed 1-cell and ensures its endpoints are in the vertex set. +addEdge + :: (Ord eId, Eq vId) + => eId + -> vId + -> vId + -> CellComplex vId eId + -> CellComplex vId eId +addEdge e u w complex = complex + { complexVertices = nub (u : w : complexVertices complex) + , complexEdges = Map.insert e (u, w) (complexEdges complex) + } + +-- | Total count of 0-cells in the complex. +numVertices :: CellComplex vId eId -> Int +numVertices = length . complexVertices + +-- | Total count of 1-cells in the complex. +numEdges :: CellComplex vId eId -> Int +numEdges = Map.size . complexEdges + +-- | Computes the topological Euler characteristic: \(\chi = |V| - |E|\). +eulerCharacteristic :: CellComplex vId eId -> Int +eulerCharacteristic c = numVertices c - numEdges c + +-------------------------------------------------------------------------------- +-- 2. Cellular Sheaf and Cochain Representations +-------------------------------------------------------------------------------- + +-- | A cellular sheaf \(\mathcal{F}\) over a cell complex \(G = (V, E)\). +-- +-- Assigns stalks to 0-cells and 1-cells, with directional restriction +-- morphisms along cell face inclusions. +-- +-- See Note [Cellular Sheaf Coherence and Homological Obstruction Localization] +-- [ref:note-cellular-sheaf-coherence]. +data CellularSheaf vId eId stalk edgeStalk = CellularSheaf + { restrictSrc :: eId -> stalk -> edgeStalk + -- ^ Source restriction morphism \(\rho_{u \trianglelefteq e}\). + , restrictTgt :: eId -> stalk -> edgeStalk + -- ^ Target restriction morphism \(\rho_{v \trianglelefteq e}\). + , liftSrc :: eId -> edgeStalk -> stalk + -- ^ Adjoint lift from edge stalk back to source vertex. + , liftTgt :: eId -> edgeStalk -> stalk + -- ^ Adjoint lift from edge stalk back to target vertex. + } + +-- | Constructs a cellular sheaf where source and target restriction maps coincide. +symmetricSheaf + :: (eId -> stalk -> edgeStalk) + -> (eId -> edgeStalk -> stalk) + -> CellularSheaf vId eId stalk edgeStalk +symmetricSheaf restr lift_ = CellularSheaf + { restrictSrc = restr + , restrictTgt = restr + , liftSrc = lift_ + , liftTgt = lift_ + } + +-- | Constructs a directional cellular sheaf with explicit source and target morphisms. +directionalSheaf + :: (eId -> stalk -> edgeStalk) + -> (eId -> stalk -> edgeStalk) + -> (eId -> edgeStalk -> stalk) + -> (eId -> edgeStalk -> stalk) + -> CellularSheaf vId eId stalk edgeStalk +directionalSheaf = CellularSheaf + +-- | 0-Cochain: an assignment of stalk elements across 0-cells (vertices). +newtype Cochain0 vId stalk = Cochain0 + { unCochain0 :: Map vId stalk + } deriving stock (Eq, Show) + deriving newtype (Functor) + +-- | 1-Cochain: an assignment of edge stalk elements across 1-cells (edges). +newtype Cochain1 eId edgeStalk = Cochain1 + { unCochain1 :: Map eId edgeStalk + } deriving stock (Eq, Show) + deriving newtype (Functor) + +-- | Result of cohomology computation at dimension 0 and 1. +data CohomologyResult eId edgeStalk + = HarmonicSection + -- ^ \(\ker \delta^0\): All boundary restrictions coincide; 0 drift. + | ObstructionMap !(Map eId (edgeStalk, edgeStalk)) + -- ^ \(\operatorname{coker} \delta^0\): Non-zero boundary discrepancies. + deriving stock (Eq, Show) + +-- | Detailed diagnostic record for an interface obstruction along an edge. +data SheafObstruction vId eId edgeStalk = SheafObstruction + { obstructionEdge :: !eId + -- ^ Identifier of the failing contract edge. + , obstructionSource :: !vId + -- ^ Source vertex (e.g. @"canonical"@). + , obstructionTarget :: !vId + -- ^ Target vertex (e.g. @"gongju"@). + , sourceRestriction :: !edgeStalk + -- ^ Projected contract value from source. + , targetRestriction :: !edgeStalk + -- ^ Projected contract value from target. + , obstructionMessage :: !Text + -- ^ Human-readable diagnostic explanation and remediation guidance. + } deriving stock (Eq, Show) + +-------------------------------------------------------------------------------- +-- 3. Sheaf Coboundary Operator & Cohomology Invariants +-------------------------------------------------------------------------------- + +-- | Sheaf Coboundary Operator: \(\delta^0 : C^0(G; \mathcal{F}) \to C^1(G; \mathcal{F})\). +-- +-- Evaluates the boundary discrepancy pair +-- \((\rho_{u \trianglelefteq e}(x_u), \rho_{v \trianglelefteq e}(x_v))\) +-- for every 1-cell \(e = (u, v)\) in the complex. +-- +-- Returns the 1-cochain of boundary pairs and a boolean indicating whether the +-- 0-cochain is harmonic (i.e. all boundary restrictions match). +-- +-- See Note [Cellular Sheaf Coherence and Homological Obstruction Localization] +-- [ref:note-cellular-sheaf-coherence]. +coboundary + :: forall vId eId stalk edgeStalk. + (Ord vId, Eq edgeStalk) + => CellComplex vId eId + -> CellularSheaf vId eId stalk edgeStalk + -> Cochain0 vId stalk + -> (Cochain1 eId (edgeStalk, edgeStalk), Bool) +coboundary complex sheaf (Cochain0 vMap) = + let edgeDiffs = Map.mapMaybeWithKey computeEdge (complexEdges complex) + harmonic = all (uncurry (==)) edgeDiffs + in (Cochain1 edgeDiffs, harmonic) + where + computeEdge eId (u, v) = case (Map.lookup u vMap, Map.lookup v vMap) of + (Just stU, Just stV) -> + Just (restrictSrc sheaf eId stU, restrictTgt sheaf eId stV) + _ -> Nothing + +-- | Predicate checking if a 0-cochain satisfies the sheaf gluing condition (zero coboundary). +isHarmonicCochain + :: (Ord vId, Eq edgeStalk) + => CellComplex vId eId + -> CellularSheaf vId eId stalk edgeStalk + -> Cochain0 vId stalk + -> Bool +isHarmonicCochain complex sheaf = snd . coboundary complex sheaf + +-- | Computes cohomology: returns 'HarmonicSection' if all boundary restrictions +-- agree, or 'ObstructionMap' detailing the non-vanishing cocycles. +computeCohomology + :: (Ord vId, Eq edgeStalk) + => CellComplex vId eId + -> CellularSheaf vId eId stalk edgeStalk + -> Cochain0 vId stalk + -> CohomologyResult eId edgeStalk +computeCohomology complex sheaf c0 = + let (Cochain1 diffs, harmonic) = coboundary complex sheaf c0 + in if harmonic + then HarmonicSection + else ObstructionMap (Map.filter (uncurry (/=)) diffs) + +-- | Locates and extracts all failing interface boundaries where \(H^1\) +-- cohomological obstructions prevent global consensus. +locateSheafObstructions + :: (Ord vId, Eq edgeStalk) + => CellComplex vId eId + -> CellularSheaf vId eId stalk edgeStalk + -> Cochain0 vId stalk + -> (eId -> vId -> vId -> edgeStalk -> edgeStalk -> Text) + -> [SheafObstruction vId eId edgeStalk] +locateSheafObstructions complex sheaf (Cochain0 vMap) explainFn = + [ SheafObstruction + { obstructionEdge = e + , obstructionSource = u + , obstructionTarget = v + , sourceRestriction = s + , targetRestriction = t + , obstructionMessage = explainFn e u v s t + } + | (e, (u, v)) <- Map.toList (complexEdges complex) + , Just stU <- [Map.lookup u vMap] + , let s = restrictSrc sheaf e stU + , Just stV <- [Map.lookup v vMap] + , let t = restrictTgt sheaf e stV + , s /= t + ] + +-------------------------------------------------------------------------------- +-- 4. Ecosystem Standardization Dimensions & Domain Stalks +-------------------------------------------------------------------------------- + +-- | Standardization contract dimensions evaluated across repository boundaries. +data ContractDimension + = ContractGhcVersion -- ^ GHC compiler version pinning (GHC 9.14.1) + | ContractCabalVersion -- ^ Cabal specification version (3.0 / 3.18) + | ContractLicense -- ^ Permissive open source license (EUPL-1.2) + | ContractGitCommitHook -- ^ Git commit-msg hook for AI trailers (.githooks/commit-msg) + | ContractGitPreCommitHook -- ^ Git pre-commit static verification hook (.githooks/pre-commit) + | ContractGitMessage -- ^ Git commit message template (.gitmessage) + | ContractHLintConfig -- ^ HLint static analysis configuration (.hlint.yaml) + | ContractCIWorkflow -- ^ Continuous integration matrix (.github/workflows/ci.yml) + | ContractAgentsAdvisory -- ^ AI agent guidance pointer (AGENTS.md) + | ContractVerifyRunner -- ^ Turnkey physical verification script (bin/-verify) + deriving stock (Eq, Ord, Show, Enum, Bounded) + +-- | Human-readable name for a contract dimension. +contractDimensionName :: ContractDimension -> Text +contractDimensionName = \case + ContractGhcVersion -> "GHC Compiler Pinning" + ContractCabalVersion -> "Cabal Spec Version" + ContractLicense -> "Software License (EUPL-1.2)" + ContractGitCommitHook -> "Git Commit-Msg Hook" + ContractGitPreCommitHook -> "Git Pre-Commit Hook" + ContractGitMessage -> "Git Message Template" + ContractHLintConfig -> "HLint Guardrails" + ContractCIWorkflow -> "CI Workflow Matrix" + ContractAgentsAdvisory -> "Agent Advisory Context" + ContractVerifyRunner -> "Physical Verify Runner" + +-- | Remediation guidance string for a contract dimension breach. +contractDimensionRemediation :: ContractDimension -> Text +contractDimensionRemediation = \case + ContractGhcVersion -> "Update cabal.project / .cabal to target GHC 9.14.1." + ContractCabalVersion -> "Update cabal manifests to cabal-version: 3.0 or 3.18." + ContractLicense -> "Add EUPL-1.2 LICENSE and update cabal license field." + ContractGitCommitHook -> "Install .githooks/commit-msg via 'gachi sync'." + ContractGitPreCommitHook -> "Install .githooks/pre-commit via 'gachi sync'." + ContractGitMessage -> "Install .gitmessage via 'gachi sync' and set commit.template." + ContractHLintConfig -> "Install canonical .hlint.yaml via 'gachi sync'." + ContractCIWorkflow -> "Generate forge CI workflows via 'gachi sync'." + ContractAgentsAdvisory -> "Install AGENTS.md and .agents/ rules via 'gachi sync'." + ContractVerifyRunner -> "Scaffold bin/-verify executable via 'gachi init/sync'." + +-- | Edge identifier in the ecosystem sheaf complex. +data SheafEdgeId = SheafEdgeId + { edgeSourceRepo :: !Text + -- ^ Source repository name (e.g. @"canonical"@). + , edgeTargetRepo :: !Text + -- ^ Target repository name (e.g. @"gongju"@). + , edgeDimension :: !ContractDimension + -- ^ Evaluated contract dimension. + } deriving stock (Eq, Ord, Show) + +-- | Projected contract value on an edge stalk. +data ContractValue + = ContractText !(Maybe Text) -- ^ Textual attribute (e.g. Just "9.14.1") + | ContractBool !Bool -- ^ Binary conformance status (True / False) + deriving stock (Eq, Ord, Show) + +-- | Observed repository configuration stalk extracted from a checkout. +data RepoStalk = RepoStalk + { stalkRepoName :: !Text + -- ^ Canonical repository identifier. + , stalkRepoPath :: !FilePath + -- ^ Absolute path to repository root. + , stalkGhcVersion :: !(Maybe Text) + -- ^ Detected GHC compiler pinning. + , stalkCabalVersion :: !(Maybe Text) + -- ^ Detected Cabal specification version. + , stalkLicense :: !(Maybe Text) + -- ^ Detected license stanza or file. + , stalkHasCommitMsg :: !Bool + -- ^ Presence and validity of .githooks/commit-msg. + , stalkHasPreCommit :: !Bool + -- ^ Presence and validity of .githooks/pre-commit. + , stalkHasGitMessage :: !Bool + -- ^ Presence of .gitmessage commit template. + , stalkHasHLint :: !Bool + -- ^ Presence of .hlint.yaml. + , stalkHasCIWorkflow :: !Bool + -- ^ Presence of CI configuration (.github/workflows/ci.yml or .gitlab-ci.yml). + , stalkHasAgentsMd :: !Bool + -- ^ Presence of AGENTS.md orientation pointer. + , stalkHasVerifyRunner :: !Bool + -- ^ Presence of executable bin/*-verify runner. + } deriving stock (Eq, Show) + +-- | Canonical reference stalk representing the ideal ecosystem contract. +canonicalRepoStalk :: RepoStalk +canonicalRepoStalk = RepoStalk + { stalkRepoName = "canonical" + , stalkRepoPath = "/" + , stalkGhcVersion = Just "9.14.1" + , stalkCabalVersion = Just "3.0" + , stalkLicense = Just "EUPL-1.2" + , stalkHasCommitMsg = True + , stalkHasPreCommit = True + , stalkHasGitMessage = True + , stalkHasHLint = True + , stalkHasCIWorkflow = True + , stalkHasAgentsMd = True + , stalkHasVerifyRunner = True + } + +-- | Restriction morphism: projects a 'RepoStalk' onto a 'ContractValue' along a dimension. +restrictRepoStalk :: ContractDimension -> RepoStalk -> ContractValue +restrictRepoStalk dim stalk = case dim of + ContractGhcVersion -> ContractText (stalkGhcVersion stalk) + ContractCabalVersion -> ContractText (normalizeCabalVer (stalkCabalVersion stalk)) + ContractLicense -> ContractText (normalizeLicense (stalkLicense stalk)) + ContractGitCommitHook -> ContractBool (stalkHasCommitMsg stalk) + ContractGitPreCommitHook -> ContractBool (stalkHasPreCommit stalk) + ContractGitMessage -> ContractBool (stalkHasGitMessage stalk) + ContractHLintConfig -> ContractBool (stalkHasHLint stalk) + ContractCIWorkflow -> ContractBool (stalkHasCIWorkflow stalk) + ContractAgentsAdvisory -> ContractBool (stalkHasAgentsMd stalk) + ContractVerifyRunner -> ContractBool (stalkHasVerifyRunner stalk) + where + -- Normalize Cabal versions: 3.18, 3.12, 3.0 all treated as valid 3.x specifications + normalizeCabalVer (Just v) + | "3." `T.isPrefixOf` T.strip v = Just "3.0" + | otherwise = Just (T.strip v) + normalizeCabalVer Nothing = Nothing + + -- Normalize EUPL licenses: EUPL-1.2, EUPL-1.1 treated as canonical EUPL + normalizeLicense (Just lic) + | "EUPL" `T.isInfixOf` T.toUpper lic = Just "EUPL-1.2" + | otherwise = Just (T.strip lic) + normalizeLicense Nothing = Nothing + +-- | Default cellular sheaf connecting repositories to the canonical reference. +defaultEcosystemSheaf + :: CellularSheaf Text SheafEdgeId RepoStalk ContractValue +defaultEcosystemSheaf = CellularSheaf + { restrictSrc = restrictRepoStalk . edgeDimension + , restrictTgt = restrictRepoStalk . edgeDimension + , liftSrc = \_ _ -> canonicalRepoStalk + , liftTgt = \_ _ -> canonicalRepoStalk + } + +-------------------------------------------------------------------------------- +-- 5. Complex Construction & Sheaf Coherence Evaluation +-------------------------------------------------------------------------------- + +-- | All ten contract dimensions evaluated in the ecosystem complex. +allContractDimensions :: [ContractDimension] +allContractDimensions = [minBound .. maxBound] + +-- | Constructs a star cell complex centered at @"canonical"@ connecting every +-- client repository along all ten contract dimensions. +buildCanonicalSheafComplex :: [Text] -> CellComplex Text SheafEdgeId +buildCanonicalSheafComplex clientRepos = + let v0 = "canonical" + allVerts = v0 : clientRepos + edgeList = + [ ( SheafEdgeId v0 repo dim, (v0, repo) ) + | repo <- clientRepos + , dim <- allContractDimensions + ] + in CellComplex + { complexVertices = allVerts + , complexEdges = Map.fromList edgeList + } + +-- | Constructs a pairwise cell complex connecting adjacent client repositories. +buildPairwiseComplex :: [Text] -> CellComplex Text SheafEdgeId +buildPairwiseComplex repos = + let pairs = zip repos (drop 1 repos) + edgeList = + [ ( SheafEdgeId u v dim, (u, v) ) + | (u, v) <- pairs + , dim <- allContractDimensions + ] + in CellComplex + { complexVertices = repos + , complexEdges = Map.fromList edgeList + } + +-- | Comprehensive diagnostic summary of cellular sheaf coherence. +data SheafReport = SheafReport + { reportVertices :: ![Text] + -- ^ All 0-cells in the complex. + , reportEdgeCount :: !Int + -- ^ Total 1-cells evaluated across all contract dimensions. + , reportEulerChar :: !Int + -- ^ Euler characteristic \(\chi = |V| - |E|\). + , reportHarmonicEdges :: !Int + -- ^ Count of edges satisfying boundary agreement. + , reportDriftEdges :: !Int + -- ^ Count of edges exhibiting boundary discrepancies. + , reportCoherencePct :: !Double + -- ^ Percentage of edges in harmonic resonance (0.0 to 100.0). + , reportIsHarmonic :: !Bool + -- ^ True if \(H^0\) is complete and \(H^1 = \emptyset\) (0 obstructions). + , reportObstructions :: ![SheafObstruction Text SheafEdgeId ContractValue] + -- ^ Localized cohomological obstructions. + } deriving stock (Eq, Show) + +-- | Evaluates cellular sheaf coherence over a cell complex and 0-cochain. +evaluateSheafCoherence + :: CellComplex Text SheafEdgeId + -> Cochain0 Text RepoStalk + -> SheafReport +evaluateSheafCoherence complex c0 = + let (Cochain1 diffs, harmonic) = coboundary complex defaultEcosystemSheaf c0 + totalEdges = Map.size diffs + driftCount = Map.size (Map.filter (uncurry (/=)) diffs) + harmonicCount = totalEdges - driftCount + pct = if totalEdges == 0 then 100.0 else (fromIntegral harmonicCount / fromIntegral totalEdges) * 100.0 + obstructions = locateSheafObstructions complex defaultEcosystemSheaf c0 formatObstructionMsg + in SheafReport + { reportVertices = complexVertices complex + , reportEdgeCount = totalEdges + , reportEulerChar = eulerCharacteristic complex + , reportHarmonicEdges = harmonicCount + , reportDriftEdges = driftCount + , reportCoherencePct = pct + , reportIsHarmonic = harmonic + , reportObstructions = obstructions + } + where + formatObstructionMsg e u v s t = + "Boundary obstruction on edge (" <> u <> " ⊵ " <> v <> ", " + <> contractDimensionName (edgeDimension e) <> "): expected " + <> formatContractVal s <> ", observed " <> formatContractVal t <> ". " + <> contractDimensionRemediation (edgeDimension e) + + formatContractVal (ContractText (Just txt)) = "'" <> txt <> "'" + formatContractVal (ContractText Nothing) = "Nothing" + formatContractVal (ContractBool b) = T.show b + +-- | Formats a 'SheafReport' into an aligned terminal diagnostic ASCII report. +formatSheafReport :: SheafReport -> Text +formatSheafReport rep = T.unlines $ + [ "================================================================================" + , " Gachi Cellular Sheaf Coherence Report (~/src/PLAN.md §1.A, Milestone 3.5)" + , "================================================================================" + , " Complex Topology: 1-D Cell Complex G = (V, E)" + , " 0-Cells (Vertices): " <> T.show (length (reportVertices rep)) + <> " " <> T.pack (show (reportVertices rep)) + , " 1-Cells (Edges): " <> T.show (reportEdgeCount rep) + <> " evaluated across " <> T.show (length allContractDimensions) <> " contract dimensions" + , " Euler Char (\x03c7): " <> T.show (reportEulerChar rep) + , "--------------------------------------------------------------------------------" + , " Cohomological Invariants:" + , " [+] 0-th Cohomology H^0 (Harmonic Equilibrium): ker \x03b4\x2070" + , " Status: " <> T.show (reportHarmonicEdges rep) <> " / " <> T.show (reportEdgeCount rep) + <> " edges in harmonic resonance (" <> formatPct (reportCoherencePct rep) <> "% coherent)" + ] + ++ (if reportIsHarmonic rep + then [ " System State: HARMONIC EQUILIBRIUM (zero boundary obstruction)" ] + else [ " System State: DRIFT DETECTED" ]) + ++ + [ " [-] 1-st Cohomology H^1 (Boundary Obstructions): coker \x03b4\x2070" + , " Status: " <> T.show (reportDriftEdges rep) <> " boundary obstructions localized" + ] + ++ (if null (reportObstructions rep) + then [ "--------------------------------------------------------------------------------" + , " [+] All repositories satisfy ecosystem contracts in total harmonic equilibrium." + , "================================================================================" + ] + else + [ "--------------------------------------------------------------------------------" + , " Localized Cohomological Obstructions (H^1):" + , "--------------------------------------------------------------------------------" + ] + ++ concatMap formatObstructionCard (reportObstructions rep) + ++ + [ "================================================================================" ] + ) + where + formatPct val = + let whole = truncate val :: Int + dec = truncate (val * 10) `mod` 10 :: Int + in T.show whole <> "." <> T.show dec + + formatObstructionCard obs = + let dim = edgeDimension (obstructionEdge obs) + in [ " Edge: " <> obstructionSource obs <> " \x22b5 " <> obstructionTarget obs + <> " (" <> contractDimensionName dim <> ")" + , " Expected: " <> formatVal (sourceRestriction obs) + , " Observed: " <> formatVal (targetRestriction obs) + , " Remediation: " <> contractDimensionRemediation dim + , "" + ] + + formatVal (ContractText (Just txt)) = "'" <> txt <> "'" + formatVal (ContractText Nothing) = "Missing / Not Specified" + formatVal (ContractBool True) = "Compliant (True)" + formatVal (ContractBool False) = "Missing / Non-Compliant (False)" + +-------------------------------------------------------------------------------- +-- 6. Live Filesystem Inspection Routines +-------------------------------------------------------------------------------- + +-- | Traverses upward from a given directory to locate the authoritative +-- workspace or repository root containing @.git@, @cabal.project@, or @project.dhall@. +findRepositoryRoot :: FilePath -> IO FilePath +findRepositoryRoot startPath = do + absPath <- canonicalizePath startPath + let searchUp p = do + hasGit <- doesDirectoryExist (p ".git") + hasProj <- doesFileExist (p "cabal.project") + hasDhall <- doesFileExist (p "project.dhall") + if hasGit || hasProj || hasDhall + then pure p + else do + let parent = takeDirectory p + if parent == p + then pure absPath + else searchUp parent + searchUp absPath + +-- | Inspects a repository directory and extracts its 'RepoStalk'. +inspectRepoStalk :: FilePath -> IO RepoStalk +inspectRepoStalk rawPath = do + repoPath <- findRepositoryRoot rawPath + let repoName = T.pack (takeFileName repoPath) + ghcVer <- inspectRepoGhcVersion repoPath + cabalVer <- inspectRepoCabalVersion repoPath + lic <- inspectRepoLicense repoPath + + hasCommitMsg <- doesFileExist (repoPath ".githooks" "commit-msg") + hasPreCommit <- doesFileExist (repoPath ".githooks" "pre-commit") + hasGitMsg <- doesFileExist (repoPath ".gitmessage") + hasHLint <- doesFileExist (repoPath ".hlint.yaml") + + hasGhCi <- doesFileExist (repoPath ".github" "workflows" "ci.yml") + hasGlCi <- doesFileExist (repoPath ".gitlab-ci.yml") + let hasCI = hasGhCi || hasGlCi + + hasAgents <- doesFileExist (repoPath "AGENTS.md") + + hasRunner <- checkVerifyRunner repoPath repoName + + pure RepoStalk + { stalkRepoName = repoName + , stalkRepoPath = repoPath + , stalkGhcVersion = ghcVer + , stalkCabalVersion = cabalVer + , stalkLicense = lic + , stalkHasCommitMsg = hasCommitMsg + , stalkHasPreCommit = hasPreCommit + , stalkHasGitMessage = hasGitMsg + , stalkHasHLint = hasHLint + , stalkHasCIWorkflow = hasCI + , stalkHasAgentsMd = hasAgents + , stalkHasVerifyRunner = hasRunner + } + +-- | Inspects GHC compiler version pinning from @cabal.project@ or @*.cabal@. +inspectRepoGhcVersion :: FilePath -> IO (Maybe Text) +inspectRepoGhcVersion repoPath = do + let projPath = repoPath "cabal.project" + hasProj <- doesFileExist projPath + if hasProj + then do + txt <- TIO.readFile projPath `catch` (\(_ :: SomeException) -> pure "") + case extractGhcFromText txt of + Just v -> pure (Just v) + Nothing -> inspectFromCabal + else inspectFromCabal + where + extractGhcFromText txt = + let ls = T.lines txt + findCompiler l = + let s = T.strip l + in if "with-compiler:" `T.isPrefixOf` s + then let rest = T.strip (T.drop 14 s) + in if "ghc-" `T.isPrefixOf` rest + then Just (T.drop 4 rest) + else Just rest + else Nothing + in case mapMaybe findCompiler ls of + (v:_) -> Just v + [] -> Nothing + + inspectFromCabal = do + cabalFiles <- findCabalFiles repoPath + results <- mapM readGhcFromCabal cabalFiles + let allVers = concat results + pure (if "9.14.1" `elem` allVers + then Just "9.14.1" + else case allVers of { (v:_) -> Just v; [] -> Nothing }) + + readGhcFromCabal path = do + txt <- TIO.readFile path `catch` (\(_ :: SomeException) -> pure "") + let ls = T.lines txt + findGhcLine l = + let s = T.strip l + in if "GHC ==" `T.isInfixOf` s + then let afterEq = T.strip (snd (T.breakOnEnd "==" s)) + v = T.takeWhile (\c -> isDigit c || c == '.') afterEq + in if T.null v then Nothing else Just v + else Nothing + pure (mapMaybe findGhcLine ls) + +-- | Inspects Cabal specification version from @*.cabal@ files. +inspectRepoCabalVersion :: FilePath -> IO (Maybe Text) +inspectRepoCabalVersion repoPath = do + cabalFiles <- findCabalFiles repoPath + case cabalFiles of + [] -> pure Nothing + (c:_) -> do + txt <- TIO.readFile c `catch` (\(_ :: SomeException) -> pure "") + let ls = T.lines txt + findCabalVer l = + let s = T.strip l + in if "cabal-version:" `T.isPrefixOf` s + then Just (T.strip (T.drop 14 s)) + else Nothing + pure (case mapMaybe findCabalVer ls of { (v:_) -> Just v; [] -> Nothing }) + +-- | Inspects license stanza from @*.cabal@ or root @LICENSE@ file. +inspectRepoLicense :: FilePath -> IO (Maybe Text) +inspectRepoLicense repoPath = do + cabalFiles <- findCabalFiles repoPath + cabalLic <- case cabalFiles of + (c:_) -> do + txt <- TIO.readFile c `catch` (\(_ :: SomeException) -> pure "") + let ls = T.lines txt + findLic l = + let s = T.strip l + in if "license:" `T.isPrefixOf` s + then Just (T.strip (T.drop 8 s)) + else Nothing + pure (case mapMaybe findLic ls of { (v:_) -> Just v; [] -> Nothing }) + [] -> pure Nothing + + case cabalLic of + Just lic -> pure (Just lic) + Nothing -> do + let licPath = repoPath "LICENSE" + hasLic <- doesFileExist licPath + if hasLic + then do + txt <- TIO.readFile licPath `catch` (\(_ :: SomeException) -> pure "") + if "European Union Public Licence" `T.isInfixOf` txt || "EUPL" `T.isInfixOf` txt + then pure (Just "EUPL-1.2") + else pure (Just "LICENSE-FOUND") + else pure Nothing + +-- | Checks for an executable verification runner under @bin/@. +checkVerifyRunner :: FilePath -> Text -> IO Bool +checkVerifyRunner repoPath repoName = do + let explicitRunner = repoPath "bin" (T.unpack repoName ++ "-verify") + hasExplicit <- doesFileExist explicitRunner + if hasExplicit + then do + perms <- getPermissions explicitRunner + pure (executable perms) + else do + let binDir = repoPath "bin" + hasBin <- doesDirectoryExist binDir + if hasBin + then do + files <- listDirectory binDir + let verifyScripts = filter (\f -> "-verify" `T.isSuffixOf` T.pack f) files + case verifyScripts of + [] -> pure False + (v:_) -> do + perms <- getPermissions (binDir v) + pure (executable perms) + else pure False + +-- | Finds all @.cabal@ files within a repository directory or @packages/*/@. +findCabalFiles :: FilePath -> IO [FilePath] +findCabalFiles repoPath = do + rootEntries <- listDirectory repoPath `catch` (\(_ :: SomeException) -> pure []) + let rootCabals = [ repoPath f | f <- rootEntries, takeExtension f == ".cabal" ] + if not (null rootCabals) + then pure rootCabals + else do + let pkgsDir = repoPath "packages" + hasPkgs <- doesDirectoryExist pkgsDir + if hasPkgs + then do + pkgEntries <- listDirectory pkgsDir `catch` (\(_ :: SomeException) -> pure []) + nestedCabals <- mapM (findPkgCabal pkgsDir) pkgEntries + pure (concat nestedCabals) + else pure [] + where + findPkgCabal baseDir pkgName = do + let dir = baseDir pkgName + isDir <- doesDirectoryExist dir + if isDir + then do + entries <- listDirectory dir `catch` (\(_ :: SomeException) -> pure []) + pure [ dir f | f <- entries, takeExtension f == ".cabal" ] + else pure [] + +-- | Audits a single target repository using the cellular sheaf model. +auditSheafTarget :: FilePath -> IO SheafReport +auditSheafTarget targetDir = do + stalk <- inspectRepoStalk targetDir + let clientName = stalkRepoName stalk + complex = buildCanonicalSheafComplex [clientName] + c0 = Cochain0 (Map.fromList [("canonical", canonicalRepoStalk), (clientName, stalk)]) + pure (evaluateSheafCoherence complex c0) + +-- | Audits all discovered ecosystem repositories within a parent directory. +auditEcosystemSheaf :: FilePath -> IO SheafReport +auditEcosystemSheaf parentDir = do + repoPaths <- discoverEcosystemRepositories parentDir + stalks <- mapM inspectRepoStalk repoPaths + let clientNames = map stalkRepoName stalks + complex = buildCanonicalSheafComplex clientNames + stalkPairs = ("canonical", canonicalRepoStalk) : zip clientNames stalks + c0 = Cochain0 (Map.fromList stalkPairs) + pure (evaluateSheafCoherence complex c0) diff --git a/src/Gachi/Sync/Types.hs b/src/Gachi/Sync/Types.hs new file mode 100644 --- /dev/null +++ b/src/Gachi/Sync/Types.hs @@ -0,0 +1,430 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} + +-- | Module: Gachi.Sync.Types +-- Description: Core types, models, and data structures for repository standardization +-- +-- This module defines the foundational types modeling the ecosystem-wide +-- Standardization Matrix (~/src/PLAN.md §1.A), asset categories across the +-- nine canonical dimensions, asset audit outcomes, and synchronization plans. +-- +-- = Architectural Context & Invariants +-- +-- In accordance with Note [Ecosystem Standardization Invariants] +-- [ref:note-ecosystem-standardization], all repositories across ~/src/* +-- adhere to shared structural conventions. This module formalizes those +-- conventions as strongly-typed Haskell records suitable for static analysis, +-- diagnostic reporting, and automated configuration propagation. +-- +-- == The Nine Standardization Dimensions +-- +-- In accordance with ~/src/PLAN.md §1.A, the ecosystem formalizes nine core +-- standardization dimensions to maintain ergonomic parity across all checkouts: +-- +-- 1. __Dimension 1 (Workspace Layout):__ +-- Multi-package hierarchy (@packages/*/src@, @packages/*/test@, @.cabal@), +-- central documentation corpus under @docs/@ (@docs/INDEX.md@, @docs/notes/@), +-- and the operational planning pair (@PLAN.md@ and @STATE.md@). +-- +-- 2. __Dimension 2 (Code Formatters):__ +-- Deterministic code formatting profiles across Haskell (@fourmolu.yaml@), +-- Rust (@rustfmt.toml@), and C/C++ (@.clang-format@). Eliminates whitespace +-- churn and enforces AST-preserving layout. +-- +-- 3. __Dimension 3 (Linters & Guardrails):__ +-- Static analysis rules enforcing zero-hint cleanliness (@.hlint.yaml@) +-- and modern GHC idioms such as @OverloadedRecordDot@. +-- +-- 4. __Dimension 4 (Build Conventions):__ +-- Hermetic toolchain pinning (@cabal.project@) targeting GHC 9.14.1 and +-- Cabal 3.18, with developer override templates (@cabal.project.local.example@). +-- +-- 5. __Dimension 5 (Git Governance):__ +-- Linux kernel RFC 2822 commit message trailers (@.gitmessage@), Tagref +-- cross-reference configuration (@tagref.yml@), and pre-commit hooks. +-- +-- 6. __Dimension 6 (Remote Topology):__ +-- Multi-forge distribution topology separating Radicle peer-to-peer from +-- commercial and community mirrors (@docs/MAINTAINER_GUIDE.md@). +-- +-- 7. __Dimension 7 (Tiered CI Workflows):__ +-- Asymmetric forge resource allocation: heavyweight physical verification on +-- GitHub Actions versus lightweight static checks on community GitLab runners. +-- +-- 8. __Dimension 8 (Polyglot Invariants):__ +-- ABI stability, FFI boundary pinning, and cross-language integration test runners. +-- +-- 9. __Dimension 9 (Agent Advisory Layer):__ +-- Context-budgeted agent instructions (@AGENTS.md@, ~4 KB limit), compatibility +-- symlinks (@CLAUDE.md@), and modular rules in @.agents/rules/@. +-- +-- 10. __Physical Verification Harnesses:__ +-- Turnkey shell scripts in @bin/@ enforcing the five physical gates across +-- every checkout (@verify@, @tagref@, @linkcheck@, @cloc@, @generate-tags@). +-- +-- == Audit and Synchronization Lifecycle +-- +-- The types defined here establish a two-phase verification and synchronization cycle: +-- +-- * __Inspection Phase:__ +-- The target workspace is audited without mutations ('Gachi.Sync.Audit.auditRepository'). +-- Each asset is tested for presence, content equality against 'assetGenerator', +-- and executable bit validity, yielding an 'AssetAuditResult'. +-- +-- * __Remediation Phase:__ +-- Diagnostic reports ('AuditReport') guide interactive or automated synchronization +-- ('gachi sync') to resolve drift and install missing required infrastructure assets. +-- +-- = When to Use This Module +-- +-- Import this module when working with: +-- * The 9 standardization dimensions ('AssetCategory'). +-- * Asset definitions and generators ('StandardAsset'). +-- * The complete multi-dimension matrix ('StandardizationMatrix'). +-- * Audit results and diagnostic reports ('AssetAuditStatus', 'AuditReport'). +-- +-- = Worked Example +-- +-- >>> import Gachi.Schema.Project (defaultProject, Author(..)) +-- >>> import Gachi.Sync.Types +-- >>> let auth = Author "Nadia Yvette Chambers" "nadia.yvette.chambers@ik.me" +-- >>> let proj = defaultProject "gongju" auth +-- >>> let asset = StandardAsset "bin/:name:-verify" CategoryVerification True True "Runner" (const "") +-- >>> resolveAssetPath proj asset +-- "bin/gongju-verify" +-- >>> categoryName CategoryFormatter +-- "Code Formatters" +module Gachi.Sync.Types + ( -- * Standardization Dimensions & Categories + AssetCategory(..) + , categoryName + , categoryDescription + + -- * Standard Asset Models + , StandardAsset(..) + , resolveAssetPath + + -- * Standardization Matrix + , StandardizationMatrix(..) + + -- * Audit Results & Statuses + , AssetAuditStatus(..) + , AssetAuditResult(..) + , isCompliant + , isDrift + , isMissing + + -- * Diagnostic Reporting + , AuditReport(..) + + -- * Operational Synchronization Modes + , SyncMode(..) + ) where + +import Data.Text (Text) +import qualified Data.Text as T +import GHC.Generics (Generic) +import Gachi.Schema.Project (Project, projectName) + +-------------------------------------------------------------------------------- +-- 1. Standardization Dimensions & Categories +-------------------------------------------------------------------------------- + +-- | The nine foundational standardization dimensions governing ecosystem repositories. +-- +-- Defined in ~/src/PLAN.md §1.A to ensure uniform developer ergonomics, +-- reproducible builds, and automated AI pair programming context across all checkouts. +data AssetCategory + = CategoryLayout + -- ^ Dimension 1: Workspace and directory hierarchy (packages/, docs/, bin/, PLAN.md, STATE.md). + | CategoryFormatter + -- ^ Dimension 2: Code formatting profiles (fourmolu.yaml, rustfmt.toml, .clang-format). + | CategoryLinter + -- ^ Dimension 3: Static analysis guardrails (.hlint.yaml). + | CategoryBuild + -- ^ Dimension 4: Build system conventions (cabal.project, cabal.project.local.example). + | CategoryGitGovernance + -- ^ Dimension 5: Git governance, RFC 2822 commit templates, and hooks (.githooks/). + | CategoryRemoteTopology + -- ^ Dimension 6: Multi-forge replication remotes (rad, github, gitcode, framagit, disroot). + | CategoryCIWorkflow + -- ^ Dimension 7: Forge-tiered CI resource allocation (.github/workflows/, .gitlab-ci.yml). + | CategoryPolyglot + -- ^ Dimension 8: Multi-language FFI boundary invariants and cross-language tests. + | CategoryAgentAdvisory + -- ^ Dimension 9: Agent orientation pointers (AGENTS.md), symlinks, rules, and skills. + | CategoryVerification + -- ^ Physical verification harnesses and non-negotiable verification gates (bin/*-verify). + deriving stock (Eq, Show, Ord, Enum, Bounded, Generic) + +-- | Human-readable short name for an 'AssetCategory'. +-- +-- Used in diagnostic audit tables and status report banners. +categoryName :: AssetCategory -> Text +categoryName CategoryLayout = "Workspace Layout" +categoryName CategoryFormatter = "Code Formatters" +categoryName CategoryLinter = "Linters & Guardrails" +categoryName CategoryBuild = "Build Conventions" +categoryName CategoryGitGovernance = "Git Governance" +categoryName CategoryRemoteTopology = "Remote Topology" +categoryName CategoryCIWorkflow = "Tiered CI Workflows" +categoryName CategoryPolyglot = "Polyglot Invariants" +categoryName CategoryAgentAdvisory = "Agent Advisory Layer" +categoryName CategoryVerification = "Physical Verification" + +-- | Detailed synopsis of what an 'AssetCategory' governs. +-- +-- Explains the architectural responsibilities and scope of each dimension. +categoryDescription :: AssetCategory -> Text +categoryDescription CategoryLayout = + "Multi-package directory hierarchy, central docs/ corpus, and two-file planning loop." +categoryDescription CategoryFormatter = + "Deterministic code formatting profiles across Haskell (Fourmolu), Rust, and C/C++." +categoryDescription CategoryLinter = + "Static analysis rules enforcing zero-hint clean compiler and linter policies." +categoryDescription CategoryBuild = + "Hermetic toolchain pinning (GHC 9.14.1 / Cabal 3.18) and local override patterns." +categoryDescription CategoryGitGovernance = + "RFC 2822 commit message trailers (Assisted-by:) and pre-commit gate hooks." +categoryDescription CategoryRemoteTopology = + "Multi-forge mirroring separating Radicle p2p from commercial and community forges." +categoryDescription CategoryCIWorkflow = + "Asymmetric forge resource allocation: heavy GitHub Actions vs lightweight community CI." +categoryDescription CategoryPolyglot = + "ABI stability, FFI boundary pinning, and cross-language integration test runners." +categoryDescription CategoryAgentAdvisory = + "Context-budgeted AGENTS.md (~4 KB pointer), compatibility symlinks, and modular rules." +categoryDescription CategoryVerification = + "Turnkey verification scripts enforcing the 5 physical gates across every repository." + +-------------------------------------------------------------------------------- +-- 2. Standard Asset Models +-------------------------------------------------------------------------------- + +-- | Declarative specification for an individual standardized asset in the ecosystem. +-- +-- Each asset defines its relative file path, category dimension, permission requirements, +-- and a pure generator synthesizing its canonical content from a 'Project' specification. +data StandardAsset = StandardAsset + { assetPath :: !FilePath + -- ^ Relative file path within the workspace root (e.g. @".hlint.yaml"@ or @"bin/:name:-verify"@). + , assetCategory :: !AssetCategory + -- ^ Standardization dimension governing this asset. + , assetRequired :: !Bool + -- ^ Whether absence of this file constitutes an audit violation. + , assetExecutable :: !Bool + -- ^ Whether POSIX executable permissions (@+x@) must be applied. + , assetDescription :: !Text + -- ^ Human-readable explanation of asset purpose and architectural role. + , assetGenerator :: !(Project -> Text) + -- ^ Pure generator synthesizing canonical file content for the given project. + } deriving stock (Generic) + +instance Show StandardAsset where + showsPrec d a = showParen (d > 10) $ + showString "StandardAsset { assetPath = " . shows (assetPath a) + . showString ", assetCategory = " . shows (assetCategory a) + . showString ", assetRequired = " . shows (assetRequired a) + . showString ", assetExecutable = " . shows (assetExecutable a) + . showString ", assetDescription = " . shows (assetDescription a) + . showString " }" + +instance Eq StandardAsset where + a == b = assetPath a == assetPath b + && assetCategory a == assetCategory b + && assetRequired a == assetRequired b + && assetExecutable a == assetExecutable b + +-- | Resolves the concrete filesystem relative path of an asset for a target project. +-- +-- Replaces template tokens such as @":name:"@ and @":project:"@ with the project's +-- declared 'projectName'. For static paths (e.g. @".hlint.yaml"@), returns the +-- path unmodified. +-- +-- === Worked Example +-- +-- >>> import Gachi.Schema.Project (defaultProject, Author(..)) +-- >>> let proj = defaultProject "gongju" (Author "Nadia" "nadia@example.com") +-- >>> let asset = StandardAsset "bin/:name:-verify" CategoryVerification True True "Verify script" (const "") +-- >>> resolveAssetPath proj asset +-- "bin/gongju-verify" +resolveAssetPath :: Project -> StandardAsset -> FilePath +resolveAssetPath proj asset = + let pName = T.unpack (projectName proj) + raw = assetPath asset + subst [] = [] + subst str@(c:cs) + | take 6 str == ":name:" = pName ++ subst (drop 6 str) + | take 9 str == ":project:" = pName ++ subst (drop 9 str) + | otherwise = c : subst cs + in subst raw + +-------------------------------------------------------------------------------- +-- 3. Standardization Matrix +-------------------------------------------------------------------------------- + +-- | Composite Standardization Matrix aggregating all registered standard assets. +-- +-- Encapsulates the entire ecosystem contract: which dimensions are active, +-- which assets belong to each dimension, and how their contents are generated. +-- +-- === Structural Invariants & Properties +-- +-- 1. __Dimension Congruence:__ Every declared dimension in 'matrixDimensions' is +-- represented by at least one asset in 'matrixAssets'. +-- 2. __Unique Target Paths:__ Within a concrete project instantiation, no two +-- assets in 'matrixAssets' resolve to the same relative file path. +-- 3. __Pure Hermetic Generation:__ Every asset's 'assetGenerator' is a pure, total +-- function evaluated strictly from the immutable 'Project' record. +-- 4. __Static Analysis Friendly:__ The matrix can be audited, filtered by category, +-- queried by path, or serialized without accessing ambient filesystem state. +data StandardizationMatrix = StandardizationMatrix + { matrixAssets :: ![StandardAsset] + -- ^ Complete list of registered standard asset specifications. + , matrixDimensions :: ![AssetCategory] + -- ^ Active dimensions enforced by this matrix instance. + } deriving stock (Generic) + +-------------------------------------------------------------------------------- +-- 4. Audit Results & Statuses +-------------------------------------------------------------------------------- + +-- | Outcome of auditing an individual asset against the physical filesystem. +-- +-- The audit engine classifies every asset into exactly one of these five statuses: +-- +-- 1. 'StatusCompliant': +-- File exists on disk, content matches expected generator output, and executable +-- bits conform to 'assetExecutable'. +-- +-- 2. 'StatusMissing': +-- File is completely absent from the target directory on disk. +-- +-- 3. 'StatusContentDrift': +-- File exists, but its text diverges from canonical generator output. +-- Contains actual character count and expected character count. +-- +-- 4. 'StatusPermissionDrift': +-- File exists and content matches, but its executable bit differs from +-- expected (e.g. executable script lacking @+x@ permissions). +-- +-- 5. 'StatusIOError': +-- Filesystem I/O exception occurred while attempting to inspect the file. +data AssetAuditStatus + = StatusCompliant + -- ^ File exists, textual content matches canonical generator, and permissions are valid. + | StatusMissing + -- ^ File is missing on disk. + | StatusContentDrift !Int !Int + -- ^ File exists but content diverges (actual character length vs expected length). + | StatusPermissionDrift !Bool !Bool + -- ^ File exists and matches content, but executable bits differ (actual vs expected). + | StatusIOError !Text + -- ^ Filesystem I/O exception occurred while attempting to inspect the file. + deriving stock (Eq, Show, Generic) + +-- | Helper checking if an audit status represents full compliance. +-- +-- Returns 'True' exclusively for 'StatusCompliant'. +isCompliant :: AssetAuditStatus -> Bool +isCompliant StatusCompliant = True +isCompliant _ = False + +-- | Helper checking if an audit status represents content or permission drift. +-- +-- Returns 'True' for 'StatusContentDrift' and 'StatusPermissionDrift'. +isDrift :: AssetAuditStatus -> Bool +isDrift (StatusContentDrift _ _) = True +isDrift (StatusPermissionDrift _ _) = True +isDrift _ = False + +-- | Helper checking if an audit status represents a missing file. +-- +-- Returns 'True' exclusively for 'StatusMissing'. +isMissing :: AssetAuditStatus -> Bool +isMissing StatusMissing = True +isMissing _ = False + +-- | Paired audit result combining an asset specification with its observed status. +-- +-- Represents the atomic finding for a single asset evaluated by the audit engine. +-- Pairs the structural contract ('resultAsset') with the empirical status observed +-- on disk ('resultStatus'). +-- +-- === Worked Example +-- +-- >>> import Gachi.Sync.Types +-- >>> let asset = StandardAsset ".hlint.yaml" CategoryLinter True False "HLint" (const "") +-- >>> let res = AssetAuditResult asset StatusCompliant +-- >>> isCompliant (resultStatus res) +-- === Invariants & Verification Semantics +-- +-- * An asset result is immutable once constructed. +-- * Predicates like 'isCompliant', 'isDrift', and 'isMissing' project directly +-- from 'resultStatus'. +-- * Audit reports aggregate lists of 'AssetAuditResult' to render tabular diagnostics. +data AssetAuditResult = AssetAuditResult + { resultAsset :: !StandardAsset + -- ^ The standardized asset specification audited. + , resultStatus :: !AssetAuditStatus + -- ^ Observed compliance or discrepancy status on disk. + } deriving stock (Eq, Show, Generic) + +-------------------------------------------------------------------------------- +-- 5. Diagnostic Reporting +-------------------------------------------------------------------------------- + +-- | Comprehensive diagnostic summary of a repository audit across the matrix. +-- +-- Summarizes aggregate compliance statistics, lists all individual asset audit +-- outcomes, and computes the overall compliance percentage. +-- +-- === Diagnostic Metrics & Mathematical Guarantees +-- +-- 1. __Exact Asset Partitioning:__ +-- The evaluated outcomes in 'reportResults' partition the universe of standard +-- assets: +-- \[ +-- \text{length}(\text{reportResults}) = \text{reportTotalAssets} +-- \] +-- 2. __Compliance Ratio Calculation:__ +-- The compliance percentage is bounded in \([0.0, 100.0]\): +-- \[ +-- \text{reportCompliancePct} = \frac{\text{reportCompliantCount}}{\text{reportTotalAssets}} \times 100.0 +-- \] +-- 3. __Observational Safety:__ +-- Audits are read-only and non-destructive. Computing an 'AuditReport' guarantees +-- zero filesystem mutations, zero file deletions, and zero timestamp alterations. +data AuditReport = AuditReport + { reportTargetDir :: !FilePath + -- ^ Target repository filesystem path audited. + , reportProjectName :: !Text + -- ^ Name of the audited project specification. + , reportResults :: ![AssetAuditResult] + -- ^ Detailed per-asset audit outcomes. + , reportTotalAssets :: !Int + -- ^ Total number of matrix assets evaluated. + , reportCompliantCount :: !Int + -- ^ Number of assets achieving full compliance. + , reportDriftCount :: !Int + -- ^ Number of existing assets with content or permission drift. + , reportMissingCount :: !Int + -- ^ Number of required assets missing from the filesystem. + , reportCompliancePct :: !Double + -- ^ Overall compliance percentage (0.0% to 100.0%). + } deriving stock (Eq, Show, Generic) + +-------------------------------------------------------------------------------- +-- 5. Operational Synchronization Modes +-------------------------------------------------------------------------------- + +-- | Operational mode controlling filesystem mutations during synchronization. +-- +-- Governs whether synchronization plans are simulated as read-only dry runs or +-- executed as atomic mutations on disk. +data SyncMode + = DryRun + -- ^ Inspect discrepancies and compute the 'SyncPlan', but perform no disk mutations. + | ApplySync + -- ^ Apply all planned changes: create missing files, update content, and fix permissions. + deriving stock (Eq, Show, Ord, Enum, Bounded, Generic) diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,772 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Module: Main +-- Description: Comprehensive test suite for gachi-sync +-- +-- Validates: +-- 1. Canonical Standardization Matrix completeness and category queries. +-- 2. Pure catalog template generators and multi-language formatting stanzas. +-- 3. Path token substitution (:name:, :project:). +-- 4. Audit engine accuracy: clean compliance, content drift detection, missing file reporting, +-- and permission drift detection on physical workspaces. +-- 5. Diagnostic ASCII report formatting. +-- 6. Forge-tiered CI matrix generation, asymmetric runner allocation, and classification (Milestone 3.3). +module Main (main) where + +import Control.Exception (bracket) +import qualified Data.Map.Strict as Map +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import System.Directory + ( createDirectoryIfMissing + , doesFileExist + , executable + , getPermissions + , removeDirectoryRecursive + , setPermissions + , setOwnerExecutable + ) +import System.Exit (ExitCode(..)) +import System.FilePath ((), takeFileName) +import System.Process (readProcessWithExitCode) +import Test.Hspec + +import Gachi.Schema.Project + ( Author(..) + , Project + , RemoteSpec(..) + , defaultProject + , remoteName + , remoteUrl + ) +import Gachi.Scaffold + ( ScaffoldMode(..) + , ScaffoldResult(..) + , generateAndWriteScaffold + ) +import Gachi.Sync + +-- | Test project specification for synthesis and auditing. +testProject :: Project +testProject = defaultProject "audit-test" (Author "Test Runner" "test@example.com") + +-- | Helper to create a temporary test directory and clean it up after testing. +withTempDir :: (FilePath -> IO a) -> IO a +withTempDir = bracket createTemp cleanupTemp + where + createTemp = do + let dir = "dist-newstyle" "test-audit-workspace" + createDirectoryIfMissing True dir + pure dir + cleanupTemp = removeDirectoryRecursive + +-- | Helper creating an isolated Git repository in a temporary directory for live remote testing. +withGitTempDir :: (FilePath -> IO a) -> IO a +withGitTempDir action = withTempDir $ \baseDir -> do + let repoDir = baseDir "git-remote-test" + createDirectoryIfMissing True repoDir + (code, _, err) <- readProcessWithExitCode "git" ["-C", repoDir, "init"] "" + if code == ExitSuccess + then action repoDir + else error ("Failed to initialize test git repo: " ++ err) + +main :: IO () +main = hspec $ do + describe "Gachi.Sync.Matrix (Standardization Matrix)" $ do + it "registers all 10 canonical dimensions" $ do + length canonicalDimensions `shouldBe` 10 + matrixDimensions canonicalMatrix `shouldBe` canonicalDimensions + + it "registers at least 20 canonical assets" $ do + length canonicalAssets `shouldSatisfy` (>= 20) + length (matrixAssets canonicalMatrix) `shouldSatisfy` (>= 20) + + it "assigns non-empty paths and descriptions to all canonical assets" $ do + mapM_ (\a -> do + assetPath a `shouldNotBe` "" + assetDescription a `shouldNotBe` "" + ) canonicalAssets + + it "filters assets correctly by category" $ do + let formatters = assetsForCategory CategoryFormatter canonicalMatrix + map assetPath formatters `shouldContain` ["fourmolu.yaml"] + map assetPath formatters `shouldContain` ["rustfmt.toml"] + map assetPath formatters `shouldContain` [".clang-format"] + + let linters = assetsForCategory CategoryLinter canonicalMatrix + map assetPath linters `shouldBe` [".hlint.yaml"] + + let builds = assetsForCategory CategoryBuild canonicalMatrix + map assetPath builds `shouldContain` ["cabal.project"] + + let gitGov = assetsForCategory CategoryGitGovernance canonicalMatrix + map assetPath gitGov `shouldContain` [".gitmessage"] + map assetPath gitGov `shouldContain` [".githooks/commit-msg"] + + let agents = assetsForCategory CategoryAgentAdvisory canonicalMatrix + map assetPath agents `shouldContain` ["AGENTS.md"] + map assetPath agents `shouldContain` [".agents/rules/commit-attribution.md"] + + it "identifies executable verification scripts and git hooks" $ do + let execs = executableAssets canonicalMatrix + map assetPath execs `shouldContain` [".githooks/commit-msg"] + map assetPath execs `shouldContain` [".githooks/pre-commit"] + map assetPath execs `shouldContain` ["bin/:name:-verify"] + map assetPath execs `shouldContain` ["bin/:name:-tagref"] + + it "counts assets per category accurately" $ do + let counts = countByCategory canonicalMatrix + length counts `shouldBe` 10 + all (\(_, c) -> c > 0) counts `shouldBe` True + + it "finds assets by relative path" $ do + let maybeHlint = findAssetByPath ".hlint.yaml" canonicalMatrix + fmap assetCategory maybeHlint `shouldBe` Just CategoryLinter + + let missing = findAssetByPath "nonexistent.file" canonicalMatrix + missing `shouldBe` Nothing + + describe "Gachi.Sync.Types (Path Resolution)" $ do + it "leaves static asset paths unchanged" $ do + let asset = StandardAsset ".hlint.yaml" CategoryLinter True False "HLint" (const "") + resolveAssetPath testProject asset `shouldBe` ".hlint.yaml" + + it "substitutes :name: tokens with project name" $ do + let asset = StandardAsset "bin/:name:-verify" CategoryVerification True True "Verify" (const "") + resolveAssetPath testProject asset `shouldBe` "bin/audit-test-verify" + + it "substitutes :project: tokens with project name" $ do + let asset = StandardAsset "docs/:project:-notes.md" CategoryLayout True False "Notes" (const "") + resolveAssetPath testProject asset `shouldBe` "docs/audit-test-notes.md" + + describe "Gachi.Sync.Catalog (Asset Generators)" $ do + it "synthesizes valid Fourmolu configuration" $ do + fourmoluTemplate `shouldSatisfy` (\t -> "indentation: 2" `T.isInfixOf` t) + fourmoluTemplate `shouldSatisfy` (\t -> "fixities:" `T.isInfixOf` t) + + it "synthesizes valid rustfmt configuration" $ do + rustfmtTemplate `shouldSatisfy` (\t -> "edition = \"2021\"" `T.isInfixOf` t) + + it "synthesizes valid .clang-format configuration" $ do + clangFormatTemplate `shouldSatisfy` (\t -> "BasedOnStyle: LLVM" `T.isInfixOf` t) + + it "synthesizes high-resource GitHub Actions workflow" $ do + let ci = githubCiTemplate testProject + ci `shouldSatisfy` (\t -> "./bin/audit-test-verify" `T.isInfixOf` t) + ci `shouldSatisfy` (\t -> "ubuntu-latest" `T.isInfixOf` t) + + it "synthesizes lightweight community GitLab CI workflow" $ do + let ci = gitlabCiTemplate testProject + ci `shouldSatisfy` (\t -> "./bin/audit-test-tagref" `T.isInfixOf` t) + + it "synthesizes modular agent advisory rules" $ do + commitAttributionRuleTemplate `shouldSatisfy` (\t -> "Assisted-by:" `T.isInfixOf` t) + codeNavigationRuleTemplate `shouldSatisfy` (\t -> "`./tags` symbol jump" `T.isInfixOf` t) + compilerVerificationRuleTemplate `shouldSatisfy` (\t -> "Zero warnings tolerated" `T.isInfixOf` t) + documentationPrecedenceRuleTemplate `shouldSatisfy` (\t -> "Precedence rule" `T.isInfixOf` t) + + describe "Gachi.Sync.Audit (Repository Audit Engine)" $ do + it "evaluates clean synthesized workspace with high compliance" $ withTempDir $ \tmpDir -> do + -- Materialize clean workspace + res <- generateAndWriteScaffold tmpDir OverwriteExisting testProject + writtenFiles res `shouldSatisfy` (not . null) + skippedFiles res `shouldBe` [] + + -- Also ensure Fourmolu config is created if needed by matrix + TIO.writeFile (tmpDir "fourmolu.yaml") fourmoluTemplate + + -- Run audit + report <- auditRepository tmpDir testProject canonicalMatrix + reportProjectName report `shouldBe` "audit-test" + reportTotalAssets report `shouldSatisfy` (>= 20) + reportCompliantCount report `shouldSatisfy` (>= 14) + reportCompliancePct report `shouldSatisfy` (>= 70.0) + + it "detects content drift when a file is modified" $ withTempDir $ \tmpDir -> do + -- Materialize clean workspace + _ <- generateAndWriteScaffold tmpDir OverwriteExisting testProject + -- Deliberately mutate .hlint.yaml + TIO.writeFile (tmpDir ".hlint.yaml") "# Divergent HLint configuration\n" + + report <- auditRepository tmpDir testProject canonicalMatrix + reportDriftCount report `shouldSatisfy` (>= 1) + let drifts = filterDriftResults report + map (assetPath . resultAsset) drifts `shouldContain` [".hlint.yaml"] + + it "detects missing assets when a required file is absent" $ withTempDir $ \tmpDir -> do + -- In an empty directory, all required assets should be missing + report <- auditRepository tmpDir testProject canonicalMatrix + reportMissingCount report `shouldSatisfy` (>= 15) + reportCompliantCount report `shouldBe` 0 + let missings = filterMissingResults report + map (assetPath . resultAsset) missings `shouldContain` [".hlint.yaml"] + map (assetPath . resultAsset) missings `shouldContain` [".gitmessage"] + + it "detects permission drift on executable scripts" $ withTempDir $ \tmpDir -> do + -- Materialize clean workspace + _ <- generateAndWriteScaffold tmpDir OverwriteExisting testProject + -- Strip executable bit from .githooks/commit-msg + let hookPath = tmpDir ".githooks" "commit-msg" + perms <- getPermissions hookPath + setPermissions hookPath (setOwnerExecutable False perms) + + report <- auditRepository tmpDir testProject canonicalMatrix + let permDrifts = filter (\r -> case resultStatus r of { StatusPermissionDrift _ _ -> True; _ -> False }) (reportResults report) + map (assetPath . resultAsset) permDrifts `shouldContain` [".githooks/commit-msg"] + + it "renders ASCII diagnostic reports with summary and tables" $ withTempDir $ \tmpDir -> do + report <- auditRepository tmpDir testProject canonicalMatrix + let formatted = formatAuditReport report + formatted `shouldSatisfy` (\t -> "Gachi Standardization Matrix Audit Report" `T.isInfixOf` t) + formatted `shouldSatisfy` (\t -> "Total Assets:" `T.isInfixOf` t) + formatted `shouldSatisfy` (\t -> "Missing Required Assets:" `T.isInfixOf` t) + + let str = formatAuditReportString report + str `shouldSatisfy` (\s -> length s > 100) + + describe "Gachi.Sync.Hash (Differential Cryptographic Hashing)" $ do + it "computes standard FIPS 180-2 SHA-256 test vectors" $ do + -- NIST Empty String Vector + sha256Text "" `shouldBe` "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" + -- NIST 3-character Vector + sha256Text "abc" `shouldBe` "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad" + -- NIST Pangram Vector + sha256Text "The quick brown fox jumps over the lazy dog" + `shouldBe` "d7a8fbb307d7809469ca9abcb0082e4f8d5651e46d3cdb762d02d0bf37c9e592" + + it "computes consistent hashes across text and file representations" $ withTempDir $ \tmpDir -> do + let sampleText = "Author: Nadia Yvette Chambers\nLicense: EUPL-1.2\n" + filePath = tmpDir "test-hash.txt" + TIO.writeFile filePath sampleText + fileHash <- sha256File filePath + let textHash = sha256Text sampleText + fileHash `shouldBe` textHash + + describe "Gachi.Sync.Engine (Harmonic Chattering Synchronization)" $ do + it "computes a sync plan proposing creation of all assets in an empty workspace" $ withTempDir $ \tmpDir -> do + plan <- computeSyncPlan tmpDir testProject canonicalMatrix + planProjectName plan `shouldBe` "audit-test" + planCreatedCount plan `shouldSatisfy` (>= 20) + planUpdatedCount plan `shouldBe` 0 + planChmodCount plan `shouldBe` 0 + isPlanClean plan `shouldBe` False + + it "executes sync plan in DryRun mode without creating files on disk" $ withTempDir $ \tmpDir -> do + plan <- computeSyncPlan tmpDir testProject canonicalMatrix + res <- executeSyncPlan DryRun plan + resultMode res `shouldBe` DryRun + resultSuccess res `shouldBe` True + length (resultCreated res) `shouldSatisfy` (>= 20) + -- Assert disk files remain untouched + doesFileExist (tmpDir ".hlint.yaml") `shouldReturn` False + doesFileExist (tmpDir ".gitmessage") `shouldReturn` False + + it "executes sync plan in ApplySync mode and creates files on disk" $ withTempDir $ \tmpDir -> do + plan <- computeSyncPlan tmpDir testProject canonicalMatrix + res <- executeSyncPlan ApplySync plan + resultMode res `shouldBe` ApplySync + resultSuccess res `shouldBe` True + length (resultCreated res) `shouldSatisfy` (>= 20) + -- Assert disk files exist + doesFileExist (tmpDir ".hlint.yaml") `shouldReturn` True + doesFileExist (tmpDir ".gitmessage") `shouldReturn` True + -- Assert executable bit + let hookPath = tmpDir ".githooks" "commit-msg" + perms <- getPermissions hookPath + executable perms `shouldBe` True + + it "satisfies the mathematical idempotency guarantee: f(f(x)) = f(x)" $ withTempDir $ \tmpDir -> do + -- 1. First synchronization pass: applies all creations + res1 <- syncRepository ApplySync tmpDir testProject canonicalMatrix + resultSuccess res1 `shouldBe` True + length (resultCreated res1) `shouldSatisfy` (>= 20) + + -- 2. Second synchronization pass: must produce zero modifications + res2 <- syncRepository ApplySync tmpDir testProject canonicalMatrix + resultSuccess res2 `shouldBe` True + length (resultCreated res2) `shouldBe` 0 + length (resultUpdated res2) `shouldBe` 0 + length (resultChmodded res2) `shouldBe` 0 + length (resultUnchanged res2) `shouldSatisfy` (>= 20) + length (resultErrors res2) `shouldBe` 0 + + -- 3. Verify that re-computing the plan yields isPlanClean == True + plan2 <- computeSyncPlan tmpDir testProject canonicalMatrix + isPlanClean plan2 `shouldBe` True + + it "detects and repairs content drift and permission drift non-destructively" $ withTempDir $ \tmpDir -> do + -- 1. Initial synchronization + _ <- syncRepository ApplySync tmpDir testProject canonicalMatrix + + -- 2. Mutate .hlint.yaml (content drift) + let hlintPath = tmpDir ".hlint.yaml" + TIO.writeFile hlintPath "# Corrupted or drifted HLint file\n" + + -- 3. Strip executable bit from .githooks/commit-msg (permission drift) + let hookPath = tmpDir ".githooks" "commit-msg" + hookPerms <- getPermissions hookPath + setPermissions hookPath (setOwnerExecutable False hookPerms) + + -- 4. Compute plan and verify drift detection + driftPlan <- computeSyncPlan tmpDir testProject canonicalMatrix + planUpdatedCount driftPlan `shouldBe` 1 + planChmodCount driftPlan `shouldBe` 1 + isPlanClean driftPlan `shouldBe` False + + -- 5. Synchronize with ApplySync to repair drift + repairRes <- syncRepository ApplySync tmpDir testProject canonicalMatrix + resultSuccess repairRes `shouldBe` True + resultUpdated repairRes `shouldBe` [".hlint.yaml"] + resultChmodded repairRes `shouldBe` [".githooks/commit-msg"] + + -- 6. Verify restored state is clean + postPlan <- computeSyncPlan tmpDir testProject canonicalMatrix + isPlanClean postPlan `shouldBe` True + permsAfter <- getPermissions hookPath + executable permsAfter `shouldBe` True + + it "discovers sibling ecosystem repositories" $ withTempDir $ \tmpDir -> do + -- Create repository A (has .git) + let repoA = tmpDir "repo-alpha" + createDirectoryIfMissing True (repoA ".git") + + -- Create repository B (has project.dhall) + let repoB = tmpDir "repo-beta" + createDirectoryIfMissing True repoB + TIO.writeFile (repoB "project.dhall") "-- test dhall" + + -- Create non-repository directory + let plainDir = tmpDir "plain-notes" + createDirectoryIfMissing True plainDir + + discovered <- discoverEcosystemRepositories tmpDir + length discovered `shouldBe` 2 + map takeFileName discovered `shouldMatchList` ["repo-alpha", "repo-beta"] + + it "renders formatted diagnostic sync plan and sync result tables" $ withTempDir $ \tmpDir -> do + plan <- computeSyncPlan tmpDir testProject canonicalMatrix + let planText = formatSyncPlan plan + planText `shouldSatisfy` (\t -> "Gachi Synchronization Plan" `T.isInfixOf` t) + planText `shouldSatisfy` (\t -> "Actions Planned:" `T.isInfixOf` t) + + res <- executeSyncPlan DryRun plan + let resText = formatSyncResult res + resText `shouldSatisfy` (\t -> "Gachi Synchronization Execution Summary" `T.isInfixOf` t) + resText `shouldSatisfy` (\t -> "DRY RUN" `T.isInfixOf` t) + + describe "Gachi.Sync.CI (Forge-Tiered CI Matrix Synthesis)" $ do + it "classifies forge types from standard workflow paths" $ do + classifyForge ".github/workflows/ci.yml" `shouldBe` Just ForgeGitHub + classifyForge ".github/workflows/verify.yaml" `shouldBe` Just ForgeGitHub + classifyForge ".gitlab-ci.yml" `shouldBe` Just ForgeGitLab + classifyForge ".woodpecker.yml" `shouldBe` Just ForgeWoodpecker + classifyForge ".woodpecker/verify.yml" `shouldBe` Just ForgeWoodpecker + classifyForge ".forgejo/workflows/ci.yml" `shouldBe` Just ForgeForgejo + classifyForge ".radicle/ci.yaml" `shouldBe` Just ForgeRadicle + classifyForge "docs/INDEX.md" `shouldBe` Nothing + + it "classifies resource tiers accurately from paths and specifications" $ do + classifyTier ".github/workflows/ci.yml" `shouldBe` Just TierHighResource + classifyTier ".gitlab-ci.yml" `shouldBe` Just TierLightweightStatic + classifyTier ".woodpecker.yml" `shouldBe` Just TierLightweightStatic + classifyTier ".forgejo/workflows/ci.yml" `shouldBe` Just TierHighResource + classifyTier ".radicle/ci.yaml" `shouldBe` Just TierLightweightStatic + classifyTier "docs/INDEX.md" `shouldBe` Nothing + + isHighResource defaultGitHubSpec `shouldBe` True + isLightweight defaultGitHubSpec `shouldBe` False + + isLightweight defaultGitLabSpec `shouldBe` True + isHighResource defaultGitLabSpec `shouldBe` False + + isLightweight defaultWoodpeckerSpec `shouldBe` True + isHighResource defaultForgejoSpec `shouldBe` True + isLightweight defaultRadicleSpec `shouldBe` True + + it "synthesizes complete high-resource GitHub Actions workflows" $ do + let wf = generateGitHubWorkflow defaultGitHubSpec testProject + wf `shouldSatisfy` ("actions/checkout@v4" `T.isInfixOf`) + wf `shouldSatisfy` ("actions/cache@v4" `T.isInfixOf`) + wf `shouldSatisfy` ("haskell-actions/setup@v2" `T.isInfixOf`) + wf `shouldSatisfy` ("ghc-version: '9.14.1'" `T.isInfixOf`) + wf `shouldSatisfy` ("cabal-version: '3.18.1.0'" `T.isInfixOf`) + wf `shouldSatisfy` ("cabal build all --enable-tests" `T.isInfixOf`) + wf `shouldSatisfy` ("./bin/audit-test-cloc --check" `T.isInfixOf`) + wf `shouldSatisfy` ("./bin/audit-test-verify" `T.isInfixOf`) + wf `shouldSatisfy` ("./bin/audit-test-tagref" `T.isInfixOf`) + wf `shouldSatisfy` ("./bin/audit-test-linkcheck" `T.isInfixOf`) + wf `shouldSatisfy` ("sudo apt-get install -y bubblewrap sqlite3 z3" `T.isInfixOf`) + wf `shouldSatisfy` ("kernel.apparmor_restrict_unprivileged_userns=0" `T.isInfixOf`) + wf `shouldSatisfy` ("url.\"https://github.com/\".insteadOf" `T.isInfixOf`) + + it "synthesizes lightweight community GitLab CI workflows without compiler overhead" $ do + let wf = generateGitLabWorkflow defaultGitLabSpec testProject + wf `shouldSatisfy` ("image: debian:bookworm-slim" `T.isInfixOf`) + wf `shouldSatisfy` ("stages:" `T.isInfixOf`) + wf `shouldSatisfy` ("tagref-check:" `T.isInfixOf`) + wf `shouldSatisfy` ("./bin/audit-test-tagref" `T.isInfixOf`) + wf `shouldSatisfy` ("./bin/audit-test-linkcheck" `T.isInfixOf`) + wf `shouldSatisfy` ("./bin/audit-test-cloc --check" `T.isInfixOf`) + -- Crucial invariant: No heavy GHC build steps in lightweight community CI + wf `shouldNotSatisfy` ("cabal build" `T.isInfixOf`) + wf `shouldNotSatisfy` ("ghc-version" `T.isInfixOf`) + + it "synthesizes lightweight Woodpecker CI pipelines" $ do + let wf = generateWoodpeckerWorkflow defaultWoodpeckerSpec testProject + wf `shouldSatisfy` ("pipeline:" `T.isInfixOf`) + wf `shouldSatisfy` ("image: debian:bookworm-slim" `T.isInfixOf`) + wf `shouldSatisfy` ("./bin/audit-test-tagref" `T.isInfixOf`) + wf `shouldSatisfy` ("./bin/audit-test-linkcheck" `T.isInfixOf`) + wf `shouldSatisfy` ("./bin/audit-test-cloc --check" `T.isInfixOf`) + wf `shouldNotSatisfy` ("cabal build" `T.isInfixOf`) + + it "synthesizes Radicle P2P local verification broker configurations" $ do + let wf = generateRadicleWorkflow defaultRadicleSpec testProject + wf `shouldSatisfy` ("version: 1" `T.isInfixOf`) + wf `shouldSatisfy` ("pipelines:" `T.isInfixOf`) + wf `shouldSatisfy` ("./bin/audit-test-tagref" `T.isInfixOf`) + wf `shouldSatisfy` ("./bin/audit-test-linkcheck" `T.isInfixOf`) + wf `shouldSatisfy` ("./bin/audit-test-cloc --check" `T.isInfixOf`) + + it "converts CI specifications into standard matrix assets in CategoryCIWorkflow" $ do + let assets = synthesizeCIAssets canonicalForgeSpecs + length assets `shouldBe` 3 + all (\a -> assetCategory a == CategoryCIWorkflow) assets `shouldBe` True + map assetPath assets `shouldMatchList` + [ ".github/workflows/ci.yml" + , ".gitlab-ci.yml" + , ".woodpecker.yml" + ] + map assetRequired assets `shouldMatchList` [True, True, False] + any assetExecutable assets `shouldBe` False + + it "extracts CI workflow assets from canonicalMatrix via ciWorkflowAssets" $ do + let ciAssets = ciWorkflowAssets canonicalMatrix + length ciAssets `shouldSatisfy` (>= 2) + map assetPath ciAssets `shouldContain` [".github/workflows/ci.yml", ".gitlab-ci.yml"] + all (\a -> assetCategory a == CategoryCIWorkflow) ciAssets `shouldBe` True + + it "supports high-resource GitLab and lightweight GitHub overrides via forgeDefaultSpec" $ do + let highGitLab = forgeDefaultSpec ForgeGitLab TierHighResource + ciTier highGitLab `shouldBe` TierHighResource + ciEnableTests highGitLab `shouldBe` True + ciContainerImage highGitLab `shouldBe` "haskell:9.14" + + let lightGH = forgeDefaultSpec ForgeGitHub TierLightweightStatic + ciTier lightGH `shouldBe` TierLightweightStatic + ciEnableTests lightGH `shouldBe` False + + describe "Gachi.Sync.Remote (Multi-Remote Topology & Provider Compliance)" $ do + it "classifies approved and excluded hosting providers with detailed rationales" $ do + classifyProvider "git@github.com:NadiaYvette/gachi.git" + `shouldBe` ProviderAllowed "GitHub" + classifyProvider "https://github.com/NadiaYvette/gachi.git" + `shouldBe` ProviderAllowed "GitHub" + classifyProvider "git@gitcode.com:NadiaYvette/gachi.git" + `shouldBe` ProviderAllowed "GitCode" + classifyProvider "git@framagit.org:NadiaYvette/gachi.git" + `shouldBe` ProviderAllowed "Framagit (GitLab CE)" + classifyProvider "git@git.disroot.org:NadiaYvette/gachi.git" + `shouldBe` ProviderAllowed "Disroot (Forgejo)" + classifyProvider "rad://z4V1sNQGXxPZ5wUQkjSoaDguKA8mt" + `shouldBe` ProviderAllowed "Radicle P2P" + + -- Verify SourceHut exclusion + case classifyProvider "git@git.sr.ht:~user/gachi" of + ProviderExcluded pName reason -> do + pName `shouldBe` "SourceHut (git.sr.ht)" + reason `shouldSatisfy` ("AI" `T.isInfixOf`) + _ -> expectationFailure "Expected SourceHut to be excluded" + + -- Verify plaintext HTTP prohibition + case classifyProvider "http://github.com/NadiaYvette/gachi.git" of + ProviderExcluded pName reason -> do + pName `shouldBe` "Insecure Plaintext HTTP" + reason `shouldSatisfy` ("Plaintext" `T.isInfixOf`) + _ -> expectationFailure "Expected plaintext HTTP to be excluded" + + -- Predicate checks + isProviderCompliant "git@github.com:NadiaYvette/gachi.git" `shouldBe` True + isProviderCompliant "rad://z4V1sNQGXxPZ5wUQkjSoaDguKA8mt" `shouldBe` True + isProviderCompliant "git@git.sr.ht:~user/gachi" `shouldBe` False + isProviderCompliant "http://github.com/NadiaYvette/gachi.git" `shouldBe` False + + it "filters compliant and non-compliant remote specifications" $ do + let rCompliant = RemoteSpec "github" "git@github.com:NadiaYvette/gachi.git" + rRadicle = RemoteSpec "rad" "rad://gachi" + rExcluded = RemoteSpec "srht" "git@git.sr.ht:~user/gachi" + allSpecs = [rCompliant, rRadicle, rExcluded] + + filterCompliantRemotes allSpecs `shouldBe` [rCompliant, rRadicle] + let nonComp = filterNonCompliantRemotes allSpecs + length nonComp `shouldBe` 1 + case nonComp of + ((r, _):_) -> remoteName r `shouldBe` "srht" + [] -> expectationFailure "Expected non-compliant remote" + + it "normalizes URLs and evaluates semantic equivalence" $ do + normalizeRemoteUrl "git@github.com:NadiaYvette/gachi.git" + `shouldBe` "git@github.com:nadiayvette/gachi" + normalizeRemoteUrl "https://github.com/NadiaYvette/gachi/" + `shouldBe` "https://github.com/nadiayvette/gachi" + + urlsMatch "git@github.com:NadiaYvette/gachi.git" "https://github.com/NadiaYvette/gachi" + `shouldBe` True + urlsMatch "git@github.com:NadiaYvette/gachi.git" "git@gitcode.com:NadiaYvette/gachi.git" + `shouldBe` False + + it "synthesizes canonical 5-forge replication specs" $ do + canonicalRemoteNames `shouldBe` ["rad", "github", "gitcode", "framagit", "disroot"] + all isCanonicalRemoteName canonicalRemoteNames `shouldBe` True + isCanonicalRemoteName "origin" `shouldBe` False + isCanonicalRemoteName "upstream" `shouldBe` False + + let specs = defaultRemoteSpecsFor "gachi" + length specs `shouldBe` 5 + map remoteName specs `shouldBe` ["rad", "github", "gitcode", "framagit", "disroot"] + map remoteUrl specs `shouldBe` + [ "rad://gachi" + , "git@github.com:NadiaYvette/gachi.git" + , "git@gitcode.com:NadiaYvette/gachi.git" + , "git@framagit.org:NadiaYvette/gachi.git" + , "git@git.disroot.org:NadiaYvette/gachi.git" + ] + + it "parses git remote -v porcelain output into ConfiguredRemote records" $ do + let rawOutput = T.unlines + [ "github\tgit@github.com:NadiaYvette/gachi.git (fetch)" + , "github\tgit@github.com:NadiaYvette/gachi.git (push)" + , "rad\trad://gachi (fetch)" + , "rad\trad://gachi (push)" + , "all\tgit@github.com:NadiaYvette/gachi.git (push)" + , "all\tgit@gitcode.com:NadiaYvette/gachi.git (push)" + ] + configured = parseGitRemoteOutput rawOutput + length configured `shouldBe` 3 + let mGithub = lookup "github" [(crName r, r) | r <- configured] + case mGithub of + Just gh -> do + crFetchUrl gh `shouldBe` Just "git@github.com:NadiaYvette/gachi.git" + crPushUrls gh `shouldBe` ["git@github.com:NadiaYvette/gachi.git"] + Nothing -> expectationFailure "Expected 'github' remote parsed" + + let mAll = lookup "all" [(crName r, r) | r <- configured] + case mAll of + Just allR -> do + crFetchUrl allR `shouldBe` Nothing + length (crPushUrls allR) `shouldBe` 2 + Nothing -> expectationFailure "Expected 'all' remote parsed" + + it "evaluates topology reports detecting clean alignment, missing remotes, drift, and prohibited providers" $ do + let specs = defaultRemoteSpecsFor "gachi" + + -- 1. Empty configuration -> 5 missing remotes + let reportEmpty = evaluateRemoteTopology "gachi" specs [] + reportCompliant reportEmpty `shouldBe` False + remoteMissingCount reportEmpty `shouldBe` 5 + remoteDriftCount reportEmpty `shouldBe` 0 + remoteNonCompliantCount reportEmpty `shouldBe` 0 + + -- 2. Fully aligned configuration -> compliant + let alignedConfig = + [ ConfiguredRemote "rad" (Just "rad://gachi") ["rad://gachi"] + , ConfiguredRemote "github" (Just "git@github.com:NadiaYvette/gachi.git") ["git@github.com:NadiaYvette/gachi.git"] + , ConfiguredRemote "gitcode" (Just "git@gitcode.com:NadiaYvette/gachi.git") ["git@gitcode.com:NadiaYvette/gachi.git"] + , ConfiguredRemote "framagit" (Just "git@framagit.org:NadiaYvette/gachi.git") ["git@framagit.org:NadiaYvette/gachi.git"] + , ConfiguredRemote "disroot" (Just "git@git.disroot.org:NadiaYvette/gachi.git") ["git@git.disroot.org:NadiaYvette/gachi.git"] + ] + reportAligned = evaluateRemoteTopology "gachi" specs alignedConfig + reportCompliant reportAligned `shouldBe` True + remoteMissingCount reportAligned `shouldBe` 0 + + -- 3. Drifted URL + let driftedConfig = + [ ConfiguredRemote "rad" (Just "rad://gachi") ["rad://gachi"] + , ConfiguredRemote "github" (Just "git@github.com:OtherOrg/gachi.git") ["git@github.com:OtherOrg/gachi.git"] + , ConfiguredRemote "gitcode" (Just "git@gitcode.com:NadiaYvette/gachi.git") ["git@gitcode.com:NadiaYvette/gachi.git"] + , ConfiguredRemote "framagit" (Just "git@framagit.org:NadiaYvette/gachi.git") ["git@framagit.org:NadiaYvette/gachi.git"] + , ConfiguredRemote "disroot" (Just "git@git.disroot.org:NadiaYvette/gachi.git") ["git@git.disroot.org:NadiaYvette/gachi.git"] + ] + reportDrift = evaluateRemoteTopology "gachi" specs driftedConfig + reportCompliant reportDrift `shouldBe` False + remoteDriftCount reportDrift `shouldBe` 1 + + -- 4. Prohibited provider + let prohibitedConfig = + alignedConfig ++ [ConfiguredRemote "srht" (Just "git@git.sr.ht:~user/gachi") []] + reportProhibited = evaluateRemoteTopology "gachi" specs prohibitedConfig + reportCompliant reportProhibited `shouldBe` False + remoteNonCompliantCount reportProhibited `shouldBe` 1 + + it "computes deterministic RemoteSyncPlan and formats ASCII report tables" $ do + let specs = defaultRemoteSpecsFor "gachi" + mixedConfig = + [ ConfiguredRemote "github" (Just "git@github.com:OtherOrg/gachi.git") [] + , ConfiguredRemote "srht" (Just "git@git.sr.ht:~user/gachi") [] + ] + report = evaluateRemoteTopology "gachi" specs mixedConfig + plan = computeRemoteSyncPlan report + + planAddCount plan `shouldBe` 4 -- rad, gitcode, framagit, disroot + planUpdateCount plan `shouldBe` 1 -- github drift + planRemoveCount plan `shouldBe` 1 -- srht prohibited + + let reportTable = formatRemoteReport report + reportTable `shouldSatisfy` ("Gachi Multi-Remote Topology Audit" `T.isInfixOf`) + reportTable `shouldSatisfy` ("ref:note-remote-topology" `T.isInfixOf`) + + let planTable = formatRemoteSyncPlan plan + planTable `shouldSatisfy` ("[ADD REMOTE]" `T.isInfixOf`) + planTable `shouldSatisfy` ("[UPDATE URL]" `T.isInfixOf`) + planTable `shouldSatisfy` ("[REMOVE REMOTE]" `T.isInfixOf`) + + it "audits and executes synchronization in a live Git repository" $ do + withGitTempDir $ \repoDir -> do + let pName = T.pack (takeFileName repoDir) + proj = defaultProject pName (Author "Nadia" "nadia@example.com") + + -- Initial audit on fresh repo has 5 missing remotes + initialReport <- auditRemoteTopology repoDir proj + remoteMissingCount initialReport `shouldBe` 5 + + -- Dry run produces planned logs without altering git config + let initialPlan = computeRemoteSyncPlan initialReport + dryRes <- executeRemoteSyncPlan DryRun initialPlan + case dryRes of + Left err -> expectationFailure (T.unpack err) + Right logs -> length logs `shouldBe` 5 + + postDryRemotes <- queryGitRemotes repoDir + postDryRemotes `shouldBe` Right [] + + -- Apply synchronization to add all canonical remotes + applyRes <- executeRemoteSyncPlan ApplySync initialPlan + case applyRes of + Left err -> expectationFailure (T.unpack err) + Right logs -> length logs `shouldBe` 5 + + -- Verify all remotes configured in Git + configured <- queryGitRemotes repoDir + case configured of + Left err -> expectationFailure (T.unpack err) + Right rms -> do + length rms `shouldBe` 5 + map crName rms `shouldMatchList` ["rad", "github", "gitcode", "framagit", "disroot"] + + -- Secondary audit confirms full compliance + finalReport <- auditRemoteTopology repoDir proj + reportCompliant finalReport `shouldBe` True + remoteMissingCount finalReport `shouldBe` 0 + remoteDriftCount finalReport `shouldBe` 0 + remoteNonCompliantCount finalReport `shouldBe` 0 + + describe "Gachi.Sync.Sheaf (1-D Cellular Sheaf Coherence & Obstruction Localization)" $ do + it "constructs canonical star complex and computes topological Euler characteristic" $ do + let complex = buildCanonicalSheafComplex ["gachi", "polytropos"] + numVertices complex `shouldBe` 3 -- canonical, gachi, polytropos + numEdges complex `shouldBe` 20 -- 2 clients * 10 dimensions + eulerCharacteristic complex `shouldBe` -17 -- 3 - 20 = -17 + + it "evaluates coboundary delta^0 on harmonic cochain confirming 0-th cohomology H^0 equilibrium" $ do + let complex = buildCanonicalSheafComplex ["gachi", "polytropos"] + stalkGachi = canonicalRepoStalk { stalkRepoName = "gachi" } + stalkPoly = canonicalRepoStalk { stalkRepoName = "polytropos" } + c0 = Cochain0 $ Map.fromList + [ ("canonical", canonicalRepoStalk) + , ("gachi", stalkGachi) + , ("polytropos", stalkPoly) + ] + (Cochain1 diffs, isHarmonic) = coboundary complex defaultEcosystemSheaf c0 + + isHarmonic `shouldBe` True + Map.size diffs `shouldBe` 20 + all (uncurry (==)) (Map.elems diffs) `shouldBe` True + + let report = evaluateSheafCoherence complex c0 + reportIsHarmonic report `shouldBe` True + reportHarmonicEdges report `shouldBe` 20 + reportDriftEdges report `shouldBe` 0 + reportCoherencePct report `shouldBe` 100.0 + reportObstructions report `shouldBe` [] + + it "localizes 1-st cohomology H^1 boundary obstructions on drifting repository configuration" $ do + let complex = buildCanonicalSheafComplex ["gongju"] + driftStalk = canonicalRepoStalk + { stalkRepoName = "gongju" + , stalkGhcVersion = Just "9.12.1" -- Drift: expected 9.14.1 + , stalkHasCommitMsg = False -- Drift: missing hook + , stalkHasVerifyRunner = False -- Drift: missing runner + } + c0 = Cochain0 $ Map.fromList + [ ("canonical", canonicalRepoStalk) + , ("gongju", driftStalk) + ] + report = evaluateSheafCoherence complex c0 + + reportIsHarmonic report `shouldBe` False + reportHarmonicEdges report `shouldBe` 7 + reportDriftEdges report `shouldBe` 3 + reportCoherencePct report `shouldBe` 70.0 + + let obs = reportObstructions report + length obs `shouldBe` 3 + let driftedDims = map (edgeDimension . obstructionEdge) obs + driftedDims `shouldMatchList` + [ ContractGhcVersion + , ContractGitCommitHook + , ContractVerifyRunner + ] + + it "verifies restriction projections for all 10 contract dimensions" $ do + let stalk = canonicalRepoStalk + restrictRepoStalk ContractGhcVersion stalk `shouldBe` ContractText (Just "9.14.1") + restrictRepoStalk ContractCabalVersion stalk `shouldBe` ContractText (Just "3.0") + restrictRepoStalk ContractLicense stalk `shouldBe` ContractText (Just "EUPL-1.2") + restrictRepoStalk ContractGitCommitHook stalk `shouldBe` ContractBool True + restrictRepoStalk ContractGitPreCommitHook stalk `shouldBe` ContractBool True + restrictRepoStalk ContractGitMessage stalk `shouldBe` ContractBool True + restrictRepoStalk ContractHLintConfig stalk `shouldBe` ContractBool True + restrictRepoStalk ContractCIWorkflow stalk `shouldBe` ContractBool True + restrictRepoStalk ContractAgentsAdvisory stalk `shouldBe` ContractBool True + restrictRepoStalk ContractVerifyRunner stalk `shouldBe` ContractBool True + + it "inspects live repository checkout and confirms harmonic coherence against canonical contracts" $ do + stalk <- inspectRepoStalk "." + stalkGhcVersion stalk `shouldBe` Just "9.14.1" + stalkLicense stalk `shouldBe` Just "EUPL-1.2" + stalkHasCommitMsg stalk `shouldBe` True + stalkHasPreCommit stalk `shouldBe` True + stalkHasGitMessage stalk `shouldBe` True + stalkHasHLint stalk `shouldBe` True + stalkHasCIWorkflow stalk `shouldBe` True + stalkHasAgentsMd stalk `shouldBe` True + stalkHasVerifyRunner stalk `shouldBe` True + + report <- auditSheafTarget "." + reportIsHarmonic report `shouldBe` True + reportHarmonicEdges report `shouldBe` 10 + reportDriftEdges report `shouldBe` 0 + reportCoherencePct report `shouldBe` 100.0 + + it "formats aligned ASCII diagnostic reports for both harmonic and obstructed states" $ do + let complex = buildCanonicalSheafComplex ["gongju"] + driftStalk = canonicalRepoStalk + { stalkRepoName = "gongju" + , stalkGhcVersion = Just "9.12.1" + } + c0 = Cochain0 $ Map.fromList + [ ("canonical", canonicalRepoStalk) + , ("gongju", driftStalk) + ] + report = evaluateSheafCoherence complex c0 + formatted = formatSheafReport report + + formatted `shouldSatisfy` ("Gachi Cellular Sheaf Coherence Report" `T.isInfixOf`) + formatted `shouldSatisfy` ("0-th Cohomology H^0 (Harmonic Equilibrium)" `T.isInfixOf`) + formatted `shouldSatisfy` ("1-st Cohomology H^1 (Boundary Obstructions)" `T.isInfixOf`) + formatted `shouldSatisfy` ("Edge: canonical" `T.isInfixOf`) + formatted `shouldSatisfy` ("Update cabal.project / .cabal to target GHC 9.14.1" `T.isInfixOf`) + case reportObstructions report of + (obs:_) -> obstructionMessage obs `shouldSatisfy` ("Boundary obstruction on edge" `T.isInfixOf`) + [] -> expectationFailure "Expected at least one obstruction"