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/E5): Layer 3 error fixes — round 3 (24 files)

Browse Source 
Int16→Int in score/stars functions; uuid-based readMay→UUID.fromText;
autoRefresh do-notation fix; id→\x->x ambiguity in HubRoutingRules;
MarketplaceDashboard replaced raw SQL with IHP query builder; optional
hub selector in TypeRegistry views via CanSelect (Text, Maybe Id) instance
added to Web.View.Prelude; import consolidations to Web.View.Prelude.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
Bernd Worsch
2026-04-12 13:11:32 +00:00
parent 3737845e02
commit 2c22766cd6
24 changed files with 81 additions and 110 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
Web/Controller/AiGovernancePolicies.hs
View File

@@ -6,6 +6,7 @@ import Web.Controller.Prelude
import Web.View.AiGovernancePolicies.Index
import Web.View.AiGovernancePolicies.New
import Application.Helper.AgentBridge (jsonArrayTexts)
import qualified Data.Aeson as A
validAllowedActions :: [Text]
validAllowedActions = ["read", "propose", "delegate", "auto_apply"]

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

@@ -10,6 +10,7 @@ import IHP.ControllerPrelude
import Data.Aeson (object, (.=))
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.UUID as UUID
import qualified "cryptohash-sha256" Crypto.Hash.SHA256 as SHA256
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Random as Random
@@ -50,7 +51,7 @@ instance Controller ApiV2TokenController where
]
(Just cid, Just csec) -> do
-- Look up consumer by id
case readMay cid of
case UUID.fromText cid of
Nothing -> respondWithStatus 400 $ object
["error" .= ("invalid_client" :: Text)]
Just rawId -> do

2
Web/Controller/CollectiveProposals.hs
View File

@@ -8,7 +8,7 @@ import Web.View.CollectiveProposals.Index
import Web.View.CollectiveProposals.Show
import Application.Helper.AgentBridge (callAgent, callAgentsBatch, BridgeResponse(..))
import Application.Helper.ModelRouter (resolveAllAgents)
import Data.List (intercalate)
import qualified Data.Aeson as A
instance Controller CollectiveProposalsController where

8
Web/Controller/HubRoutingRules.hs
View File

