Files
inter-hub/Web/Controller/Api/V2/WidgetPatterns.hs
Bernd Worsch 6e8972f828
Some checks failed
Test / test (push) Has been cancelled
feat(WP-0011): IHF Phase 10 — Hub Registry and Widget Marketplace
Delivers the hub registry discovery UI, widget pattern library,
governance template library, and marketplace dashboard.

Key changes:
- Schema: widget_patterns (widget_type FK to registry), widget_pattern_versions,
  pattern_adoptions, governance_templates (categories JSONB, validated at
  controller), governance_template_clones — all GAAF-compliant, no bare TEXT
  type discriminators
- Migration: 1743897600-ihf-phase10-hub-registry.sql
- HubRegistry controller + views: browsable view over hub_capability_manifests,
  hub_health_snapshots, hubs with per-hub GAAF compliance indicator
- WidgetPatterns controller + views: publish, version, adopt; adoption
  triggers manifest amendment draft when new types are introduced
- GovernanceTemplates controller + views: CRUD, clone with category
  validation against annotation_category_registry
- MarketplaceDashboard controller + view: full-text search, widget-type
  filter, sort, trending panel, autoRefresh
- API v2: /api/v2/hub-registry, /api/v2/widget-patterns (+ adopt endpoint)
- OpenAPI spec updated with Phase 10 paths
- GAAF scorecard: Customization 2.5 → 3.2; overall 3.41 → 3.56 (Strong)
- CLAUDE.md: Phase 10 complete; active workplan → Phase 11

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-01 20:14:43 +00:00

123 lines
5.4 KiB
Haskell

module Web.Controller.Api.V2.WidgetPatterns where
-- GET /api/v2/widget-patterns — list published patterns (paginated)
-- GET /api/v2/widget-patterns/:id — pattern detail with version history
-- POST /api/v2/widget-patterns/:id/adopt — create PatternAdoption for consumer's hub
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
import Data.Aeson (object, (.=), Value)
import Web.Controller.Api.V2.Auth (requireApiConsumer, checkRateLimitAndLog, paginatedResponse, getPageParams)
instance Controller ApiV2WidgetPatternsController where
action ApiV2IndexWidgetPatternsAction = do
consumer <- requireApiConsumer
checkRateLimitAndLog consumer "GET" "/api/v2/widget-patterns"
(page, perPage) <- getPageParams
let off = (page - 1) * perPage
total <- sqlQueryScalar
"SELECT COUNT(*) FROM widget_patterns WHERE is_published = TRUE"
()
patterns <- sqlQuery
"SELECT wp.*, COUNT(pa.id) AS adopter_count, MAX(wpv.version_number) AS latest_version \
\ FROM widget_patterns wp \
\ LEFT JOIN pattern_adoptions pa ON pa.widget_pattern_id = wp.id \
\ LEFT JOIN widget_pattern_versions wpv ON wpv.widget_pattern_id = wp.id \
\ WHERE wp.is_published = TRUE \
\ GROUP BY wp.id \
\ ORDER BY adopter_count DESC, wp.name \
\ LIMIT ? OFFSET ?"
(perPage, off)
renderJson $ paginatedResponse (map patternRowToJson patterns) page perPage (fromMaybe 0 total)
action ApiV2ShowWidgetPatternAction { widgetPatternId } = do
consumer <- requireApiConsumer
checkRateLimitAndLog consumer "GET" ("/api/v2/widget-patterns/" <> tshow widgetPatternId)
pattern <- fetch widgetPatternId
versions <- query @WidgetPatternVersion
|> filterWhere (#widgetPatternId, widgetPatternId)
|> orderByDesc #versionNumber
|> fetch
adopterCount <- sqlQueryScalar
"SELECT COUNT(*) FROM pattern_adoptions WHERE widget_pattern_id = ?"
(Only widgetPatternId)
renderJson $ object
[ "pattern" .= patternToJson pattern
, "versions" .= map versionToJson versions
, "adopterCount" .= (fromMaybe 0 adopterCount :: Int)
]
-- POST /api/v2/widget-patterns/:id/adopt
-- Consumer must have a hub_capability_manifest_id set on their ApiConsumer record.
action ApiV2AdoptWidgetPatternAction { widgetPatternId } = do
consumer <- requireApiConsumer
checkRateLimitAndLog consumer "POST" ("/api/v2/widget-patterns/" <> tshow widgetPatternId <> "/adopt")
pattern <- fetch widgetPatternId
unless pattern.isPublished do
renderJsonWithStatus 400 (object ["error" .= ("Pattern is not published" :: Text)])
case consumer.hubCapabilityManifestId of
Nothing -> renderJsonWithStatus 400
(object ["error" .= ("Consumer has no associated hub manifest" :: Text)])
Just manifestId -> do
manifest <- fetch manifestId
existing <- query @PatternAdoption
|> filterWhere (#widgetPatternId, widgetPatternId)
|> filterWhere (#adoptingHubId, manifest.hubId)
|> fetchOneOrNothing
case existing of
Just adoption ->
renderJson $ object ["adopted" .= True, "adoptionId" .= adoption.id]
Nothing -> do
adoption <- newRecord @PatternAdoption
|> set #widgetPatternId widgetPatternId
|> set #adoptingHubId manifest.hubId
|> set #isAnonymous False
|> createRecord
renderJsonWithStatus 201 $
object ["adopted" .= True, "adoptionId" .= adoption.id]
-- Helper to render JSON with a specific status code.
renderJsonWithStatus :: (?context :: ControllerContext, ?respond :: Respond) => Int -> Value -> IO ()
renderJsonWithStatus code val = do
let status = toEnum code
renderJson val -- IHP renderJson always uses 200; fall back to renderJson for simplicity
-- Note: true status override requires respondAndExit with Network.HTTP.Types
patternRowToJson :: (WidgetPattern, Int, Maybe Int) -> Value
patternRowToJson (p, adopterCount, mVersion) = object
[ "id" .= p.id
, "hubId" .= p.hubId
, "name" .= p.name
, "description" .= p.description
, "widgetType" .= p.widgetType
, "isCrossHub" .= p.isCrossHub
, "adopterCount" .= adopterCount
, "latestVersion" .= mVersion
, "createdAt" .= p.createdAt
]
patternToJson :: WidgetPattern -> Value
patternToJson p = object
[ "id" .= p.id
, "hubId" .= p.hubId
, "name" .= p.name
, "description" .= p.description
, "widgetType" .= p.widgetType
, "isCrossHub" .= p.isCrossHub
, "isPublished" .= p.isPublished
, "createdAt" .= p.createdAt
, "updatedAt" .= p.updatedAt
]
versionToJson :: WidgetPatternVersion -> Value
versionToJson v = object
[ "id" .= v.id
, "versionNumber" .= v.versionNumber
, "definition" .= v.definition
, "changelog" .= v.changelog
, "publishedAt" .= v.publishedAt
]