coulomb/inter-hub
2
0
Fork 0
generated from coulomb/repo-seed
Code Issues Pull Requests Actions 1 Packages Projects Releases Wiki Activity

feat(WP-0009): IHF GAAF Compliance Foundation — type registries, extension manifests, architectural contracts
Some checks failed
Test / test (push) Has been cancelled
Details

Browse Source 
Implements IHUB-WP-0009: closes four GAAF-2026 gaps before domain hub work begins.
- TypeRegistry helper + controllers/views (hub_kind, hub_capability_manifest)
- HubCapabilityManifest entity with validation and registry linkage
- ARCHITECTURE-LAYERS.md + CI-enforced boundary contracts
- Alembic migration 1743724800, fitness tests (Test/Architecture/)
- GAAF spec, Operational Architecture spec, domain hub extension guide
- Updates to CLAUDE.md, SCOPE.md, Schema.sql, Routes, FrontController, Types

state_hub_sync: pending (tunnel was STALE at completion time; run fix-consistency)

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
Bernd Worsch
2026-03-31 21:17:39 +00:00
parent 1a7732d7da
commit b5d73aa18b
47 changed files with 4855 additions and 104 deletions
Download Patch File Download Diff File Expand all files Collapse all files

43
Web/Controller/Widgets.hs
View File

@@ -10,6 +10,7 @@ import IHP.Prelude
import IHP.ControllerPrelude
import Data.Aeson (toJSON, object, (.=))
import Application.Helper.Controller (isInRegression, widgetCycleCounts, callClaudeApi)
import Application.Helper.TypeRegistry (validateWidgetType, validatePolicyScope, activeWidgetTypes, activePolicyScopes)
import Data.List (intercalate)
instance Controller WidgetsController where
@@ -27,7 +28,9 @@ instance Controller WidgetsController where
|> filterWhere (#status, "active")
|> orderByAsc #name
|> fetch
render NewView { widget, hubs, adapterSpecs }
(fwTypes, ownedTypes) <- activeWidgetTypes
policyScopes <- activePolicyScopes
render NewView { widget, hubs, adapterSpecs, widgetTypes = fwTypes <> ownedTypes, policyScopes }
action ShowWidgetAction { widgetId } = do
widget <- fetch widgetId
@@ -70,12 +73,27 @@ instance Controller WidgetsController where
let widget = newRecord @Widget
hubs <- query @Hub |> fetch
adapterSpecs <- query @WidgetAdapterSpec |> filterWhere (#status, "active") |> orderByAsc #name |> fetch
(fwTypes, ownedTypes) <- activeWidgetTypes
policyScopes <- activePolicyScopes
let widgetTypes = fwTypes <> ownedTypes
widgetTypeVal <- paramOrDefault @Text "" "widgetType" >>= \t -> liftIO (validateWidgetType t)
mPolicyScope <- paramOrNothing @Text "policyScope"
policyScopeVal <- case mPolicyScope of
Nothing -> pure (Right ())
Just "" -> pure (Right ())
Just ps -> liftIO (validatePolicyScope ps)
widget
|> fill @'["name", "widgetType", "hubId", "capabilityRef", "viewContext", "policyScope", "status", "adapterSpecId"]
|> validateField #name nonEmpty
|> validateField #widgetType nonEmpty
|> (case widgetTypeVal of
Left msg -> attachFailure #widgetType msg
Right () -> id)
|> (case policyScopeVal of
Left msg -> attachFailure #policyScope msg
Right () -> id)
|> ifValid \case
Left widget -> render NewView { widget, hubs, adapterSpecs }
Left widget -> render NewView { widget, hubs, adapterSpecs, widgetTypes, policyScopes }
Right widget -> do
widget <- createRecord widget
let snapshot = object
@@ -100,18 +118,35 @@ instance Controller WidgetsController where
widget <- fetch widgetId
hubs <- query @Hub |> fetch
adapterSpecs <- query @WidgetAdapterSpec |> filterWhere (#status, "active") |> orderByAsc #name |> fetch
render EditView { widget, hubs, adapterSpecs }
(fwTypes, ownedTypes) <- activeWidgetTypes
policyScopes <- activePolicyScopes
render EditView { widget, hubs, adapterSpecs, widgetTypes = fwTypes <> ownedTypes, policyScopes }
action UpdateWidgetAction { widgetId } = do
widget <- fetch widgetId
hubs <- query @Hub |> fetch
adapterSpecs <- query @WidgetAdapterSpec |> filterWhere (#status, "active") |> orderByAsc #name |> fetch
(fwTypes, ownedTypes) <- activeWidgetTypes
policyScopes <- activePolicyScopes
let widgetTypes = fwTypes <> ownedTypes
widgetTypeVal <- paramOrDefault @Text "" "widgetType" >>= \t -> liftIO (validateWidgetType t)
mPolicyScope <- paramOrNothing @Text "policyScope"
policyScopeVal <- case mPolicyScope of
Nothing -> pure (Right ())
Just "" -> pure (Right ())
Just ps -> liftIO (validatePolicyScope ps)
widget
|> fill @'["name", "widgetType", "hubId", "capabilityRef", "viewContext", "policyScope", "status", "adapterSpecId"]
|> validateField #name nonEmpty
|> validateField #widgetType nonEmpty
|> (case widgetTypeVal of
Left msg -> attachFailure #widgetType msg
Right () -> id)
|> (case policyScopeVal of
Left msg -> attachFailure #policyScope msg
Right () -> id)
|> ifValid \case
Left widget -> render EditView { widget, hubs, adapterSpecs }
Left widget -> render EditView { widget, hubs, adapterSpecs, widgetTypes, policyScopes }
Right widget -> do
let newVersion = widget.version + 1
widget <- widget |> set #version newVersion |> updateRecord