coulomb/inter-hub
2
0
Fork 0
generated from coulomb/repo-seed
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix(WP-0017/E3): Layer 3 error fixes — controllers and views

Browse Source 
Fix compilation errors across 6 controllers and 29 views: import cleanup,
ResponseException pattern for API auth, type fixes, unused import removal.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
Bernd Worsch
2026-04-11 23:40:31 +00:00
parent 58cad31042
commit c40f11d657
35 changed files with 96 additions and 116 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
Web/Controller/Api/V2/Auth.hs
View File

@@ -10,6 +10,7 @@ import qualified Data.Text.Encoding as TE
import qualified "cryptohash-sha256" Crypto.Hash.SHA256 as SHA256 import qualified "cryptohash-sha256" Crypto.Hash.SHA256 as SHA256
import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Base16 as Base16
import Network.Wai (requestHeaders, responseLBS) import Network.Wai (requestHeaders, responseLBS)
import IHP.Controller.Response (ResponseException (..))
-- | Extract Bearer token from Authorization header and validate it -- | Extract Bearer token from Authorization header and validate it
-- against the api_keys table. Returns the ApiConsumer on success, -- against the api_keys table. Returns the ApiConsumer on success,
@@ -52,12 +53,10 @@ unauthorized401 = respondWithStatus 401 $ object
] ]
respondWithStatus :: (?respond :: Respond) => Int -> Value -> IO a respondWithStatus :: (?respond :: Respond) => Int -> Value -> IO a
respondWithStatus status body = do respondWithStatus status body = throwIO $ ResponseException $ responseLBS
respondAndExit $ responseLBS (toEnum status)
(toEnum status) [("Content-Type", "application/json")]
[("Content-Type", "application/json")] (encode body)
(encode body)
error "respondAndExit: unreachable"
-- | SHA-256 hex hash of the key (same as stored in key_hash column) -- | SHA-256 hex hash of the key (same as stored in key_hash column)
hashApiKey :: Text -> Text hashApiKey :: Text -> Text

1
Web/Controller/ApiDashboard.hs
View File

@@ -5,6 +5,7 @@ import Web.View.ApiDashboard.Show
import Generated.Types import Generated.Types
import IHP.Prelude import IHP.Prelude
import IHP.ControllerPrelude import IHP.ControllerPrelude
import Web.Routes ()
import Database.PostgreSQL.Simple (Only(..)) import Database.PostgreSQL.Simple (Only(..))
instance Controller ApiDashboardController where instance Controller ApiDashboardController where

1
Web/Controller/EnvelopeEmissionContracts.hs
View File

@@ -6,6 +6,7 @@ import Web.View.EnvelopeEmissionContracts.Show
import Generated.Types import Generated.Types
import IHP.Prelude import IHP.Prelude
import IHP.ControllerPrelude import IHP.ControllerPrelude
import Web.Routes ()
instance Controller EnvelopeEmissionContractsController where instance Controller EnvelopeEmissionContractsController where
beforeAction = ensureIsUser beforeAction = ensureIsUser

3
Web/Controller/HubRegistry.hs
View File

@@ -30,8 +30,7 @@ instance Controller HubRegistryController where
|> limit 10 |> limit 10
|> fetch |> fetch
adoptedPatterns <- sqlQuery adoptedPatterns <- sqlQuery
"SELECT wp.id, wp.name, wp.widget_type, wp.hub_id, \ "SELECT wp.id, wp.name, wp.widget_type, pa.is_version_pinned, pa.adopted_at \
\ pa.id AS adoption_id, pa.is_version_pinned, pa.adopted_at \
\ FROM pattern_adoptions pa \ \ FROM pattern_adoptions pa \
\ JOIN widget_patterns wp ON wp.id = pa.widget_pattern_id \ \ JOIN widget_patterns wp ON wp.id = pa.widget_pattern_id \
\ WHERE pa.adopting_hub_id = ? \ \ WHERE pa.adopting_hub_id = ? \

7
Web/Controller/InteractionEvents.hs
View File

@@ -5,7 +5,6 @@ import Generated.Types
import IHP.Prelude import IHP.Prelude
import IHP.ControllerPrelude import IHP.ControllerPrelude
import Data.Aeson (object, (.=), decode, Value) import Data.Aeson (object, (.=), decode, Value)
import Data.Coerce (coerce)
import qualified Data.Aeson as A import qualified Data.Aeson as A
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.ByteString.Lazy.Char8 as LBSC import qualified Data.ByteString.Lazy.Char8 as LBSC
@@ -27,8 +26,8 @@ instance Controller InteractionEventsController where
unless (eventType `elem` validEventTypes) do unless (eventType `elem` validEventTypes) do
renderJsonWithStatusCode status422 (object ["error" .= ("unknown event_type" :: Text), "valid" .= validEventTypes]) renderJsonWithStatusCode status422 (object ["error" .= ("unknown event_type" :: Text), "valid" .= validEventTypes])
let mUser = currentUserOrNothing let mUser = currentUserOrNothing @User
let actorId = fmap (.id) mUser let actorId = fmap (\(Id uuid) -> uuid) (fmap (.id) mUser)
actorType = maybe "anonymous" (const "user") mUser actorType = maybe "anonymous" (const "user") mUser
actorTypeParam = paramOrDefault @Text actorType "actor_type" actorTypeParam = paramOrDefault @Text actorType "actor_type"
viewContextRef = paramOrNothing @Text "view_context_ref" viewContextRef = paramOrNothing @Text "view_context_ref"
@@ -41,7 +40,7 @@ instance Controller InteractionEventsController where
event <- newRecord @InteractionEvent event <- newRecord @InteractionEvent
|> set #widgetId widgetId |> set #widgetId widgetId
|> set #eventType eventType |> set #eventType eventType
|> set #actorId (coerce actorId) |> set #actorId actorId
|> set #actorType actorTypeParam |> set #actorType actorTypeParam
|> set #viewContextRef viewContextRef |> set #viewContextRef viewContextRef
|> set #metadata metadata |> set #metadata metadata

