Files
inter-hub/Web/View/FederatedPolicyOverlays/PolicyComplianceDashboard.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

80 lines
3.3 KiB
Haskell
Raw Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
module Web.View.FederatedPolicyOverlays.PolicyComplianceDashboard where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data PolicyComplianceDashboardView = PolicyComplianceDashboardView
{ overlays :: ![FederatedPolicyOverlay]
, hubs :: ![Hub]
, decisions :: ![DecisionRecord]
, policies :: ![PolicyReference]
}
instance View PolicyComplianceDashboardView where
html PolicyComplianceDashboardView { .. } = [hsx|
<div class="flex items-center justify-between mb-6">
<h1 class="text-2xl font-semibold">Policy Compliance Dashboard</h1>
<a href={FederatedPolicyOverlaysAction}
class="text-sm text-gray-500 hover:underline"> All Policies</a>
</div>
{renderComplianceOverlays overlays}
<div class="mt-8 bg-white rounded-lg border border-gray-200 p-6">
<h2 class="text-lg font-medium text-gray-800 mb-4">Overall Coverage</h2>
<div class="flex items-center gap-6">
<div class="text-center">
<div class="text-3xl font-bold text-gray-900">{show totalDecisions}</div>
<div class="text-xs text-gray-500 mt-1">Total Decisions</div>
</div>
<div class="text-center">
<div class="text-3xl font-bold text-green-600">{show coveredDecisions}</div>
<div class="text-xs text-gray-500 mt-1">With Policy Ref</div>
</div>
<div class="text-center">
<div class="text-3xl font-bold text-indigo-600">{coveragePct}%</div>
<div class="text-xs text-gray-500 mt-1">Coverage</div>
</div>
</div>
</div>
|]
where
decisionIdsWithPolicy = map (show . (.decisionId)) policies
coveredDecisions = length $ filter (\d -> show d.id `elem` decisionIdsWithPolicy) decisions
totalDecisions = length decisions
coveragePct :: Int
coveragePct = if totalDecisions == 0 then 0
else (coveredDecisions * 100) `div` totalDecisions
renderComplianceOverlays :: [FederatedPolicyOverlay] -> Html
renderComplianceOverlays [] = [hsx|
<div class="bg-gray-50 rounded-lg border border-gray-200 p-8 text-center">
<p class="text-gray-400 text-sm">No active policy overlays.</p>
</div>
|]
renderComplianceOverlays os = [hsx|
<div class="space-y-4">
{forEach os renderOverlayRow}
</div>
|]
renderOverlayRow :: FederatedPolicyOverlay -> Html
renderOverlayRow o = [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-5">
<div class="flex items-start justify-between">
<div>
<h3 class="font-medium text-gray-800">{o.title}</h3>
<p class="text-xs text-gray-500 mt-1">
Enforced from: {maybe "" show o.enforcedFrom}
</p>
</div>
<span class="text-xs bg-green-100 text-green-700 px-2 py-0.5 rounded font-medium">
active
</span>
</div>
</div>
|]