Files
inter-hub/Web/View/Hubs/AgentAuditDashboard.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

206 lines
8.6 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.Hubs.AgentAuditDashboard where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data AgentAuditDashboardView = AgentAuditDashboardView
{ hub :: !Hub
, proposals :: ![AgentProposal]
, reviews :: ![AgentReviewRecord]
, widgets :: ![Widget]
}
instance View AgentAuditDashboardView where
html AgentAuditDashboardView { .. } = [hsx|
<div class="flex items-center justify-between mb-6">
<div>
<h1 class="text-2xl font-semibold">Agent Audit Dashboard</h1>
<p class="text-sm text-gray-500">{hub.name}</p>
</div>
<a href={ShowHubAction (hub.id)}
class="text-sm text-indigo-600 hover:underline"> Hub</a>
</div>
<!-- KPI row -->
<div class="grid grid-cols-4 gap-4 mb-6">
{kpiCard "Total Proposals" (show totalProposals) "text-gray-800"}
{kpiCard "Pending" (show pendingCount) "text-yellow-700"}
{kpiCard "Acceptance Rate" (showPct acceptanceRate) "text-green-700"}
{kpiCard "Rejection Rate" (showPct rejectionRate) "text-red-700"}
</div>
<!-- Proposals by type -->
<div class="bg-white rounded-lg border border-gray-200 p-5 mb-5">
<h2 class="text-sm font-semibold text-gray-700 mb-3">Proposals by Type</h2>
<div class="flex gap-4 flex-wrap">
{forEach allTypes (renderTypeCount proposals)}
</div>
</div>
<!-- Unreviewed queue -->
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden mb-5">
<div class="px-5 py-3 border-b border-gray-100 bg-yellow-50">
<h2 class="text-sm font-semibold text-yellow-800">Unreviewed Queue ({show pendingCount})</h2>
</div>
{renderPendingQueue pending}
</div>
<!-- Recent proposals (last 20) -->
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden mb-5">
<div class="px-5 py-3 border-b border-gray-100">
<h2 class="text-sm font-semibold text-gray-700">Recent Proposals (last 20)</h2>
</div>
<table class="w-full text-sm">
<thead class="bg-gray-50 border-b border-gray-200">
<tr>
<th class="text-left px-4 py-2 font-medium text-gray-600 text-xs">Type</th>
<th class="text-left px-4 py-2 font-medium text-gray-600 text-xs">Source Widget</th>
<th class="text-left px-4 py-2 font-medium text-gray-600 text-xs">Status</th>
<th class="text-left px-4 py-2 font-medium text-gray-600 text-xs">Confidence</th>
<th class="text-left px-4 py-2 font-medium text-gray-600 text-xs">Age</th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach recent (renderRecentRow widgets)}
</tbody>
</table>
</div>
<!-- Attribution log: model_ref x proposal_type matrix -->
<div class="bg-white rounded-lg border border-gray-200 p-5">
<h2 class="text-sm font-semibold text-gray-700 mb-3">Attribution Log (model × type)</h2>
<table class="text-xs">
<thead>
<tr>
<th class="text-left px-3 py-1 text-gray-500">Model</th>
{forEach allTypes renderTypeHeader}
</tr>
</thead>
<tbody>
{forEach allModels (renderModelRow allTypes proposals)}
</tbody>
</table>
</div>
|]
where
totalProposals = length proposals
pending = filter (\p -> p.status == "pending") proposals
pendingCount = length pending
accepted = filter (\r -> r.decision == "accepted") reviews
rejected = filter (\r -> r.decision == "rejected") reviews
reviewed = length accepted + length rejected
acceptanceRate = if reviewed == 0 then 0 else fromIntegral (length accepted) / fromIntegral reviewed :: Double
rejectionRate = if reviewed == 0 then 0 else fromIntegral (length rejected) / fromIntegral reviewed :: Double
recent = take 20 proposals
allTypes = ["summary", "requirement_draft", "duplicate_flag", "policy_flag", "impl_proposal"]
allModels = nub (map (.modelRef) proposals)
renderTypeHeader :: Text -> Html
renderTypeHeader t = [hsx|<th class="px-3 py-1 text-gray-500">{t}</th>|]
renderModelRow :: [Text] -> [AgentProposal] -> Text -> Html
renderModelRow types props m = [hsx|
<tr class="border-t border-gray-100">
<td class="px-3 py-1 font-mono text-gray-600">{m}</td>
{forEach types (renderMatrixCell props m)}
</tr>
|]
renderMatrixCell :: [AgentProposal] -> Text -> Text -> Html
renderMatrixCell props m t =
let cnt = length (filter (\p -> p.modelRef == m && p.proposalType == t) props)
display = if cnt == 0 then "" else show cnt
in [hsx|<td class="px-3 py-1 text-center text-gray-700">{display}</td>|]
kpiCard :: Text -> Text -> Text -> Html
kpiCard label value colorClass = [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-4">
<p class="text-xs text-gray-500 mb-1">{label}</p>
<p class={"text-2xl font-bold " <> colorClass}>{value}</p>
</div>
|]
renderQueueRow :: AgentProposal -> Html
renderQueueRow p = [hsx|
<tr class="hover:bg-gray-50">
<td class="px-4 py-2">
<span class={typeBadge p.proposalType <> " text-xs px-2 py-0.5 rounded font-medium"}>
{p.proposalType}
</span>
</td>
<td class="px-4 py-2 text-gray-400 text-xs">{show p.createdAt}</td>
<td class="px-4 py-2">
<a href={ShowAgentProposalAction (p.id)}
class="text-xs text-indigo-600 hover:underline">Review </a>
</td>
</tr>
|]
renderRecentRow :: [Widget] -> AgentProposal -> Html
renderRecentRow widgets p = [hsx|
<tr class="hover:bg-gray-50">
<td class="px-4 py-2">
<a href={ShowAgentProposalAction (p.id)}
class={typeBadge p.proposalType <> " text-xs px-2 py-0.5 rounded font-medium"}>
{p.proposalType}
</a>
</td>
<td class="px-4 py-2 text-gray-600 text-xs">{widgetName widgets p.sourceWidgetId}</td>
<td class="px-4 py-2">
<span class={statusBadge p.status <> " text-xs px-2 py-0.5 rounded"}>
{p.status}
</span>
</td>
<td class="px-4 py-2 text-gray-500 text-xs">{maybe "" (\c -> show (round (c * 100) :: Int) <> "%") p.confidence}</td>
<td class="px-4 py-2 text-gray-400 text-xs">{show p.createdAt}</td>
</tr>
|]
renderTypeCount :: [AgentProposal] -> Text -> Html
renderTypeCount proposals t =
let cnt = length (filter (\p -> p.proposalType == t) proposals)
in [hsx|
<div class="flex items-center gap-2">
<span class={typeBadge t <> " text-xs px-2 py-0.5 rounded font-medium"}>{t}</span>
<span class="text-sm font-semibold text-gray-700">{show cnt}</span>
</div>
|]
renderPendingQueue :: [AgentProposal] -> Html
renderPendingQueue [] = [hsx|<p class="text-sm text-gray-400 px-5 py-4">No pending proposals.</p>|]
renderPendingQueue pending = [hsx|
<table class="w-full text-sm">
<tbody class="divide-y divide-gray-100">
{forEach (sortByCreatedAt pending) renderQueueRow}
</tbody>
</table>
|]
widgetName :: [Widget] -> Maybe (Id Widget) -> Text
widgetName _ Nothing = ""
widgetName widgets (Just wid) = maybe "" (.name) (find (\w -> w.id == wid) widgets)
sortByCreatedAt :: [AgentProposal] -> [AgentProposal]
sortByCreatedAt = sortBy (\a b -> compare a.createdAt b.createdAt)
showPct :: Double -> Text
showPct d = show (round (d * 100) :: Int) <> "%"
typeBadge :: Text -> Text
typeBadge "summary" = "bg-blue-100 text-blue-800"
typeBadge "requirement_draft" = "bg-indigo-100 text-indigo-800"
typeBadge "duplicate_flag" = "bg-orange-100 text-orange-800"
typeBadge "policy_flag" = "bg-red-100 text-red-800"
typeBadge "impl_proposal" = "bg-green-100 text-green-800"
typeBadge _ = "bg-gray-100 text-gray-600"
statusBadge :: Text -> Text
statusBadge "pending" = "bg-yellow-100 text-yellow-800"
statusBadge "accepted" = "bg-green-100 text-green-800"
statusBadge "rejected" = "bg-red-100 text-red-800"
statusBadge "superseded" = "bg-gray-100 text-gray-500"
statusBadge _ = "bg-gray-100 text-gray-600"