From c40f11d657a7dca217bfe611aebf6684cd04215f Mon Sep 17 00:00:00 2001 From: Bernd Worsch Date: Sat, 11 Apr 2026 23:40:31 +0000 Subject: [PATCH] =?UTF-8?q?fix(WP-0017/E3):=20Layer=203=20error=20fixes=20?= =?UTF-8?q?=E2=80=94=20controllers=20and=20views?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 --- Web/Controller/Api/V2/Auth.hs | 11 +++++----- Web/Controller/ApiDashboard.hs | 1 + Web/Controller/EnvelopeEmissionContracts.hs | 1 + Web/Controller/HubRegistry.hs | 3 +-- Web/Controller/InteractionEvents.hs | 7 +++--- Web/Controller/Requirements.hs | 1 + Web/View/AdaptiveThresholds/Index.hs | 1 - Web/View/AgentRegistrations/Show.hs | 10 +++++---- Web/View/Annotations/New.hs | 5 +---- Web/View/ArchiveRecords/Show.hs | 3 +-- Web/View/DecisionRecords/New.hs | 7 ++---- Web/View/DecisionRecords/Show.hs | 8 +++---- Web/View/DeploymentRecords/Show.hs | 1 - Web/View/GovernanceTemplates/New.hs | 1 - Web/View/HubCapabilityManifests/Edit.hs | 2 +- Web/View/HubCapabilityManifests/New.hs | 5 +---- Web/View/HubRegistry/Show.hs | 4 ++-- Web/View/HubRoutingRules/New.hs | 12 +++++----- Web/View/HubRoutingRules/RoutedCandidates.hs | 7 ++---- Web/View/HubRoutingRules/Show.hs | 9 +++----- .../Hubs/AdapterCompatibilityDashboard.hs | 22 ++++++++++--------- Web/View/Hubs/AntifragilityDashboard.hs | 2 +- Web/View/Hubs/GovernanceDashboard.hs | 2 +- .../InteractionReportingContracts/Show.hs | 4 ++-- Web/View/LearningDashboard/Show.hs | 3 ++- Web/View/LineageEnrichment/Index.hs | 1 - Web/View/PatternPerformance/Index.hs | 1 - Web/View/RequirementCandidates/Edit.hs | 21 ++++++++++-------- Web/View/RequirementCandidates/Index.hs | 7 ++---- Web/View/RequirementCandidates/New.hs | 21 ++++++++++-------- Web/View/RequirementCandidates/Show.hs | 9 +------- Web/View/StaticPages/ExtensionGuide.hs | 4 ++-- Web/View/StaticPages/Landing.hs | 4 ++-- Web/View/StaticPages/Tutorial.hs | 2 +- Web/View/StewardshipRoles/New.hs | 10 ++++----- 35 files changed, 96 insertions(+), 116 deletions(-) diff --git a/Web/Controller/Api/V2/Auth.hs b/Web/Controller/Api/V2/Auth.hs index 9a18374..a650f3e 100644 --- a/Web/Controller/Api/V2/Auth.hs +++ b/Web/Controller/Api/V2/Auth.hs @@ -10,6 +10,7 @@ import qualified Data.Text.Encoding as TE import qualified "cryptohash-sha256" Crypto.Hash.SHA256 as SHA256 import qualified Data.ByteString.Base16 as Base16 import Network.Wai (requestHeaders, responseLBS) +import IHP.Controller.Response (ResponseException (..)) -- | Extract Bearer token from Authorization header and validate it -- 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 status body = do - respondAndExit $ responseLBS - (toEnum status) - [("Content-Type", "application/json")] - (encode body) - error "respondAndExit: unreachable" +respondWithStatus status body = throwIO $ ResponseException $ responseLBS + (toEnum status) + [("Content-Type", "application/json")] + (encode body) -- | SHA-256 hex hash of the key (same as stored in key_hash column) hashApiKey :: Text -> Text diff --git a/Web/Controller/ApiDashboard.hs b/Web/Controller/ApiDashboard.hs index 701f54b..5d0a90a 100644 --- a/Web/Controller/ApiDashboard.hs +++ b/Web/Controller/ApiDashboard.hs @@ -5,6 +5,7 @@ import Web.View.ApiDashboard.Show import Generated.Types import IHP.Prelude import IHP.ControllerPrelude +import Web.Routes () import Database.PostgreSQL.Simple (Only(..)) instance Controller ApiDashboardController where diff --git a/Web/Controller/EnvelopeEmissionContracts.hs b/Web/Controller/EnvelopeEmissionContracts.hs index afa2fe5..6f9cdd6 100644 --- a/Web/Controller/EnvelopeEmissionContracts.hs +++ b/Web/Controller/EnvelopeEmissionContracts.hs @@ -6,6 +6,7 @@ import Web.View.EnvelopeEmissionContracts.Show import Generated.Types import IHP.Prelude import IHP.ControllerPrelude +import Web.Routes () instance Controller EnvelopeEmissionContractsController where beforeAction = ensureIsUser diff --git a/Web/Controller/HubRegistry.hs b/Web/Controller/HubRegistry.hs index b0943e3..be174c0 100644 --- a/Web/Controller/HubRegistry.hs +++ b/Web/Controller/HubRegistry.hs @@ -30,8 +30,7 @@ instance Controller HubRegistryController where |> limit 10 |> fetch adoptedPatterns <- sqlQuery - "SELECT wp.id, wp.name, wp.widget_type, wp.hub_id, \ - \ pa.id AS adoption_id, pa.is_version_pinned, pa.adopted_at \ + "SELECT wp.id, wp.name, wp.widget_type, pa.is_version_pinned, pa.adopted_at \ \ FROM pattern_adoptions pa \ \ JOIN widget_patterns wp ON wp.id = pa.widget_pattern_id \ \ WHERE pa.adopting_hub_id = ? \ diff --git a/Web/Controller/InteractionEvents.hs b/Web/Controller/InteractionEvents.hs index 338c2e1..7d1f21b 100644 --- a/Web/Controller/InteractionEvents.hs +++ b/Web/Controller/InteractionEvents.hs @@ -5,7 +5,6 @@ import Generated.Types import IHP.Prelude import IHP.ControllerPrelude import Data.Aeson (object, (.=), decode, Value) -import Data.Coerce (coerce) import qualified Data.Aeson as A import qualified Data.Text as T import qualified Data.ByteString.Lazy.Char8 as LBSC @@ -27,8 +26,8 @@ instance Controller InteractionEventsController where unless (eventType `elem` validEventTypes) do renderJsonWithStatusCode status422 (object ["error" .= ("unknown event_type" :: Text), "valid" .= validEventTypes]) - let mUser = currentUserOrNothing - let actorId = fmap (.id) mUser + let mUser = currentUserOrNothing @User + let actorId = fmap (\(Id uuid) -> uuid) (fmap (.id) mUser) actorType = maybe "anonymous" (const "user") mUser actorTypeParam = paramOrDefault @Text actorType "actor_type" viewContextRef = paramOrNothing @Text "view_context_ref" @@ -41,7 +40,7 @@ instance Controller InteractionEventsController where event <- newRecord @InteractionEvent |> set #widgetId widgetId |> set #eventType eventType - |> set #actorId (coerce actorId) + |> set #actorId actorId |> set #actorType actorTypeParam |> set #viewContextRef viewContextRef |> set #metadata metadata diff --git a/Web/Controller/Requirements.hs b/Web/Controller/Requirements.hs index 0935179..6af9a35 100644 --- a/Web/Controller/Requirements.hs +++ b/Web/Controller/Requirements.hs @@ -6,6 +6,7 @@ import Web.View.Requirements.Show import Generated.Types import IHP.Prelude import IHP.ControllerPrelude +import Web.Routes () instance Controller RequirementsController where beforeAction = ensureIsUser diff --git a/Web/View/AdaptiveThresholds/Index.hs b/Web/View/AdaptiveThresholds/Index.hs index 5ca7a27..fa036dd 100644 --- a/Web/View/AdaptiveThresholds/Index.hs +++ b/Web/View/AdaptiveThresholds/Index.hs @@ -37,7 +37,6 @@ instance View IndexView where {renderCfgStatus mCfg}
- {csrfTokenTag}