1
Web/Controller/Requirements.hs
View File

@@ -6,6 +6,7 @@ import Web.View.Requirements.Show
import Generated.Types import Generated.Types
import IHP.Prelude import IHP.Prelude
import IHP.ControllerPrelude import IHP.ControllerPrelude
import Web.Routes ()
instance Controller RequirementsController where instance Controller RequirementsController where
beforeAction = ensureIsUser beforeAction = ensureIsUser

1
Web/View/AdaptiveThresholds/Index.hs
View File

@@ -37,7 +37,6 @@ instance View IndexView where
{renderCfgStatus mCfg} {renderCfgStatus mCfg}
</div> </div>
<form method="POST" action={CalibrateThresholdsAction (h.id)}> <form method="POST" action={CalibrateThresholdsAction (h.id)}>
{csrfTokenTag}
<button type="submit" <button type="submit"
class="px-3 py-1.5 text-sm bg-indigo-600 text-white rounded hover:bg-indigo-700"> class="px-3 py-1.5 text-sm bg-indigo-600 text-white rounded hover:bg-indigo-700">
Calibrate Calibrate

10
Web/View/AgentRegistrations/Show.hs
View File

@@ -24,10 +24,7 @@ instance View ShowView where
{statusBadge agent.isActive} {statusBadge agent.isActive}
<a href={EditAgentRegistrationAction agent.id} <a href={EditAgentRegistrationAction agent.id}
class="px-3 py-1 text-sm bg-gray-100 hover:bg-gray-200 rounded">Edit</a> class="px-3 py-1 text-sm bg-gray-100 hover:bg-gray-200 rounded">Edit</a>
{when agent.isActive [hsx| {when agent.isActive deactivateButton}
<a href={DeactivateAgentAction agent.id}
class="px-3 py-1 text-sm bg-red-50 text-red-700 hover:bg-red-100 rounded">Deactivate</a>
|]}
<a href={ComputeAgentPerformanceAction agent.id} <a href={ComputeAgentPerformanceAction agent.id}
class="px-3 py-1 text-sm bg-blue-50 text-blue-700 hover:bg-blue-100 rounded">Compute Performance</a> class="px-3 py-1 text-sm bg-blue-50 text-blue-700 hover:bg-blue-100 rounded">Compute Performance</a>
</div> </div>
@@ -62,6 +59,11 @@ instance View ShowView where
</div> </div>
|] |]
where where
deactivateButton = [hsx|
<a href={DeactivateAgentAction agent.id}
class="px-3 py-1 text-sm bg-red-50 text-red-700 hover:bg-red-100 rounded">Deactivate</a>
|]
policiesTable = [hsx| policiesTable = [hsx|
<div class="bg-white shadow rounded-lg overflow-hidden"> <div class="bg-white shadow rounded-lg overflow-hidden">
<table class="min-w-full divide-y divide-gray-200"> <table class="min-w-full divide-y divide-gray-200">

5
Web/View/Annotations/New.hs
View File

@@ -1,9 +1,6 @@
module Web.View.Annotations.New where module Web.View.Annotations.New where
import Web.Types import Web.View.Prelude
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes () import Web.Routes ()
data NewView = NewView data NewView = NewView

3
Web/View/ArchiveRecords/Show.hs
View File

@@ -5,7 +5,6 @@ import Generated.Types
import IHP.Prelude import IHP.Prelude
import IHP.ViewPrelude import IHP.ViewPrelude
import Web.Routes () import Web.Routes ()
import Data.Coerce (coerce)
data ShowView = ShowView data ShowView = ShowView
{ record :: !ArchiveRecord { record :: !ArchiveRecord
@@ -62,7 +61,7 @@ renderLineageLink :: ArchiveRecord -> Html
renderLineageLink record renderLineageLink record
| record.subjectType == "Widget" = [hsx| | record.subjectType == "Widget" = [hsx|
<div class="mt-4"> <div class="mt-4">
<a href={LineageInspectorAction (coerce record.subjectId)} <a href={LineageInspectorAction (Id record.subjectId)}
class="text-sm text-indigo-600 hover:underline">View Lineage →</a> class="text-sm text-indigo-600 hover:underline">View Lineage →</a>
</div> </div>
|] |]

7
Web/View/DecisionRecords/New.hs
View File

@@ -1,9 +1,6 @@
module Web.View.DecisionRecords.New where module Web.View.DecisionRecords.New where
import Web.Types import Web.View.Prelude
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes () import Web.Routes ()
data NewView = NewView data NewView = NewView
@@ -29,7 +26,7 @@ instance View NewView where
renderForm :: HasPath action => DecisionRecord -> [Requirement] -> [RequirementCandidate] -> [User] -> action -> Html renderForm :: HasPath action => DecisionRecord -> [Requirement] -> [RequirementCandidate] -> [User] -> action -> Html
renderForm record requirements candidates users submitAction = [hsx| renderForm record requirements candidates users submitAction = [hsx|
<form method="POST" action={submitAction} class="bg-white rounded-lg border border-gray-200 px-6 py-5 space-y-4"> <form method="POST" action={pathTo submitAction} class="bg-white rounded-lg border border-gray-200 px-6 py-5 space-y-4">
<div> <div>
<label class="block text-sm font-medium text-gray-700 mb-1">Title</label> <label class="block text-sm font-medium text-gray-700 mb-1">Title</label>
<input type="text" name="title" value={record.title} <input type="text" name="title" value={record.title}

8
Web/View/DecisionRecords/Show.hs
View File

@@ -66,7 +66,7 @@ instance View ShowView where
{forEach policyRefs renderPolicyRef} {forEach policyRefs renderPolicyRef}
<form method="POST" action={AddPolicyReferenceAction (record.id)} <form method="POST" action={AddPolicyReferenceAction (record.id)}
class="mt-3 flex items-end gap-2"> class="mt-3 flex items-end gap-2">
{hiddenField "authenticity_token"}
<div> <div>
<label class="text-xs text-gray-500 block mb-1">Scope</label> <label class="text-xs text-gray-500 block mb-1">Scope</label>
<select name="policyScope" <select name="policyScope"
@@ -113,7 +113,7 @@ instance View ShowView where
{forEach implRefs renderImplRef} {forEach implRefs renderImplRef}
<form method="POST" action={AddImplementationRefAction (record.id)} <form method="POST" action={AddImplementationRefAction (record.id)}
class="mt-3 flex items-end gap-2"> class="mt-3 flex items-end gap-2">
{hiddenField "authenticity_token"}
<div> <div>
<label class="text-xs text-gray-500 block mb-1">System</label> <label class="text-xs text-gray-500 block mb-1">System</label>
<select name="system" <select name="system"
@@ -168,7 +168,7 @@ renderPolicyRef ref = [hsx|
</div> </div>
<form method="POST" <form method="POST"
action={DeletePolicyReferenceAction (ref.id)}> action={DeletePolicyReferenceAction (ref.id)}>
{hiddenField "authenticity_token"}
<button type="submit" <button type="submit"
class="text-xs text-red-500 hover:text-red-700 ml-2">Remove</button> class="text-xs text-red-500 hover:text-red-700 ml-2">Remove</button>
</form> </form>
@@ -187,7 +187,7 @@ renderImplRef ref = [hsx|
</div> </div>
<form method="POST" <form method="POST"
action={DeleteImplementationRefAction (ref.id)}> action={DeleteImplementationRefAction (ref.id)}>
{hiddenField "authenticity_token"}
<button type="submit" <button type="submit"
class="text-xs text-red-500 hover:text-red-700 ml-2">Remove</button> class="text-xs text-red-500 hover:text-red-700 ml-2">Remove</button>
</form> </form>

1
Web/View/DeploymentRecords/Show.hs
View File

@@ -183,7 +183,6 @@ renderNoEvaluationForm :: Id DeploymentRecord -> Html
renderNoEvaluationForm deploymentRecordId = [hsx| renderNoEvaluationForm deploymentRecordId = [hsx|
<form method="POST" action={EvaluateChangeAction deploymentRecordId} <form method="POST" action={EvaluateChangeAction deploymentRecordId}
class="space-y-3"> class="space-y-3">
{hiddenField "authenticity_token"}
<div> <div>
<label class="block text-xs font-medium text-gray-600 mb-1"> <label class="block text-xs font-medium text-gray-600 mb-1">
Score (1–5) <span class="text-red-500">*</span> Score (1–5) <span class="text-red-500">*</span>

1
Web/View/GovernanceTemplates/New.hs
View File

@@ -22,7 +22,6 @@ instance View NewView where
<h1 class="text-2xl font-semibold mb-6">New Governance Template</h1> <h1 class="text-2xl font-semibold mb-6">New Governance Template</h1>
<form method="POST" action={CreateGovernanceTemplateAction}> <form method="POST" action={CreateGovernanceTemplateAction}>
{csrfTokenFormField}
<div class="space-y-4 max-w-lg"> <div class="space-y-4 max-w-lg">
<div> <div>
<label class="block text-sm font-medium text-gray-700 mb-1">Name</label> <label class="block text-sm font-medium text-gray-700 mb-1">Name</label>

2
Web/View/HubCapabilityManifests/Edit.hs
View File

@@ -59,7 +59,7 @@ instance View EditView where
<div class="flex gap-3"> <div class="flex gap-3">
<button type="submit" <button type="submit"
class="bg-indigo-600 text-white text-sm px-4 py-2 rounded hover:bg-indigo-700" class="bg-indigo-600 text-white text-sm px-4 py-2 rounded hover:bg-indigo-700"
{if manifest.status /= "draft" then ("disabled" :: Text) else ""}> disabled={manifest.status /= "draft"}>
Save Save
</button> </button>
{if manifest.status == "draft" then renderActivateLink manifest.id else mempty} {if manifest.status == "draft" then renderActivateLink manifest.id else mempty}

5
Web/View/HubCapabilityManifests/New.hs
View File

@@ -1,9 +1,6 @@
module Web.View.HubCapabilityManifests.New where module Web.View.HubCapabilityManifests.New where
import Web.Types import Web.View.Prelude
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes () import Web.Routes ()
data NewView = NewView data NewView = NewView

4
Web/View/HubRegistry/Show.hs
View File

@@ -11,7 +11,7 @@ import qualified Data.ByteString.Lazy.Char8 as BL
-- | Row from the adopted patterns query. -- | Row from the adopted patterns query.
-- (patternId, patternName, widgetType, patternHubId, adoptionId, isVersionPinned, adoptedAt) -- (patternId, patternName, widgetType, patternHubId, adoptionId, isVersionPinned, adoptedAt)
type AdoptedPatternRow = (Id WidgetPattern, Text, Text, Id Hub, Id PatternAdoption, Bool, UTCTime) type AdoptedPatternRow = (Id WidgetPattern, Text, Text, Bool, UTCTime)
data ShowView = ShowView data ShowView = ShowView
{ hub :: !Hub { hub :: !Hub
@@ -170,7 +170,7 @@ renderSnapshotRow s = [hsx|
|] |]
renderAdoptedPattern :: AdoptedPatternRow -> Html renderAdoptedPattern :: AdoptedPatternRow -> Html
renderAdoptedPattern (patternId, patternName, widgetType, _, _, isPinned, adoptedAt) = [hsx| renderAdoptedPattern (patternId, patternName, widgetType, isPinned, adoptedAt) = [hsx|
<div class="bg-white rounded border border-gray-200 p-3 flex items-center justify-between"> <div class="bg-white rounded border border-gray-200 p-3 flex items-center justify-between">
<div> <div>
<a href={ShowWidgetPatternAction (patternId)} <a href={ShowWidgetPatternAction (patternId)}

12
Web/View/HubRoutingRules/New.hs
View File

@@ -1,9 +1,6 @@
module Web.View.HubRoutingRules.New where module Web.View.HubRoutingRules.New where
import Web.Types import Web.View.Prelude
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes () import Web.Routes ()
data NewView = NewView data NewView = NewView
@@ -21,11 +18,14 @@ instance View NewView where
renderForm :: HubRoutingRule -> [Hub] -> Html renderForm :: HubRoutingRule -> [Hub] -> Html
renderForm rule hubs = formFor rule [hsx| renderForm rule hubs = formFor rule [hsx|
{(selectField #sourceHubId hubs){ fieldLabel = "Source Hub" }} {(selectField #sourceHubId (hubOptions hubs)){ fieldLabel = "Source Hub" }}
{(selectField #targetHubId hubs){ fieldLabel = "Target Hub" }} {(selectField #targetHubId (hubOptions hubs)){ fieldLabel = "Target Hub" }}
{(textField #matchCategory){ helpText = "Leave blank to match any category" }} {(textField #matchCategory){ helpText = "Leave blank to match any category" }}
{(textField #matchWidgetType){ helpText = "Leave blank to match any widget type" }} {(textField #matchWidgetType){ helpText = "Leave blank to match any widget type" }}
{(numberField #priority){ helpText = "Higher priority rules are evaluated first" }} {(numberField #priority){ helpText = "Higher priority rules are evaluated first" }}
{textareaField #notes} {textareaField #notes}
{submitButton} {submitButton}
|] |]
hubOptions :: [Hub] -> [(Text, Id Hub)]
hubOptions = map (\h -> (h.name, h.id))

7
Web/View/HubRoutingRules/RoutedCandidates.hs
View File

@@ -1,9 +1,6 @@
module Web.View.HubRoutingRules.RoutedCandidates where module Web.View.HubRoutingRules.RoutedCandidates where
import Web.Types import Web.View.Prelude
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes () import Web.Routes ()
data RoutedCandidatesView = RoutedCandidatesView data RoutedCandidatesView = RoutedCandidatesView
@@ -49,7 +46,7 @@ renderRoutedCandidates candidates = [hsx|
renderCandidateRow :: RequirementCandidate -> Html renderCandidateRow :: RequirementCandidate -> Html
renderCandidateRow c = [hsx| renderCandidateRow c = [hsx|
<tr class="hover:bg-gray-50"> <tr class="hover:bg-gray-50">
<td class="px-4 py-3 text-gray-800">{c.summary}</td> <td class="px-4 py-3 text-gray-800">{c.title}</td>
<td class="px-4 py-3 text-gray-500">{c.category}</td> <td class="px-4 py-3 text-gray-500">{c.category}</td>
<td class="px-4 py-3"> <td class="px-4 py-3">
<span class="text-xs bg-yellow-100 text-yellow-800 px-2 py-0.5 rounded font-medium"> <span class="text-xs bg-yellow-100 text-yellow-800 px-2 py-0.5 rounded font-medium">

9
Web/View/HubRoutingRules/Show.hs
View File

@@ -1,9 +1,6 @@
module Web.View.HubRoutingRules.Show where module Web.View.HubRoutingRules.Show where
import Web.Types import Web.View.Prelude
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes () import Web.Routes ()
import Web.View.HubRoutingRules.Index (statusBadge) import Web.View.HubRoutingRules.Index (statusBadge)
@@ -35,11 +32,11 @@ instance View ShowView where
<dl class="grid grid-cols-2 gap-4 text-sm"> <dl class="grid grid-cols-2 gap-4 text-sm">
<div> <div>
<dt class="text-gray-500">Match Category</dt> <dt class="text-gray-500">Match Category</dt>
<dd class="font-medium">{maybe "any" id rule.matchCategory}</dd> <dd class="font-medium">{fromMaybe "any" rule.matchCategory}</dd>
</div> </div>
<div> <div>
<dt class="text-gray-500">Match Widget Type</dt> <dt class="text-gray-500">Match Widget Type</dt>
<dd class="font-medium">{maybe "any" id rule.matchWidgetType}</dd> <dd class="font-medium">{fromMaybe "any" rule.matchWidgetType}</dd>
</div> </div>
<div> <div>
<dt class="text-gray-500">Priority</dt> <dt class="text-gray-500">Priority</dt>

22
Web/View/Hubs/AdapterCompatibilityDashboard.hs
View File

@@ -54,16 +54,7 @@ instance View AdapterCompatibilityDashboardView where
</div> </div>
</div> </div>
{renderCoverageBar adapterBacked nativeCount} {renderCoverageBar adapterBacked nativeCount}
{forEach coverageBySpec (\(sid, cnt) -> {forEach coverageBySpec (renderCoverageSpecRow specs)}
let mSpec = find (\s -> s.id == sid) specs
label = maybe "(unknown)" (.name) mSpec
in [hsx|
<div class="flex items-center gap-3 mt-2 text-xs text-gray-600">
<span class="bg-purple-100 text-purple-700 px-1.5 py-0.5 rounded">{label}</span>
<span>{show cnt} widgets</span>
</div>
|]
)}
</div> </div>
<!-- Panel 3: Contract versions in use --> <!-- Panel 3: Contract versions in use -->
@@ -116,6 +107,17 @@ instance View AdapterCompatibilityDashboardView where
in sortBy (comparing (Down . snd)) in sortBy (comparing (Down . snd))
[ (sid, length (filter (== sid) assigned)) | sid <- specIds ] [ (sid, length (filter (== sid) assigned)) | sid <- specIds ]
renderCoverageSpecRow :: [WidgetAdapterSpec] -> (Id WidgetAdapterSpec, Int) -> Html
renderCoverageSpecRow ss (sid, cnt) =
let mSpec = find (\s -> s.id == sid) ss
label = maybe "(unknown)" (.name) mSpec
in [hsx|
<div class="flex items-center gap-3 mt-2 text-xs text-gray-600">
<span class="bg-purple-100 text-purple-700 px-1.5 py-0.5 rounded">{label}</span>
<span>{show cnt} widgets</span>
</div>
|]
renderActiveSpecsTable :: [WidgetAdapterSpec] -> Html renderActiveSpecsTable :: [WidgetAdapterSpec] -> Html
renderActiveSpecsTable [] = [hsx|<p class="text-sm text-gray-400">No active adapter specs.</p>|] renderActiveSpecsTable [] = [hsx|<p class="text-sm text-gray-400">No active adapter specs.</p>|]
renderActiveSpecsTable ss = [hsx| renderActiveSpecsTable ss = [hsx|

2
Web/View/Hubs/AntifragilityDashboard.hs
View File

@@ -93,7 +93,7 @@ instance View AntifragilityDashboardView where
{renderRecurrenceSection recurrenceLeaderboard widgets} {renderRecurrenceSection recurrenceLeaderboard widgets}
</div> </div>
|] |]
where where
deployedIds = map (.id) allDeployments deployedIds = map (.id) allDeployments
openGaps = filter (\d -> any (\r -> r.decisionId == d.id) allImplRefs openGaps = filter (\d -> any (\r -> r.decisionId == d.id) allImplRefs
&& not (any (\dp -> dp.decisionId == d.id) allDeployments)) && not (any (\dp -> dp.decisionId == d.id) allDeployments))

2
Web/View/Hubs/GovernanceDashboard.hs
View File

@@ -92,7 +92,7 @@ instance View GovernanceDashboardView where
</table> </table>
</div> </div>
|] |]
where where
awaitingDecision = filter (isAwaitingDecision allDecisions) allRequirements awaitingDecision = filter (isAwaitingDecision allDecisions) allRequirements
regressedWidgets = filter (\w -> w.id `elem` regressionWidgetIds) widgets regressedWidgets = filter (\w -> w.id `elem` regressionWidgetIds) widgets

4
Web/View/InteractionReportingContracts/Show.hs
View File

@@ -57,12 +57,12 @@ instance View ShowView where
<pre class="text-xs text-blue-900 overflow-auto">curl -X POST {contract.endpointPath} \ <pre class="text-xs text-blue-900 overflow-auto">curl -X POST {contract.endpointPath} \
-H "Authorization: Bearer &lt;hub-api-key&gt;" \ -H "Authorization: Bearer &lt;hub-api-key&gt;" \
-H "Content-Type: application/json" \ -H "Content-Type: application/json" \
-d '{"{"} -d '&#123;
"widget_id": "&lt;uuid&gt;", "widget_id": "&lt;uuid&gt;",
"hub_id": "&lt;uuid&gt;", "hub_id": "&lt;uuid&gt;",
"event_type": "clicked", "event_type": "clicked",
"occurred_at": "2026-03-29T12:00:00Z" "occurred_at": "2026-03-29T12:00:00Z"
{"}"}'</pre> &#125;'</pre>
</div> </div>
<div class="mt-4 text-xs text-gray-400"> <div class="mt-4 text-xs text-gray-400">

3
Web/View/LearningDashboard/Show.hs
View File

@@ -2,6 +2,7 @@ module Web.View.LearningDashboard.Show where
import Web.View.Prelude import Web.View.Prelude
import Data.Time (diffUTCTime, getCurrentTime, nominalDay) import Data.Time (diffUTCTime, getCurrentTime, nominalDay)
import qualified Data.Text as T
data ShowView = ShowView data ShowView = ShowView
{ topCorrelations :: ![OutcomeCorrelation] { topCorrelations :: ![OutcomeCorrelation]
@@ -159,7 +160,7 @@ renderKnowledge e = [hsx|
<div> <div>
<a href={ShowInstitutionalKnowledgeAction (e.id)} <a href={ShowInstitutionalKnowledgeAction (e.id)}
class="text-sm text-blue-600 hover:underline"> class="text-sm text-blue-600 hover:underline">
{take 80 e.summary <> if length e.summary > 80 then "…" else ""} {T.take 80 e.summary <> if T.length e.summary > 80 then "…" else ""}
</a> </a>
</div> </div>
|] |]

1
Web/View/LineageEnrichment/Index.hs
View File

@@ -36,7 +36,6 @@ instance View IndexView where
</p> </p>
</div> </div>
<form method="POST" action={EnrichLineageAction (h.id)}> <form method="POST" action={EnrichLineageAction (h.id)}>
{csrfTokenTag}
<button type="submit" <button type="submit"
class="px-3 py-1.5 text-sm bg-green-600 text-white rounded hover:bg-green-700" class="px-3 py-1.5 text-sm bg-green-600 text-white rounded hover:bg-green-700"
disabled={unenriched == 0}> disabled={unenriched == 0}>

1
Web/View/PatternPerformance/Index.hs
View File

@@ -58,7 +58,6 @@ instance View IndexView where
renderRecomputeButton :: Hub -> Html renderRecomputeButton :: Hub -> Html
renderRecomputeButton h = [hsx| renderRecomputeButton h = [hsx|
<form method="POST" action={ComputePatternPerformanceAction (h.id)} class="inline"> <form method="POST" action={ComputePatternPerformanceAction (h.id)} class="inline">
{csrfTokenTag}
<button type="submit" <button type="submit"
class="px-3 py-1.5 text-sm bg-indigo-600 text-white rounded hover:bg-indigo-700"> class="px-3 py-1.5 text-sm bg-indigo-600 text-white rounded hover:bg-indigo-700">
Recompute for {h.name} Recompute for {h.name}

21
Web/View/RequirementCandidates/Edit.hs
View File

@@ -1,9 +1,6 @@
module Web.View.RequirementCandidates.Edit where module Web.View.RequirementCandidates.Edit where
import Web.Types import Web.View.Prelude
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes () import Web.Routes ()
data EditView = EditView data EditView = EditView
@@ -33,16 +30,22 @@ renderForm candidate widgets threads = formFor candidate [hsx|
{(textField #title) { fieldLabel = "Title" }} {(textField #title) { fieldLabel = "Title" }}
{(textareaField #description) { fieldLabel = "Description" }} {(textareaField #description) { fieldLabel = "Description" }}
{selectField #sourceWidgetId (widgetOptions widgets)} {selectField #sourceWidgetId (widgetOptions widgets)}
{selectField #sourceThreadId (threadOptions threads)} <div>
<label class="block text-sm font-medium text-gray-700 mb-1">Source Thread</label>
<select name="sourceThreadId" class="w-full border border-gray-300 rounded px-3 py-2 text-sm">
<option value="">None</option>
{forEach threads renderThreadOption}
</select>
</div>
{selectField #category categoryOptions} {selectField #category categoryOptions}
{submitButton} {submitButton}
|] |]
widgetOptions :: [Widget] -> [(Text, Text)] widgetOptions :: [Widget] -> [(Text, Id Widget)]
widgetOptions = map (\w -> (w.name, show w.id)) widgetOptions = map (\w -> (w.name, w.id))
threadOptions :: [AnnotationThread] -> [(Text, Text)] renderThreadOption :: AnnotationThread -> Html
threadOptions threads = ("None", "") : map (\t -> (t.title, show t.id)) threads renderThreadOption t = [hsx|<option value={show t.id}>{t.title}</option>|]
categoryOptions :: [(Text, Text)] categoryOptions :: [(Text, Text)]
categoryOptions = categoryOptions =

7
Web/View/RequirementCandidates/Index.hs
View File

@@ -1,9 +1,6 @@
module Web.View.RequirementCandidates.Index where module Web.View.RequirementCandidates.Index where
import Web.Types import Web.View.Prelude
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes () import Web.Routes ()
data IndexView = IndexView data IndexView = IndexView
@@ -50,7 +47,7 @@ renderFilterPills current = [hsx|
renderPill :: Maybe Text -> Maybe Text -> Text -> Html renderPill :: Maybe Text -> Maybe Text -> Text -> Html
renderPill target current label = renderPill target current label =
let isActive = target == current let isActive = target == current
baseClass = "text-xs px-3 py-1.5 rounded-full border " baseClass = "text-xs px-3 py-1.5 rounded-full border " :: Text
cls = if isActive cls = if isActive
then baseClass <> "bg-indigo-600 text-white border-indigo-600" then baseClass <> "bg-indigo-600 text-white border-indigo-600"
else baseClass <> "border-gray-300 text-gray-600 hover:bg-gray-50" else baseClass <> "border-gray-300 text-gray-600 hover:bg-gray-50"

21
Web/View/RequirementCandidates/New.hs
View File

@@ -1,9 +1,6 @@
module Web.View.RequirementCandidates.New where module Web.View.RequirementCandidates.New where
import Web.Types import Web.View.Prelude
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes () import Web.Routes ()
data NewView = NewView data NewView = NewView
@@ -30,16 +27,22 @@ renderForm candidate widgets threads = formFor candidate [hsx|
{(textField #title) { fieldLabel = "Title" }} {(textField #title) { fieldLabel = "Title" }}
{(textareaField #description) { fieldLabel = "Description" }} {(textareaField #description) { fieldLabel = "Description" }}
{selectField #sourceWidgetId (widgetOptions widgets)} {selectField #sourceWidgetId (widgetOptions widgets)}
{selectField #sourceThreadId (threadOptions threads)} <div>
<label class="block text-sm font-medium text-gray-700 mb-1">Source Thread</label>
<select name="sourceThreadId" class="w-full border border-gray-300 rounded px-3 py-2 text-sm">
<option value="">None</option>
{forEach threads renderThreadOption}
</select>
</div>
{selectField #category categoryOptions} {selectField #category categoryOptions}
{submitButton} {submitButton}
|] |]
widgetOptions :: [Widget] -> [(Text, Text)] widgetOptions :: [Widget] -> [(Text, Id Widget)]
widgetOptions = map (\w -> (w.name, show w.id)) widgetOptions = map (\w -> (w.name, w.id))
threadOptions :: [AnnotationThread] -> [(Text, Text)] renderThreadOption :: AnnotationThread -> Html
threadOptions threads = ("None", "") : map (\t -> (t.title, show t.id)) threads renderThreadOption t = [hsx|<option value={show t.id}>{t.title}</option>|]
categoryOptions :: [(Text, Text)] categoryOptions :: [(Text, Text)]
categoryOptions = categoryOptions =

9
Web/View/RequirementCandidates/Show.hs
View File

@@ -1,9 +1,6 @@
module Web.View.RequirementCandidates.Show where module Web.View.RequirementCandidates.Show where
import Web.Types import Web.View.Prelude
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes () import Web.Routes ()
data ShowView = ShowView data ShowView = ShowView
@@ -122,7 +119,6 @@ renderTriageButton :: Id RequirementCandidate -> Text -> Html
renderTriageButton candidateId newStatus = [hsx| renderTriageButton candidateId newStatus = [hsx|
<form method="POST" action={UpdateTriageStatusAction (candidateId)} <form method="POST" action={UpdateTriageStatusAction (candidateId)}
class="inline"> class="inline">
{hiddenField "authenticity_token"}
<input type="hidden" name="status" value={newStatus} /> <input type="hidden" name="status" value={newStatus} />
<button type="submit" class={triageButtonClass newStatus}> <button type="submit" class={triageButtonClass newStatus}>
→ {newStatus} → {newStatus}
@@ -144,7 +140,6 @@ renderReviewerSection candidate mAssignment users = [hsx|
</div> </div>
<form method="POST" action={AssignReviewerAction (candidate.id)} <form method="POST" action={AssignReviewerAction (candidate.id)}
class="flex items-center gap-2"> class="flex items-center gap-2">
{hiddenField "authenticity_token"}
<select name="userId" class="text-sm border border-gray-300 rounded px-2 py-1"> <select name="userId" class="text-sm border border-gray-300 rounded px-2 py-1">
{forEach users renderUserOption} {forEach users renderUserOption}
</select> </select>
@@ -216,7 +211,6 @@ renderPromoteButton candidate =
Nothing -> [hsx| Nothing -> [hsx|
<form method="POST" <form method="POST"
action={PromoteToRequirementAction (candidate.id)}> action={PromoteToRequirementAction (candidate.id)}>
{hiddenField "authenticity_token"}
<button type="submit" <button type="submit"
class="text-sm bg-indigo-600 text-white px-3 py-1.5 rounded hover:bg-indigo-700"> class="text-sm bg-indigo-600 text-white px-3 py-1.5 rounded hover:bg-indigo-700">
Promote to Requirement Promote to Requirement
@@ -228,7 +222,6 @@ renderLinkDecisionButton :: RequirementCandidate -> Html
renderLinkDecisionButton candidate = [hsx| renderLinkDecisionButton candidate = [hsx|
<form method="POST" <form method="POST"
action={LinkToDecisionAction (candidate.id)}> action={LinkToDecisionAction (candidate.id)}>
{hiddenField "authenticity_token"}
<button type="submit" <button type="submit"
class="text-sm bg-gray-700 text-white px-3 py-1.5 rounded hover:bg-gray-800"> class="text-sm bg-gray-700 text-white px-3 py-1.5 rounded hover:bg-gray-800">
Create Decision Record Create Decision Record

4
Web/View/StaticPages/ExtensionGuide.hs
View File

@@ -85,10 +85,10 @@ instance View ExtensionGuideView where
</p> </p>
<div class="bg-gray-900 rounded-lg p-4 text-sm font-mono text-green-400"> <div class="bg-gray-900 rounded-lg p-4 text-sm font-mono text-green-400">
POST /api/v2/widgets<br/> POST /api/v2/widgets<br/>
<span class="text-gray-400">{"{"} "name": "PR Review Widget",<br/> <span class="text-gray-400">&#123; "name": "PR Review Widget",<br/>
&nbsp;&nbsp;"widgetType": "dev.code-review",<br/> &nbsp;&nbsp;"widgetType": "dev.code-review",<br/>
&nbsp;&nbsp;"hubId": "...",<br/> &nbsp;&nbsp;"hubId": "...",<br/>
&nbsp;&nbsp;"viewContext": "pull-request-sidebar" {"}"}</span> &nbsp;&nbsp;"viewContext": "pull-request-sidebar" &#125;</span>
</div> </div>
</section> </section>

4
Web/View/StaticPages/Landing.hs
View File

@@ -115,9 +115,9 @@ instance View LandingView where
</div> </div>
|] |]
where where
chainLink label color = [hsx| chainLink (label :: Text) (color :: Text) = [hsx|
<span class={"inline-block px-2 py-1 rounded text-xs bg-" <> color <> "-100 text-" <> color <> "-800 font-mono"}> <span class={"inline-block px-2 py-1 rounded text-xs bg-" <> color <> "-100 text-" <> color <> "-800 font-mono"}>
{label :: Text} {label}
</span> </span>
|] |]
arrow = [hsx|<span class="text-gray-400">→</span>|] arrow = [hsx|<span class="text-gray-400">→</span>|]

2
Web/View/StaticPages/Tutorial.hs
View File

@@ -25,7 +25,7 @@ instance View TutorialView where
</p> </p>
<div class="bg-gray-900 rounded-lg p-4 text-sm font-mono text-green-400"> <div class="bg-gray-900 rounded-lg p-4 text-sm font-mono text-green-400">
<div class="text-gray-400 mb-1">-- Every rendered widget wraps its HSX in widgetEnvelope</div> <div class="text-gray-400 mb-1">-- Every rendered widget wraps its HSX in widgetEnvelope</div>
widgetEnvelope widgetId viewContext [hsx|...|] {"widgetEnvelope widgetId viewContext [hsx|...|]" :: Text}
</div> </div>
<p class="text-sm text-gray-500 mt-2"> <p class="text-sm text-gray-500 mt-2">
The envelope injects <code>data-widget-id</code> and <code>data-view-context</code> attributes, The envelope injects <code>data-widget-id</code> and <code>data-view-context</code> attributes,

10
Web/View/StewardshipRoles/New.hs
View File

@@ -1,9 +1,6 @@
module Web.View.StewardshipRoles.New where module Web.View.StewardshipRoles.New where
import Web.Types import Web.View.Prelude
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes () import Web.Routes ()
data NewView = NewView data NewView = NewView
@@ -21,9 +18,12 @@ instance View NewView where
renderForm :: StewardshipRole -> [Hub] -> Html renderForm :: StewardshipRole -> [Hub] -> Html
renderForm role hubs = formFor role [hsx| renderForm role hubs = formFor role [hsx|
{(selectField #hubId hubs){ fieldLabel = "Hub" }} {(selectField #hubId (hubOptions hubs)){ fieldLabel = "Hub" }}
{(textField #roleName){ helpText = "e.g. Hub Lead, Policy Steward, Triage Owner" }} {(textField #roleName){ helpText = "e.g. Hub Lead, Policy Steward, Triage Owner" }}
{(textField #assignedTo){ helpText = "Person name or identifier" }} {(textField #assignedTo){ helpText = "Person name or identifier" }}
{(textareaField #notes){ fieldLabel = "Notes (optional)" }} {(textareaField #notes){ fieldLabel = "Notes (optional)" }}
{submitButton} {submitButton}
|] |]
hubOptions :: [Hub] -> [(Text, Id Hub)]
hubOptions = map (\h -> (h.name, h.id))