Files
inter-hub/Web/View/FederatedGovernance/Dashboard.hs
Bernd Worsch f1978c3888 fix(WP-0014): pre-flight compilation fixes, Tailwind pipeline, and admin seed
A2 — Compilation fixes:
- Remove inline FK constraints from Schema.sql; IHP schema compiler cannot
  parse them. Add 1744329600-restore-fk-constraints.sql migration to restore
  referential integrity at the DB level.
- Rename `#label` → `#label_` throughout to avoid clash with Haskell built-in.
- Fix `hub.id == hid` UUID comparisons to use `toUUID hub.id`.
- Replace non-existent `setStatus`/`respondJson` calls with
  `renderJsonWithStatusCode` throughout Api controllers.
- Fix qualified package import for `cryptohash-sha256` in Auth.hs.
- Add `CanSelect (Text, Text)` instance in Helper.View.
- Refactor HSX inline lambdas to named helper functions in 100+ views
  (GHC cannot infer types for anonymous functions inside quasi-quoted HSX).
- Fix missing imports (IHP.QueryBuilder, IHP.Fetch, Web.Routes, Only, etc.)
  across helpers and controllers.
- Remove duplicate `diffUTCTime` definition in BottleneckDetector.
- Change `createEventForHub` return type from `IO ResponseReceived` to `IO ()`.
- Seed type-registry vocabulary via 1744502400-seed-type-registries.sql
  (moved from Schema.sql where IHP does not execute INSERT statements).

A3 — Tailwind build pipeline:
- Add `tailwindcss` to flake.nix native packages.
- Uncomment `tailwind.exec` process in devenv shell config.
- Add tailwind/tailwind.config.js (scans Web/View/**/*.hs).
- Add tailwind/app.css with @tailwind directives.

A4 — Admin user seed:
- Add 1744416000-seed-admin-user.sql: inserts admin@inter-hub.local
  with bcrypt-hashed password admin1234! (cost 10).
- Add .env.example documenting all required environment variables
  and default admin credentials.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-04 09:55:12 +00:00

245 lines
12 KiB
Haskell

