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

fix(WP-0014/A2): close remaining pure-param and structural compilation errors

Browse Source 
Convert all remaining `<- paramOrNothing / param / paramOrDefault /
currentUserOrNothing` monadic binds to `let` — these functions are pure
(ImplicitParams-based) in IHP v1.5, so `<-` is a type error in an IO
do-block.

Controllers fixed:
  AgentDelegations, AiGovernancePolicies, Annotations, ApiConsumers,
  CollectiveProposals, DecisionRecords, DeploymentRecords,
  HubCapabilityManifests, HubRoutingRules, InstitutionalKnowledge,
  OutcomeCorrelations, RequirementCandidates, TypeRegistries,
  WebhookSubscriptions, Widgets,
  Api/V2/{Annotations,InteractionEvents,Token}

WebhookSubscriptions: remove orphaned `Right () ->` case arm that was
left inside a bare `unless` block (structural parse error).

Also carries forward all in-progress fixes from the working tree:
  helpers (AgentBridge, ApiRateLimit, BottleneckDetector,
            CrossHubPropagation, FrictionScore),
  views (CanSelect instances, HSX lambda extraction, formFor wrappers),
  env/build (envrc GHCi perms, flake.nix Tailwind + GHC resource limits,
             static/app.css additional Tailwind output).

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
Bernd Worsch
2026-04-10 01:14:08 +00:00
parent 5510ae22da
commit ce42607fca
85 changed files with 584 additions and 397 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
Web/Controller/Api/V2/Annotations.hs
View File

@@ -9,14 +9,15 @@ import Web.Controller.Api.V2.Auth
( requireApiConsumer, paginatedResponse, getPageParams
, respondWithStatus )
import Application.Helper.TypeRegistry (validateAnnotationCategory)
import qualified Data.UUID as UUID
instance Controller ApiV2AnnotationsController where
action ApiV2IndexAnnotationsAction = do
_consumer <- requireApiConsumer
(page, perPage) <- getPageParams
mWidgetId <- paramOrNothing @(Id Widget) "widgetId"
mCategory <- paramOrNothing @Text "category"
let mWidgetId = paramOrNothing @(Id Widget) "widgetId"
mCategory = paramOrNothing @Text "category"
let off = (page - 1) * perPage
let baseQ = query @Annotation |> orderByDesc #createdAt
let q1 = case mWidgetId of
@@ -37,9 +38,9 @@ instance Controller ApiV2AnnotationsController where
-- POST /api/v2/annotations
action ApiV2CreateAnnotationAction = do
_consumer <- requireApiConsumer
widgetIdText <- paramOrNothing @Text "widgetId"
category <- paramOrNothing @Text "category"
body <- paramOrNothing @Text "body"
let widgetIdText = paramOrNothing @Text "widgetId"
category = paramOrNothing @Text "category"
body = paramOrNothing @Text "body"
let missing = catMaybes
[ if isNothing widgetIdText then Just ("widgetId" :: Text) else Nothing
@@ -66,7 +67,7 @@ instance Controller ApiV2AnnotationsController where
]
Right () -> pure ()
case readMay wIdText of
case UUID.fromText wIdText of
Nothing -> respondWithStatus 422 $ object
["error" .= ("widgetId must be a valid UUID" :: Text)]
Just rawId -> do
@@ -82,7 +83,6 @@ instance Controller ApiV2AnnotationsController where
|> set #body bodyTxt
|> set #actorType "api"
|> createRecord
setStatus 201
renderJson (annotationToJson ann)
annotationToJson :: Annotation -> Value

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

@@ -57,6 +57,7 @@ respondWithStatus status body = do
(toEnum status)
[("Content-Type", "application/json")]
(encode body)
error "respondAndExit: unreachable"
-- | SHA-256 hex hash of the key (same as stored in key_hash column)
hashApiKey :: Text -> Text
@@ -78,10 +79,10 @@ paginatedResponse items page perPage total =
]
-- | Parse page / per_page query params with sensible defaults
getPageParams :: (?context :: ControllerContext) => IO (Int, Int)
getPageParams :: (?context :: ControllerContext, ?request :: Request) => IO (Int, Int)
getPageParams = do
page <- fromMaybe 1 <$> paramOrNothing @Int "page"
perPage <- fromMaybe 50 <$> paramOrNothing @Int "per_page"
let page = fromMaybe 1 (paramOrNothing @Int "page")
perPage = fromMaybe 50 (paramOrNothing @Int "per_page")
let perPage' = min 200 (max 1 perPage)
let page' = max 1 page
pure (page', perPage')

3
Web/Controller/Api/V2/HubRegistry.hs
View File

@@ -8,7 +8,8 @@ import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
import Data.Aeson (object, (.=), Value)
import Web.Controller.Api.V2.Auth (requireApiConsumer, checkRateLimitAndLog)
import Web.Controller.Api.V2.Auth (requireApiConsumer)
import Application.Helper.ApiRateLimit (checkRateLimitAndLog)
instance Controller ApiV2HubRegistryController where

15
Web/Controller/Api/V2/InteractionEvents.hs
View File

