generated from coulomb/repo-seed
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>
124 lines
5.4 KiB
Haskell
124 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, 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 <- 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
|
|
]
|