@@ -42,8 +42,8 @@ instance Controller HubRoutingRulesController where
|> fill @'["sourceHubId","targetHubId","matchCategory","matchWidgetType","priority","notes"]
|> validateField #sourceHubId nonEmpty
|> validateField #targetHubId nonEmpty
|> (case wtResult of { Left msg -> attachFailure #matchWidgetType msg; Right () -> id })
|> (case catResult of { Left msg -> attachFailure #matchCategory msg; Right () -> id })
|> (case wtResult of { Left msg -> attachFailure #matchWidgetType msg; Right () -> \x -> x })
|> (case catResult of { Left msg -> attachFailure #matchCategory msg; Right () -> \x -> x })
|> ifValid \case
Left r -> render NewView { rule = r, hubs }
Right r -> do
@@ -65,8 +65,8 @@ instance Controller HubRoutingRulesController where
catResult <- case mMatchCategory of { Nothing -> pure (Right ()); Just "" -> pure (Right ()); Just c -> liftIO (validateAnnotationCategory c) }
rule
|> fill @'["matchCategory","matchWidgetType","priority","notes"]
|> (case wtResult of { Left msg -> attachFailure #matchWidgetType msg; Right () -> id })
|> (case catResult of { Left msg -> attachFailure #matchCategory msg; Right () -> id })
|> (case wtResult of { Left msg -> attachFailure #matchWidgetType msg; Right () -> \x -> x })
|> (case catResult of { Left msg -> attachFailure #matchCategory msg; Right () -> \x -> x })
|> ifValid \case
Left r -> render EditView { rule = r, hubs }
Right r -> do

3
Web/Controller/LearningDashboard.hs
View File

@@ -8,8 +8,7 @@ import Web.View.LearningDashboard.Show
instance Controller LearningDashboardController where
beforeAction = ensureIsUser
action LearningDashboardAction = do
autoRefresh
action LearningDashboardAction = autoRefresh do
topCorrelations <- query @OutcomeCorrelation
|> orderByDesc #correlationScore
|> limit 10

69
Web/Controller/MarketplaceDashboard.hs
View File

@@ -5,8 +5,6 @@ import Web.View.MarketplaceDashboard.Show
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
import Database.PostgreSQL.Simple (Query)
instance Controller MarketplaceDashboardController where
beforeAction = ensureIsUser
@@ -15,15 +13,32 @@ instance Controller MarketplaceDashboardController where
let mWType = paramOrNothing @Text "widgetType"
let sortBy = paramOrDefault @Text "adopted" "sort"
-- Widget patterns: full-text search + filter
patterns <- sqlQuery (patternQuery mSearch mWType sortBy) ()
-- Widget patterns: fetch then count adoptions
basePatterns <- query @WidgetPattern
|> filterWhere (#isPublished, True)
|> orderByAsc #name
|> limit 50
|> fetch
patterns <- mapM (\p -> do
cnt <- sqlQueryScalar
"SELECT COUNT(*) FROM pattern_adoptions WHERE widget_pattern_id = ?"
(Only p.id)
pure (p, fromMaybe 0 cnt)) basePatterns
-- Governance templates: full-text search
templates <- sqlQuery (templateQuery mSearch) ()
-- Governance templates: fetch then count clones
baseTemplates <- query @GovernanceTemplate
|> filterWhere (#isPublished, True)
|> limit 50
|> fetch
templates <- mapM (\t -> do
cnt <- sqlQueryScalar
"SELECT COUNT(*) FROM governance_template_clones WHERE governance_template_id = ?"
(Only t.id)
pure (t, fromMaybe 0 cnt)) baseTemplates
-- Trending patterns (most adoptions in last 30 days)
trending <- sqlQuery
"SELECT wp.id, wp.name, wp.widget_type, COUNT(pa.id) AS recent_adoptions \
trendingRaw :: [(Id WidgetPattern, Text, Text, Int)] <- sqlQuery
"SELECT wp.id, wp.name, wp.widget_type, CAST(COUNT(pa.id) AS integer) AS recent_adoptions \
\ FROM widget_patterns wp \
\ JOIN pattern_adoptions pa ON pa.widget_pattern_id = wp.id \
\ WHERE wp.is_published = TRUE \
@@ -32,6 +47,7 @@ instance Controller MarketplaceDashboardController where
\ ORDER BY recent_adoptions DESC \
\ LIMIT 5"
()
let trending = trendingRaw
widgetTypeOptions <- sqlQuery
"SELECT name, label FROM widget_type_registry WHERE status = 'active' ORDER BY label"
@@ -45,40 +61,3 @@ instance Controller MarketplaceDashboardController where
, sortOrder = sortBy
}
-- | Widget pattern list query with optional search and type filter.
patternQuery :: Maybe Text -> Maybe Text -> Text -> Query
patternQuery mSearch mWType sortBy =
let baseWhere = "wp.is_published = TRUE"
searchClause = case mSearch of
Nothing -> ""
Just _ -> " AND to_tsvector('english', wp.name || ' ' || COALESCE(wp.description,'')) \
\ @@ plainto_tsquery(?)"
typeClause = case mWType of
Nothing -> ""
Just _ -> " AND wp.widget_type = ?"
orderClause = case sortBy of
"recent" -> "wp.created_at DESC"
"alpha" -> "wp.name ASC"
_ -> "adopter_count DESC"
in "SELECT wp.*, COUNT(pa.id) AS adopter_count \
\ FROM widget_patterns wp \
\ LEFT JOIN pattern_adoptions pa ON pa.widget_pattern_id = wp.id \
\ WHERE " <> baseWhere <> searchClause <> typeClause <>
" GROUP BY wp.id \
\ ORDER BY " <> orderClause <>
" LIMIT 50"
-- | Governance template list query with optional search.
templateQuery :: Maybe Text -> Query
templateQuery mSearch =
let searchClause = case mSearch of
Nothing -> ""
Just _ -> " AND to_tsvector('english', gt.name || ' ' || COALESCE(gt.description,'')) \
\ @@ plainto_tsquery(?)"
in "SELECT gt.*, COUNT(gtc.id) AS clone_count \
\ FROM governance_templates gt \
\ LEFT JOIN governance_template_clones gtc ON gtc.governance_template_id = gt.id \
\ WHERE gt.is_published = TRUE" <> searchClause <>
" GROUP BY gt.id \
\ ORDER BY clone_count DESC \
\ LIMIT 50"