@@ -12,6 +12,8 @@ import Web.Controller.Api.V2.Auth
import Application.Helper.TypeRegistry (validateEventType)
import Web.Job.WebhookDeliveryJob (dispatchWebhooks)
import Control.Concurrent (forkIO)
import Control.Monad (void)
import qualified Data.UUID as UUID
import qualified Data.Aeson as A
instance Controller ApiV2InteractionEventsController where
@@ -19,8 +21,8 @@ instance Controller ApiV2InteractionEventsController where
action ApiV2IndexInteractionEventsAction = do
_consumer <- requireApiConsumer
(page, perPage) <- getPageParams
mWidgetId <- paramOrNothing @(Id Widget) "widgetId"
mEventType <- paramOrNothing @Text "eventType"
let mWidgetId = paramOrNothing @(Id Widget) "widgetId"
mEventType = paramOrNothing @Text "eventType"
let off = (page - 1) * perPage
let baseQ = query @InteractionEvent
|> orderByDesc #occurredAt
@@ -42,9 +44,9 @@ instance Controller ApiV2InteractionEventsController where
-- POST /api/v2/interaction-events
action ApiV2CreateInteractionEventAction = do
consumer <- requireApiConsumer
widgetIdText <- paramOrNothing @Text "widgetId"
eventType <- paramOrNothing @Text "eventType"
viewContext <- paramOrNothing @Text "viewContext"
let widgetIdText = paramOrNothing @Text "widgetId"
eventType = paramOrNothing @Text "eventType"
viewContext = paramOrNothing @Text "viewContext"
let missing = catMaybes
[ if isNothing widgetIdText then Just ("widgetId" :: Text) else Nothing
@@ -83,7 +85,7 @@ instance Controller ApiV2InteractionEventsController where
, "value" .= evType
]
case readMay wIdText of
case UUID.fromText wIdText of
Nothing -> respondWithStatus 422 $ object
["error" .= ("widgetId must be a valid UUID" :: Text)]
Just rawId -> do
@@ -108,7 +110,6 @@ instance Controller ApiV2InteractionEventsController where
, "occurredAt" .= event.occurredAt
]
liftIO $ void $ forkIO $ dispatchWebhooks "clicked" webhookPayload
setStatus 201
renderJson (eventToJson event)
eventToJson :: InteractionEvent -> Value

6
Web/Controller/Api/V2/Learning.hs
View File

@@ -14,8 +14,8 @@ instance Controller ApiV2LearningController where
action ApiV2IndexOutcomeCorrelationsAction = do
_consumer <- requireApiConsumer
mHubId <- paramOrNothing @(Id Hub) "hub_id"
mCat <- paramOrNothing @Text "category"
let mHubId = paramOrNothing @(Id Hub) "hub_id"
mCat = paramOrNothing @Text "category"
(page, perPage) <- getPageParams
let off = (page - 1) * perPage
baseQuery <- pure $ query @OutcomeCorrelation
@@ -43,7 +43,7 @@ instance Controller ApiV2LearningController where
action ApiV2IndexKnowledgeBaseAction = do
_consumer <- requireApiConsumer
mQ <- paramOrNothing @Text "q"
let mQ = paramOrNothing @Text "q"
(page, perPage) <- getPageParams
let off = (page - 1) * perPage
rows <- case mQ of

10
Web/Controller/Api/V2/Token.hs
View File

@@ -10,7 +10,7 @@ import IHP.ControllerPrelude
import Data.Aeson (object, (.=))
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified 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.Random as Random
import Data.Time (addUTCTime)
@@ -23,10 +23,10 @@ instance Controller ApiV2TokenController where
when (requestMethod ?request /= "POST") do
respondWithStatus 405 $ object ["error" .= ("Method not allowed" :: Text)]
grantType <- paramOrNothing @Text "grant_type"
clientId <- paramOrNothing @Text "client_id"
clientSecret <- paramOrNothing @Text "client_secret"
mScope <- paramOrNothing @Text "scope"
let grantType = paramOrNothing @Text "grant_type"
clientId = paramOrNothing @Text "client_id"
clientSecret = paramOrNothing @Text "client_secret"
mScope = paramOrNothing @Text "scope"
-- grant_type must be client_credentials
case grantType of

3
Web/Controller/Api/V2/WidgetPatterns.hs
View File

@@ -9,7 +9,8 @@ import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
import Data.Aeson (object, (.=), Value)
import Web.Controller.Api.V2.Auth (requireApiConsumer, checkRateLimitAndLog, paginatedResponse, getPageParams)
import Web.Controller.Api.V2.Auth (requireApiConsumer, paginatedResponse, getPageParams)
import Application.Helper.ApiRateLimit (checkRateLimitAndLog)
instance Controller ApiV2WidgetPatternsController where

4
Web/Controller/Api/V2/Widgets.hs
View File

@@ -12,12 +12,12 @@ instance Controller ApiV2WidgetsController where
action ApiV2IndexWidgetsAction = do
_consumer <- requireApiConsumer
(page, perPage) <- getPageParams
let offset = (page - 1) * perPage
let pageOffset = (page - 1) * perPage
total <- query @Widget |> fetchCount
widgets <- query @Widget
|> orderByDesc #createdAt
|> limit perPage
|> offset offset
|> offset pageOffset
|> fetch
renderJson $ paginatedResponse (map widgetToJson widgets) page perPage total