generated from coulomb/repo-seed
Bernd Worsch
f1978c3888
A2 — Compilation fixes: - Remove inline FK constraints from Schema.sql; IHP schema compiler cannot parse them. Add 1744329600-restore-fk-constraints.sql migration to restore referential integrity at the DB level. - Rename `#label` → `#label_` throughout to avoid clash with Haskell built-in. - Fix `hub.id == hid` UUID comparisons to use `toUUID hub.id`. - Replace non-existent `setStatus`/`respondJson` calls with `renderJsonWithStatusCode` throughout Api controllers. - Fix qualified package import for `cryptohash-sha256` in Auth.hs. - Add `CanSelect (Text, Text)` instance in Helper.View. - Refactor HSX inline lambdas to named helper functions in 100+ views (GHC cannot infer types for anonymous functions inside quasi-quoted HSX). - Fix missing imports (IHP.QueryBuilder, IHP.Fetch, Web.Routes, Only, etc.) across helpers and controllers. - Remove duplicate `diffUTCTime` definition in BottleneckDetector. - Change `createEventForHub` return type from `IO ResponseReceived` to `IO ()`. - Seed type-registry vocabulary via 1744502400-seed-type-registries.sql (moved from Schema.sql where IHP does not execute INSERT statements). A3 — Tailwind build pipeline: - Add `tailwindcss` to flake.nix native packages. - Uncomment `tailwind.exec` process in devenv shell config. - Add tailwind/tailwind.config.js (scans Web/View/**/*.hs). - Add tailwind/app.css with @tailwind directives. A4 — Admin user seed: - Add 1744416000-seed-admin-user.sql: inserts admin@inter-hub.local with bcrypt-hashed password admin1234! (cost 10). - Add .env.example documenting all required environment variables and default admin credentials. Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
447 lines
17 KiB
Haskell
447 lines
17 KiB
Haskell
module Web.Controller.Api.V2.OpenApi where
|
|
|
|
-- GET /api/v2/openapi.json — OpenAPI 3.1 spec with live type registry enums
|
|
-- GET /api/v2/openapi.yaml — YAML convenience alias
|
|
-- GET /api/v2/docs — Swagger UI
|
|
|
|
import Web.Types
|
|
import Generated.Types
|
|
import IHP.Prelude
|
|
import IHP.ControllerPrelude
|
|
import Data.Aeson (object, (.=), Array, toJSON)
|
|
import qualified Data.Aeson as A
|
|
import qualified Data.Vector as V
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.Encoding as TE
|
|
import qualified Data.Yaml as Yaml -- yaml package
|
|
import qualified Data.ByteString.Lazy as LBS
|
|
import Application.Helper.TypeRegistry
|
|
( activeWidgetTypes, activeEventTypes, activeAnnotationCategories )
|
|
import Network.HTTP.Types (status200)
|
|
import Network.Wai (responseLBS)
|
|
|
|
instance Controller ApiV2OpenApiController where
|
|
|
|
action ApiV2OpenApiJsonAction = do
|
|
spec <- buildOpenApiSpec
|
|
respondAndExit $ responseLBS status200
|
|
[("Content-Type", "application/json")]
|
|
(A.encode spec)
|
|
|
|
action ApiV2OpenApiYamlAction = do
|
|
spec <- buildOpenApiSpec
|
|
let yaml = Yaml.encode spec
|
|
respondAndExit $ responseLBS status200
|
|
[("Content-Type", "application/yaml")]
|
|
(LBS.fromStrict yaml)
|
|
|
|
action ApiV2DocsAction = do
|
|
respondAndExit $ responseLBS status200
|
|
[("Content-Type", "text/html; charset=utf-8")]
|
|
swaggerUiHtml
|
|
|
|
-- | Build the full OpenAPI 3.1 document from live registry data.
|
|
buildOpenApiSpec :: (?modelContext :: ModelContext) => IO Value
|
|
buildOpenApiSpec = do
|
|
(fwWidgetTypes, ownedWidgetTypes) <- activeWidgetTypes
|
|
let allWidgetTypes = fwWidgetTypes ++ ownedWidgetTypes
|
|
eventTypes <- activeEventTypes
|
|
annCats <- activeAnnotationCategories
|
|
|
|
let wtEnum = toJSON $ map (.name) allWidgetTypes
|
|
let etEnum = toJSON $ map (.name) eventTypes
|
|
let acEnum = toJSON $ map (.name) annCats
|
|
|
|
pure $ object
|
|
[ "openapi" .= ("3.1.0" :: Text)
|
|
, "info" .= object
|
|
[ "title" .= ("Interaction Hub Framework API" :: Text)
|
|
, "version" .= ("2.0" :: Text)
|
|
, "description" .= ("IHF external API v2. For the human-readable contract see /contracts/functional/interaction-reporting-v1.md" :: Text)
|
|
]
|
|
, "x-ihf-contract" .= ("/contracts/functional/interaction-reporting-v1.md" :: Text)
|
|
, "servers" .= [object ["url" .= ("/api/v2" :: Text)]]
|
|
, "paths" .= buildPaths
|
|
, "components" .= object
|
|
[ "schemas" .= object
|
|
[ "WidgetType" .= object
|
|
[ "type" .= ("string" :: Text)
|
|
, "enum" .= wtEnum
|
|
]
|
|
, "EventType" .= object
|
|
[ "type" .= ("string" :: Text)
|
|
, "enum" .= etEnum
|
|
]
|
|
, "AnnotationCategory" .= object
|
|
[ "type" .= ("string" :: Text)
|
|
, "enum" .= acEnum
|
|
]
|
|
, "PaginationMeta" .= object
|
|
[ "type" .= ("object" :: Text)
|
|
, "properties" .= object
|
|
[ "page" .= object ["type" .= ("integer" :: Text)]
|
|
, "per_page" .= object ["type" .= ("integer" :: Text)]
|
|
, "total" .= object ["type" .= ("integer" :: Text)]
|
|
]
|
|
]
|
|
, "Widget" .= widgetSchema
|
|
, "InteractionEvent" .= interactionEventSchema
|
|
, "Annotation" .= annotationSchema
|
|
, "RequirementCandidate" .= rcSchema
|
|
, "DecisionRecord" .= drSchema
|
|
, "DeploymentRecord" .= depSchema
|
|
, "OutcomeSignal" .= sigSchema
|
|
, "OutcomeCorrelation" .= outcomeCorrelationSchema
|
|
, "PatternPerformanceRecord" .= patternPerformanceSchema
|
|
, "InstitutionalKnowledgeEntry" .= institutionalKnowledgeSchema
|
|
]
|
|
, "securitySchemes" .= object
|
|
[ "BearerAuth" .= object
|
|
[ "type" .= ("http" :: Text)
|
|
, "scheme" .= ("bearer" :: Text)
|
|
, "description" .= ("API key or OAuth token obtained via POST /api/v2/token" :: Text)
|
|
]
|
|
]
|
|
]
|
|
, "security" .= [object ["BearerAuth" .= ([] :: [Text])]]
|
|
]
|
|
|
|
buildPaths :: Value
|
|
buildPaths = object
|
|
[ "/widgets" .= getListPath "Widget"
|
|
, "/widgets/{id}" .= getShowPath "Widget"
|
|
, "/interaction-events" .= object
|
|
[ "get" .= listOp "InteractionEvent"
|
|
[ ("widgetId", "string", "uuid")
|
|
, ("eventType", "string", "")
|
|
]
|
|
, "post" .= writeOp "InteractionEvent" "CreateInteractionEventRequest"
|
|
]
|
|
, "/annotations" .= object
|
|
[ "get" .= listOp "Annotation"
|
|
[ ("widgetId", "string", "uuid")
|
|
, ("category", "string", "")
|
|
]
|
|
, "post" .= writeOp "Annotation" "CreateAnnotationRequest"
|
|
]
|
|
, "/requirement-candidates" .= getListPath "RequirementCandidate"
|
|
, "/requirement-candidates/{id}" .= getShowPath "RequirementCandidate"
|
|
, "/decision-records" .= getListPath "DecisionRecord"
|
|
, "/decision-records/{id}" .= getShowPath "DecisionRecord"
|
|
, "/deployment-records" .= getListPath "DeploymentRecord"
|
|
, "/deployment-records/{id}" .= getShowPath "DeploymentRecord"
|
|
, "/outcome-signals" .= getListPath "OutcomeSignal"
|
|
, "/outcome-signals/{id}" .= getShowPath "OutcomeSignal"
|
|
, "/widget-types" .= publicListPath "WidgetTypeRegistry"
|
|
, "/event-types" .= publicListPath "EventTypeRegistry"
|
|
, "/annotation-categories" .= publicListPath "AnnotationCategoryRegistry"
|
|
, "/token" .= tokenPath
|
|
-- Phase 10 — Hub Registry and Widget Marketplace
|
|
, "/hub-registry" .= getListPath "HubRegistryEntry"
|
|
, "/hub-registry/{hubId}" .= getShowPath "HubRegistryEntry"
|
|
, "/widget-patterns" .= getListPath "WidgetPattern"
|
|
, "/widget-patterns/{id}" .= getShowPath "WidgetPattern"
|
|
, "/widget-patterns/{id}/adopt" .= object
|
|
[ "post" .= writeOp "PatternAdoption" "AdoptPatternRequest"
|
|
]
|
|
]
|
|
|
|
getListPath :: Text -> Value
|
|
getListPath schemaName = object
|
|
[ "get" .= listOp schemaName [] ]
|
|
|
|
getShowPath :: Text -> Value
|
|
getShowPath schemaName = object
|
|
[ "get" .= showOp schemaName ]
|
|
|
|
listOp :: Text -> [(Text, Text, Text)] -> Value
|
|
listOp schemaName extraParams = object
|
|
[ "summary" .= ("List " <> schemaName)
|
|
, "security" .= [object ["BearerAuth" .= ([] :: [Text])]]
|
|
, "parameters" .= (pageParams ++ map toParam extraParams)
|
|
, "responses" .= object
|
|
[ "200" .= object
|
|
[ "description" .= ("OK" :: Text)
|
|
, "content" .= object
|
|
[ "application/json" .= object
|
|
[ "schema" .= object
|
|
[ "type" .= ("object" :: Text)
|
|
, "properties" .= object
|
|
[ "data" .= object
|
|
[ "type" .= ("array" :: Text)
|
|
, "items" .= object ["$ref" .= ("#/components/schemas/" <> schemaName)]
|
|
]
|
|
, "meta" .= object ["$ref" .= ("#/components/schemas/PaginationMeta" :: Text)]
|
|
]
|
|
]
|
|
]
|
|
]
|
|
]
|
|
, "401" .= object ["description" .= ("Unauthorized" :: Text)]
|
|
]
|
|
]
|
|
where
|
|
toParam (name, typ, fmt) = object $
|
|
[ "name" .= name, "in" .= ("query" :: Text)
|
|
, "schema" .= object (["type" .= typ] ++ if fmt /= "" then [("format", A.String fmt)] else [])
|
|
]
|
|
|
|
showOp :: Text -> Value
|
|
showOp schemaName = object
|
|
[ "summary" .= ("Get " <> schemaName)
|
|
, "security" .= [object ["BearerAuth" .= ([] :: [Text])]]
|
|
, "parameters" .= [object ["name" .= ("id" :: Text), "in" .= ("path" :: Text), "required" .= True, "schema" .= object ["type" .= ("string" :: Text), "format" .= ("uuid" :: Text)]]]
|
|
, "responses" .= object
|
|
[ "200" .= object
|
|
[ "description" .= ("OK" :: Text)
|
|
, "content" .= object
|
|
[ "application/json" .= object
|
|
["schema" .= object ["$ref" .= ("#/components/schemas/" <> schemaName)]]
|
|
]
|
|
]
|
|
, "401" .= object ["description" .= ("Unauthorized" :: Text)]
|
|
, "404" .= object ["description" .= ("Not found" :: Text)]
|
|
]
|
|
]
|
|
|
|
writeOp :: Text -> Text -> Value
|
|
writeOp schemaName _reqSchema = object
|
|
[ "summary" .= ("Create " <> schemaName)
|
|
, "security" .= [object ["BearerAuth" .= ([] :: [Text])]]
|
|
, "requestBody" .= object
|
|
[ "required" .= True
|
|
, "content" .= object
|
|
[ "application/json" .= object
|
|
["schema" .= object ["$ref" .= ("#/components/schemas/" <> schemaName)]]
|
|
]
|
|
]
|
|
, "responses" .= object
|
|
[ "201" .= object ["description" .= ("Created" :: Text)]
|
|
, "401" .= object ["description" .= ("Unauthorized" :: Text)]
|
|
, "422" .= object ["description" .= ("Validation error" :: Text)]
|
|
]
|
|
]
|
|
|
|
publicListPath :: Text -> Value
|
|
publicListPath schemaName = object
|
|
[ "get" .= object
|
|
[ "summary" .= ("List registered " <> schemaName <> " values" :: Text)
|
|
, "responses" .= object
|
|
[ "200" .= object ["description" .= ("OK" :: Text)] ]
|
|
]
|
|
]
|
|
|
|
tokenPath :: Value
|
|
tokenPath = object
|
|
[ "post" .= object
|
|
[ "summary" .= ("Obtain OAuth access token (client credentials)" :: Text)
|
|
, "requestBody" .= object
|
|
[ "required" .= True
|
|
, "content" .= object
|
|
[ "application/x-www-form-urlencoded" .= object
|
|
[ "schema" .= object
|
|
[ "type" .= ("object" :: Text)
|
|
, "properties" .= object
|
|
[ "grant_type" .= object ["type" .= ("string" :: Text), "enum" .= ["client_credentials" :: Text]]
|
|
, "client_id" .= object ["type" .= ("string" :: Text), "format" .= ("uuid" :: Text)]
|
|
, "client_secret" .= object ["type" .= ("string" :: Text)]
|
|
, "scope" .= object ["type" .= ("string" :: Text)]
|
|
]
|
|
]
|
|
]
|
|
]
|
|
]
|
|
, "responses" .= object
|
|
[ "200" .= object ["description" .= ("Access token issued" :: Text)]
|
|
, "400" .= object ["description" .= ("Invalid request or credentials" :: Text)]
|
|
]
|
|
]
|
|
]
|
|
|
|
pageParams :: [Value]
|
|
pageParams =
|
|
[ object ["name" .= ("page" :: Text), "in" .= ("query" :: Text), "schema" .= object ["type" .= ("integer" :: Text)]]
|
|
, object ["name" .= ("per_page" :: Text), "in" .= ("query" :: Text), "schema" .= object ["type" .= ("integer" :: Text)]]
|
|
]
|
|
|
|
-- Schemas for all resource types
|
|
|
|
widgetSchema :: Value
|
|
widgetSchema = object
|
|
[ "type" .= ("object" :: Text)
|
|
, "properties" .= object
|
|
[ "id" .= uuidProp
|
|
, "hubId" .= uuidProp
|
|
, "name" .= strProp
|
|
, "widgetType" .= object ["$ref" .= ("#/components/schemas/WidgetType" :: Text)]
|
|
, "capabilityRef" .= strProp
|
|
, "viewContext" .= strProp
|
|
, "policyScope" .= strProp
|
|
, "status" .= strProp
|
|
, "version" .= object ["type" .= ("integer" :: Text)]
|
|
, "createdAt" .= object ["type" .= ("string" :: Text), "format" .= ("date-time" :: Text)]
|
|
]
|
|
]
|
|
|
|
interactionEventSchema :: Value
|
|
interactionEventSchema = object
|
|
[ "type" .= ("object" :: Text)
|
|
, "properties" .= object
|
|
[ "id" .= uuidProp
|
|
, "widgetId" .= uuidProp
|
|
, "eventType" .= object ["$ref" .= ("#/components/schemas/EventType" :: Text)]
|
|
, "actorId" .= uuidProp
|
|
, "actorType" .= strProp
|
|
, "viewContextRef" .= strProp
|
|
, "metadata" .= object ["type" .= ("object" :: Text)]
|
|
, "occurredAt" .= dtProp
|
|
]
|
|
]
|
|
|
|
annotationSchema :: Value
|
|
annotationSchema = object
|
|
[ "type" .= ("object" :: Text)
|
|
, "properties" .= object
|
|
[ "id" .= uuidProp
|
|
, "widgetId" .= uuidProp
|
|
, "parentId" .= uuidProp
|
|
, "body" .= strProp
|
|
, "category" .= object ["$ref" .= ("#/components/schemas/AnnotationCategory" :: Text)]
|
|
, "severity" .= strProp
|
|
, "threadId" .= uuidProp
|
|
, "actorId" .= uuidProp
|
|
, "actorType" .= strProp
|
|
, "createdAt" .= dtProp
|
|
]
|
|
]
|
|
|
|
rcSchema :: Value
|
|
rcSchema = object
|
|
[ "type" .= ("object" :: Text)
|
|
, "properties" .= object
|
|
[ "id" .= uuidProp
|
|
, "title" .= strProp
|
|
, "description" .= strProp
|
|
, "sourceWidgetId" .= uuidProp
|
|
, "category" .= strProp
|
|
, "status" .= strProp
|
|
, "createdAt" .= dtProp
|
|
]
|
|
]
|
|
|
|
drSchema :: Value
|
|
drSchema = object
|
|
[ "type" .= ("object" :: Text)
|
|
, "properties" .= object
|
|
[ "id" .= uuidProp
|
|
, "title" .= strProp
|
|
, "rationale" .= strProp
|
|
, "outcome" .= strProp
|
|
, "requirementId" .= uuidProp
|
|
, "candidateId" .= uuidProp
|
|
, "decidedAt" .= dtProp
|
|
, "notes" .= strProp
|
|
, "createdAt" .= dtProp
|
|
]
|
|
]
|
|
|
|
depSchema :: Value
|
|
depSchema = object
|
|
[ "type" .= ("object" :: Text)
|
|
, "properties" .= object
|
|
[ "id" .= uuidProp
|
|
, "decisionId" .= uuidProp
|
|
, "versionRef" .= strProp
|
|
, "deployedAt" .= dtProp
|
|
, "notes" .= strProp
|
|
, "createdAt" .= dtProp
|
|
]
|
|
]
|
|
|
|
sigSchema :: Value
|
|
sigSchema = object
|
|
[ "type" .= ("object" :: Text)
|
|
, "properties" .= object
|
|
[ "id" .= uuidProp
|
|
, "widgetId" .= uuidProp
|
|
, "deploymentId" .= uuidProp
|
|
, "signalType" .= strProp
|
|
, "value" .= object ["type" .= ("number" :: Text)]
|
|
, "observedAt" .= dtProp
|
|
]
|
|
]
|
|
|
|
outcomeCorrelationSchema :: Value
|
|
outcomeCorrelationSchema = object
|
|
[ "type" .= ("object" :: Text)
|
|
, "properties" .= object
|
|
[ "id" .= uuidProp
|
|
, "hubId" .= uuidProp
|
|
, "annotationCategory" .= strProp
|
|
, "correlationType" .= strProp
|
|
, "correlationScore" .= object ["type" .= ("number" :: Text)]
|
|
, "sampleCount" .= object ["type" .= ("integer" :: Text)]
|
|
, "computedAt" .= dtProp
|
|
]
|
|
]
|
|
|
|
patternPerformanceSchema :: Value
|
|
patternPerformanceSchema = object
|
|
[ "type" .= ("object" :: Text)
|
|
, "properties" .= object
|
|
[ "id" .= uuidProp
|
|
, "widgetPatternId" .= uuidProp
|
|
, "hubId" .= uuidProp
|
|
, "adoptionCount" .= object ["type" .= ("integer" :: Text)]
|
|
, "positiveOutcomeCount" .= object ["type" .= ("integer" :: Text)]
|
|
, "totalOutcomeCount" .= object ["type" .= ("integer" :: Text)]
|
|
, "positiveOutcomeRate" .= object ["type" .= ("number" :: Text)]
|
|
, "meanOutcomeValue" .= object ["type" .= ("number" :: Text)]
|
|
, "outcomeRank" .= object ["type" .= ("integer" :: Text)]
|
|
, "calibratedAt" .= dtProp
|
|
]
|
|
]
|
|
|
|
institutionalKnowledgeSchema :: Value
|
|
institutionalKnowledgeSchema = object
|
|
[ "type" .= ("object" :: Text)
|
|
, "properties" .= object
|
|
[ "id" .= uuidProp
|
|
, "hubId" .= uuidProp
|
|
, "decisionRecordId" .= uuidProp
|
|
, "summary" .= strProp
|
|
, "tags" .= object ["type" .= ("array" :: Text)]
|
|
, "createdAt" .= dtProp
|
|
, "updatedAt" .= dtProp
|
|
]
|
|
]
|
|
|
|
uuidProp :: Value
|
|
uuidProp = object ["type" .= ("string" :: Text), "format" .= ("uuid" :: Text)]
|
|
|
|
strProp :: Value
|
|
strProp = object ["type" .= ("string" :: Text)]
|
|
|
|
dtProp :: Value
|
|
dtProp = object ["type" .= ("string" :: Text), "format" .= ("date-time" :: Text)]
|
|
|
|
-- | Embedded Swagger UI HTML using CDN assets (no build step required)
|
|
swaggerUiHtml :: LBS.ByteString
|
|
swaggerUiHtml = LBS.fromStrict $ TE.encodeUtf8 swaggerUiHtmlText
|
|
|
|
swaggerUiHtmlText :: Text
|
|
swaggerUiHtmlText =
|
|
"<!DOCTYPE html><html lang=\"en\"><head><meta charset=\"UTF-8\" />" <>
|
|
"<title>IHF API v2 \x2014 Documentation</title>" <>
|
|
"<link rel=\"stylesheet\" href=\"https://unpkg.com/swagger-ui-dist@5/swagger-ui.css\" />" <>
|
|
"</head><body>" <>
|
|
"<div id=\"swagger-ui\"></div>" <>
|
|
"<script src=\"https://unpkg.com/swagger-ui-dist@5/swagger-ui-bundle.js\"></script>" <>
|
|
"<script>window.onload=function(){SwaggerUIBundle({" <>
|
|
"url:\"/api/v2/openapi.json\"," <>
|
|
"dom_id:\"#swagger-ui\"," <>
|
|
"presets:[SwaggerUIBundle.presets.apis,SwaggerUIBundle.SwaggerUIStandalonePreset]," <>
|
|
"layout:\"StandaloneLayout\"" <>
|
|
"});}</script>" <>
|
|
"</body></html>"
|