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

fix(api): unblock production build
Some checks failed
Build and Deploy / build-push-deploy (push) Failing after 8m21s
Details

Browse Source
This commit is contained in:
Bernd Worsch
2026-06-14 14:42:11 +02:00
parent 84ee797e4f
commit a2d0dddddd
6 changed files with 51 additions and 40 deletions
Download Patch File Download Diff File Expand all files Collapse all files

40
Web/Controller/Api/V2/HubCapabilityManifests.hs
View File

@@ -16,6 +16,7 @@ import Data.String (fromString)
import qualified Data.Aeson.Key as K
import qualified Data.Aeson.KeyMap as KM
import qualified Data.ByteString as BS
import qualified Data.Text.Encoding as TE
import qualified Data.UUID as UUID
import qualified Data.Vector as V
import Database.PostgreSQL.Simple (Only(..))
@@ -103,13 +104,17 @@ createManifest = do
[ "error" .= ("Hub already has a capability manifest" :: Text)
, "code" .= ("manifest_already_exists" :: Text)
]
declaredWidgetTypes <- textArrayFieldFromRequestOrEmpty "declaredWidgetTypes"
declaredEventTypes <- textArrayFieldFromRequestOrEmpty "declaredEventTypes"
declaredAnnotationCategories <- textArrayFieldFromRequestOrEmpty "declaredAnnotationCategories"
declaredPolicyScopes <- textArrayFieldFromRequestOrEmpty "declaredPolicyScopes"
manifest <- newRecord @HubCapabilityManifest
|> set #hubId hubId
|> set #manifestVersion manifestVersion
|> set #declaredWidgetTypes (toJSON (textArrayFieldFromRequestOrEmpty "declaredWidgetTypes"))
|> set #declaredEventTypes (toJSON (textArrayFieldFromRequestOrEmpty "declaredEventTypes"))
|> set #declaredAnnotationCategories (toJSON (textArrayFieldFromRequestOrEmpty "declaredAnnotationCategories"))
|> set #declaredPolicyScopes (toJSON (textArrayFieldFromRequestOrEmpty "declaredPolicyScopes"))
|> set #declaredWidgetTypes (toJSON declaredWidgetTypes)
|> set #declaredEventTypes (toJSON declaredEventTypes)
|> set #declaredAnnotationCategories (toJSON declaredAnnotationCategories)
|> set #declaredPolicyScopes (toJSON declaredPolicyScopes)
|> set #capabilityDescription capabilityDescription
|> set #contact contact
|> set #status "draft"
@@ -126,13 +131,17 @@ updateManifest manifestId = do
, "code" .= ("manifest_read_only" :: Text)
]
maybeDeclaredWidgetTypes <- textArrayFieldFromRequest "declaredWidgetTypes"
maybeDeclaredEventTypes <- textArrayFieldFromRequest "declaredEventTypes"
maybeDeclaredAnnotationCategories <- textArrayFieldFromRequest "declaredAnnotationCategories"
maybeDeclaredPolicyScopes <- textArrayFieldFromRequest "declaredPolicyScopes"
let manifestVersion = fromMaybe manifest.manifestVersion (nonEmptyText =<< paramOrNothing @Text "manifestVersion")
capabilityDescription = fromMaybe manifest.capabilityDescription (Just <$> paramOrNothing @Text "capabilityDescription")
contact = fromMaybe manifest.contact (Just <$> paramOrNothing @Text "contact")
declaredWidgetTypes = maybe manifest.declaredWidgetTypes toJSON (textArrayFieldFromRequest "declaredWidgetTypes")
declaredEventTypes = maybe manifest.declaredEventTypes toJSON (textArrayFieldFromRequest "declaredEventTypes")
declaredAnnotationCategories = maybe manifest.declaredAnnotationCategories toJSON (textArrayFieldFromRequest "declaredAnnotationCategories")
declaredPolicyScopes = maybe manifest.declaredPolicyScopes toJSON (textArrayFieldFromRequest "declaredPolicyScopes")
declaredWidgetTypes = maybe manifest.declaredWidgetTypes toJSON maybeDeclaredWidgetTypes
declaredEventTypes = maybe manifest.declaredEventTypes toJSON maybeDeclaredEventTypes
declaredAnnotationCategories = maybe manifest.declaredAnnotationCategories toJSON maybeDeclaredAnnotationCategories
declaredPolicyScopes = maybe manifest.declaredPolicyScopes toJSON maybeDeclaredPolicyScopes
manifest <- manifest
|> set #manifestVersion manifestVersion
@@ -204,18 +213,19 @@ manifestToJson manifest = object
, "updatedAt" .= manifest.updatedAt
]
textArrayFieldFromRequestOrEmpty :: (?context :: ControllerContext, ?request :: Request) => Text -> [Text]
textArrayFieldFromRequestOrEmpty :: (?context :: ControllerContext, ?request :: Request) => Text -> IO [Text]
textArrayFieldFromRequestOrEmpty fieldName =
fromMaybe [] (textArrayFieldFromRequest fieldName)
fromMaybe [] <$> textArrayFieldFromRequest fieldName
textArrayFieldFromRequest :: (?context :: ControllerContext, ?request :: Request) => Text -> Maybe [Text]
textArrayFieldFromRequest :: (?context :: ControllerContext, ?request :: Request) => Text -> IO (Maybe [Text])
textArrayFieldFromRequest fieldName =
case getHeader "Content-Type" of
Just contentType | "application/json" `BS.isPrefixOf` contentType ->
textArrayFieldFromJsonBody fieldName requestBodyJSON
Just contentType | "application/json" `BS.isPrefixOf` contentType -> do
body <- requestBodyJSON
pure $ textArrayFieldFromJsonBody fieldName body
_ ->
let values = paramList @Text fieldName
in if null values then Nothing else Just values
let values = paramList @Text (TE.encodeUtf8 fieldName)
in pure $ if null values then Nothing else Just values
textArrayFieldFromJsonBody :: Text -> Value -> Maybe [Text]
textArrayFieldFromJsonBody fieldName (Object body) =