generated from coulomb/repo-seed
Bernd Worsch
3737845e02
Fixes 46 compile errors across 18 controllers and views: - BridgeResponse missing from explicit import lists (Widgets, RequirementCandidates, DecisionRecords, AgentDelegations) — dot-notation HasField resolution fails without the type in scope under DuplicateRecordFields - unId not in IHP v1.5 — replaced all fmap (Id . unId) with fmap coerce - respondWith not in IHP — replaced with plain redirectTo in 5 controllers - [hubId] list param to sqlQuery — replaced with (Only hubId) tuple - deleteWhere not in IHP — replaced with query/filterWhere/fetch/deleteRecords - fill @'["label"] mismatch — field is label_ in generated types, not label - PersistUUID/toUUID (persistent-style) — replaced with (Only id) - intercalate + jsonArrayTexts ambiguity in GovernanceTemplates — hid Index import, removed local duplicates, added Data.Text (intercalate) - Int16 not in scope in AntifragilityDashboard — changed to Int (score :: Int) - typeArraySection type mismatch in HubCapabilityManifests/Edit — unified to [Text] - renderForm arity mismatch — added action param to DecisionRecords/New.renderForm - Missing qualified Data.Aeson import in AdaptiveThresholds - Missing ?request::Request constraint in Api/V2/WidgetPatterns.renderJsonWithStatus Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
118 lines
5.0 KiB
Haskell
118 lines
5.0 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, paginatedResponse, getPageParams)
|
|
import Application.Helper.ApiRateLimit (checkRateLimitAndLog)
|
|
|
|
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 <- query @WidgetPattern
|
|
|> filterWhere (#isPublished, True)
|
|
|> orderByAsc #name
|
|
|> limit perPage
|
|
|> offset off
|
|
|> fetch
|
|
renderJson $ paginatedResponse (map patternToJson 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, ?request :: Request) => Int -> Value -> IO ()
|
|
renderJsonWithStatus _code val =
|
|
renderJson val -- IHP renderJson always uses 200; status override requires 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
|
|
]
|