module Web.View.FederatedGovernance.Dashboard where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import qualified Data.List as List
data FederatedGovernanceDashboardView = FederatedGovernanceDashboardView
{ hubs :: ![Hub]
, widgets :: ![Widget]
, ownerships :: ![WidgetOwnership]
, rules :: ![HubRoutingRule]
, routedCandidates :: ![RequirementCandidate]
, overlays :: ![FederatedPolicyOverlay]
, allDecisions :: ![DecisionRecord]
, allPolicies :: ![PolicyReference]
, stewards :: ![StewardshipRole]
, recentArchives :: ![ArchiveRecord]
}
instance View FederatedGovernanceDashboardView where
html FederatedGovernanceDashboardView { .. } = [hsx|
<div class="flex items-center justify-between mb-6">
<h1 class="text-2xl font-semibold">Federated Governance</h1>
<a href={PolicyComplianceDashboardAction}
class="text-sm text-indigo-600 hover:underline">Policy Compliance </a>
</div>
<div class="grid grid-cols-1 gap-6 lg:grid-cols-2">
{panel1Ownership}
{panel2Routing}
{panel3PolicyCompliance}
{panel4Stewardship}
{panel5Archive}
</div>
|]
where
-- ── Panel 1: Ownership coverage ──────────────────────────────────
totalWidgets = length widgets
ownedWidgetIds = List.nub (map (.widgetId) ownerships)
ownedCount = length ownedWidgetIds
localCount = length (filter (\o -> o.ownershipType == "local") ownerships)
delegatedCount = length (filter (\o -> o.ownershipType == "delegated") ownerships)
globalCount = length (filter (\o -> o.ownershipType == "global") ownerships)
ownershipPct :: Int
ownershipPct = if totalWidgets == 0 then 0 else (ownedCount * 100) `div` totalWidgets
panel1Ownership = [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-5">
<div class="flex items-center justify-between mb-4">
<h2 class="font-medium text-gray-800">Ownership Coverage</h2>
<a href={WidgetOwnershipsAction}
class="text-xs text-blue-600 hover:underline">View all </a>
</div>
<div class="flex gap-6 mb-4">
<div class="text-center">
<div class="text-3xl font-bold text-gray-900">{show ownedCount}</div>
<div class="text-xs text-gray-500">of {show totalWidgets} widgets owned</div>
</div>
<div class="text-center">
<div class="text-3xl font-bold text-indigo-600">{show ownershipPct}%</div>
<div class="text-xs text-gray-500">coverage</div>
</div>
</div>
<div class="flex gap-3 text-xs">
<span class="bg-gray-100 text-gray-700 px-2 py-1 rounded">
local: {show localCount}
</span>
<span class="bg-blue-100 text-blue-700 px-2 py-1 rounded">
delegated: {show delegatedCount}
</span>
<span class="bg-purple-100 text-purple-700 px-2 py-1 rounded">
global: {show globalCount}
</span>
</div>
</div>
|]
-- ── Panel 2: Routing activity ─────────────────────────────────────
activeRulesCount = length rules
routedCount = length routedCandidates
hubName hid = maybe (show hid) (.name) (find (\h -> toUUID h.id == hid) hubs)
panel2Routing = [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-5">
<div class="flex items-center justify-between mb-4">
<h2 class="font-medium text-gray-800">Routing Activity</h2>
<a href={HubRoutingRulesAction}
class="text-xs text-blue-600 hover:underline">Rules </a>
</div>
<div class="flex gap-6 mb-4">
<div class="text-center">
<div class="text-3xl font-bold text-gray-900">{show activeRulesCount}</div>
<div class="text-xs text-gray-500">active rules</div>
</div>
<div class="text-center">
<div class="text-3xl font-bold text-green-600">{show routedCount}</div>
<div class="text-xs text-gray-500">routed (30 days)</div>
</div>
</div>
{renderRulesSection rules}
</div>
|]
renderRulesSection :: [HubRoutingRule] -> Html
renderRulesSection [] = [hsx|<p class="text-xs text-gray-400">No active routing rules.</p>|]
renderRulesSection rs = [hsx|
<div class="space-y-1">
{forEach (take 5 rs) renderRuleRow}
</div>
|]
renderRuleRow :: HubRoutingRule -> Html
renderRuleRow r = [hsx|
<div class="flex items-center gap-2 text-xs text-gray-600">
<span class="font-medium">{hubName r.sourceHubId}</span>
<span class="text-gray-400"></span>
<span class="font-medium">{hubName r.targetHubId}</span>
{maybe mempty renderMatchCategory r.matchCategory}
</div>
|]
renderMatchCategory :: Text -> Html
renderMatchCategory c = [hsx|<span class="text-gray-400">({c})</span>|]
-- ── Panel 3: Policy compliance ────────────────────────────────────
activeOverlaysCount = length overlays
decisionIdsWithPolicy = List.nub $ map (Just . (.decisionId)) allPolicies
coveredDecisions = length $ filter (\d -> Just d.id `elem` decisionIdsWithPolicy) allDecisions
totalDecisions = length allDecisions
policyPct :: Int
policyPct = if totalDecisions == 0 then 0
else (coveredDecisions * 100) `div` totalDecisions
panel3PolicyCompliance = [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-5">
<div class="flex items-center justify-between mb-4">
<h2 class="font-medium text-gray-800">Policy Compliance</h2>
<a href={PolicyComplianceDashboardAction}
class="text-xs text-blue-600 hover:underline">Dashboard </a>
</div>
<div class="flex gap-6 mb-4">
<div class="text-center">
<div class="text-3xl font-bold text-gray-900">{show activeOverlaysCount}</div>
<div class="text-xs text-gray-500">active overlays</div>
</div>
<div class="text-center">
<div class="text-3xl font-bold text-indigo-600">{show policyPct}%</div>
<div class="text-xs text-gray-500">decision coverage</div>
</div>
</div>
{renderOverlaysList overlays}
</div>
|]
-- ── Panel 4: Stewardship coverage ─────────────────────────────────
hubsWithStewards = List.nub (map (.hubId) stewards)
stewardedCount = length hubsWithStewards
totalHubs = length hubs
hubsWithNoSteward = filter (\h -> toUUID h.id `notElem` hubsWithStewards) hubs
panel4Stewardship = [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-5">
<div class="flex items-center justify-between mb-4">
<h2 class="font-medium text-gray-800">Stewardship Coverage</h2>
<a href={StewardshipRolesAction}
class="text-xs text-blue-600 hover:underline">Roles </a>
</div>
<div class="flex gap-6 mb-4">
<div class="text-center">
<div class="text-3xl font-bold text-gray-900">{show stewardedCount}</div>
<div class="text-xs text-gray-500">of {show totalHubs} hubs stewarded</div>
</div>
<div class="text-center">
<div class="text-3xl font-bold text-amber-600">{show (length hubsWithNoSteward)}</div>
<div class="text-xs text-gray-500">hubs unassigned</div>
</div>
</div>
{renderUnstewarded hubsWithNoSteward}
</div>
|]
-- ── Panel 5: Archive activity ─────────────────────────────────────
archiveByType = List.sortBy (\a b -> compare (fst a) (fst b))
$ map (\grp -> ((head grp).subjectType, length grp))
$ List.groupBy (\a b -> a.subjectType == b.subjectType)
$ List.sortBy (\a b -> compare a.subjectType b.subjectType) recentArchives
panel5Archive = [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-5 lg:col-span-2">
<div class="flex items-center justify-between mb-4">
<h2 class="font-medium text-gray-800">Archive Activity (90 days)</h2>
<a href={ArchiveRecordsAction}
class="text-xs text-blue-600 hover:underline">All records </a>
</div>
{renderArchiveActivity recentArchives archiveByType}
</div>
|]
renderOverlaysList :: [FederatedPolicyOverlay] -> Html
renderOverlaysList [] = [hsx|<p class="text-xs text-gray-400">No active policy overlays.</p>|]
renderOverlaysList overlays = [hsx|
<div class="space-y-1">
{forEach overlays renderOverlayTitle}
</div>
|]
renderOverlayTitle :: FederatedPolicyOverlay -> Html
renderOverlayTitle o = [hsx|<div class="text-xs text-gray-600 truncate">{o.title}</div>|]
renderUnstewarded :: [Hub] -> Html
renderUnstewarded [] = [hsx|<p class="text-xs text-green-600">All hubs have active stewards.</p>|]
renderUnstewarded hs = [hsx|
<div>
<p class="text-xs text-gray-500 mb-1">Hubs without stewards:</p>
<div class="flex flex-wrap gap-1">
{forEach hs renderUnstewardedHub}
</div>
</div>
|]
renderUnstewardedHub :: Hub -> Html
renderUnstewardedHub h = [hsx|<span class="text-xs bg-amber-100 text-amber-700 px-2 py-0.5 rounded">{h.name}</span>|]
renderArchiveActivity :: [ArchiveRecord] -> [(Text, Int)] -> Html
renderArchiveActivity [] _ = [hsx|<p class="text-sm text-gray-400">No artifacts archived in the last 90 days.</p>|]
renderArchiveActivity archives byType = [hsx|
<div class="flex items-center gap-3 mb-2">
<div class="text-3xl font-bold text-gray-900">{show (length archives)}</div>
<div class="text-xs text-gray-500">total archived artifacts</div>
</div>
<div class="flex flex-wrap gap-2">
{forEach byType renderArchiveTypeChip}
</div>
|]
renderArchiveTypeChip :: (Text, Int) -> Html
renderArchiveTypeChip (typ, cnt) = [hsx|
<span class="text-sm bg-amber-50 border border-amber-200 text-amber-800 px-3 py-1 rounded">
{typ}: {show cnt}
</span>
|]