module Web.Controller.Api.V2.Widgets where import Web.Types import Generated.Types import IHP.Prelude import IHP.ControllerPrelude import Data.Aeson (Value, object, (.=)) import Network.Wai (requestMethod) import qualified Data.UUID as UUID import Application.Helper.TypeRegistry (validateWidgetType, validatePolicyScope) import Web.Controller.Api.V2.Auth ( requireApiConsumer, paginatedResponse, getPageParams , respondWithStatus ) instance Controller ApiV2WidgetsController where action ApiV2IndexWidgetsAction = do case requestMethod ?request of "GET" -> listWidgets "POST" -> createApiWidget _ -> respondWithStatus 405 $ object ["error" .= ("Method not allowed" :: Text)] action ApiV2ShowWidgetAction { widgetId } = do _consumer <- requireApiConsumer widget <- fetch widgetId renderJson (widgetToJson widget) action ApiV2CreateWidgetAction = createApiWidget listWidgets :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO () listWidgets = do _consumer <- requireApiConsumer (page, perPage) <- getPageParams let pageOffset = (page - 1) * perPage total <- query @Widget |> fetchCount widgets <- query @Widget |> orderByDesc #createdAt |> limit perPage |> offset pageOffset |> fetch renderJson $ paginatedResponse (map widgetToJson widgets) page perPage total createApiWidget :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO () createApiWidget = do _consumer <- requireApiConsumer let hubIdText = paramOrNothing @Text "hubId" name = paramOrNothing @Text "name" widgetType = paramOrNothing @Text "widgetType" capabilityRef = paramOrNothing @Text "capabilityRef" viewContext = paramOrNothing @Text "viewContext" policyScope = fromMaybe "internal" (nonEmptyText =<< paramOrNothing @Text "policyScope") status = fromMaybe "active" (nonEmptyText =<< paramOrNothing @Text "status") let missing = missingWidgetCreateFields [ ("hubId", hubIdText) , ("name", name) , ("widgetType", widgetType) ] unless (null missing) do respondWithStatus 422 $ object [ "error" .= ("Missing required fields" :: Text) , "missing" .= missing ] unless (validWidgetStatus status) do respondWithStatus 422 $ object [ "error" .= ("Unsupported widget status" :: Text) , "code" .= ("unsupported_widget_status" :: Text) , "value" .= status , "valid" .= validWidgetStatuses ] let Just hubIdRaw = hubIdText Just nameText = name Just typeText = widgetType typeResult <- liftIO $ validateWidgetType typeText case typeResult of Left _ -> respondWithStatus 422 $ object [ "error" .= ("Unregistered widget type" :: Text) , "code" .= ("unregistered_widget_type" :: Text) , "value" .= typeText , "registry" .= ("/api/v2/widget-types" :: Text) ] Right () -> pure () scopeResult <- liftIO $ validatePolicyScope policyScope case scopeResult of Left _ -> respondWithStatus 422 $ object [ "error" .= ("Unregistered policy scope" :: Text) , "code" .= ("unregistered_policy_scope" :: Text) , "value" .= policyScope , "registry" .= ("/api/v2/policy-scopes" :: Text) ] Right () -> pure () adapterSpecId <- parseOptionalAdapterSpecId case UUID.fromText hubIdRaw of Nothing -> respondWithStatus 422 $ object ["error" .= ("hubId must be a valid UUID" :: Text)] Just rawId -> do let hubId = Id rawId :: Id Hub mHub <- fetchOneOrNothing hubId case mHub of Nothing -> respondWithStatus 422 $ object ["error" .= ("Hub not found" :: Text)] Just _hub -> do widget <- newRecord @Widget |> set #hubId hubId |> set #name nameText |> set #widgetType typeText |> set #capabilityRef capabilityRef |> set #viewContext viewContext |> set #policyScope policyScope |> set #status status |> set #adapterSpecId adapterSpecId |> createRecord _version <- createInitialWidgetVersion widget respondWithStatus 201 (widgetToJson widget) parseOptionalAdapterSpecId :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO (Maybe (Id WidgetAdapterSpec)) parseOptionalAdapterSpecId = case paramOrNothing @Text "adapterSpecId" of Nothing -> pure Nothing Just "" -> pure Nothing Just adapterSpecRaw -> case UUID.fromText adapterSpecRaw of Nothing -> respondWithStatus 422 $ object ["error" .= ("adapterSpecId must be a valid UUID" :: Text)] Just rawId -> do let adapterSpecId = Id rawId :: Id WidgetAdapterSpec mAdapterSpec <- fetchOneOrNothing adapterSpecId case mAdapterSpec of Nothing -> respondWithStatus 422 $ object ["error" .= ("Widget adapter spec not found" :: Text)] Just _ -> pure (Just adapterSpecId) createInitialWidgetVersion :: (?modelContext :: ModelContext) => Widget -> IO WidgetVersion createInitialWidgetVersion widget = newRecord @WidgetVersion |> set #widgetId widget.id |> set #version 1 |> set #schemaSnapshot (widgetVersionSnapshot widget) |> createRecord widgetVersionSnapshot :: Widget -> Value widgetVersionSnapshot widget = object [ "name" .= widget.name , "widget_type" .= widget.widgetType , "hub_id" .= widget.hubId , "capability_ref" .= widget.capabilityRef , "view_context" .= widget.viewContext , "policy_scope" .= widget.policyScope , "status" .= widget.status , "version" .= widget.version ] widgetToJson :: Widget -> Value widgetToJson w = object [ "id" .= w.id , "hubId" .= w.hubId , "name" .= w.name , "widgetType" .= w.widgetType , "capabilityRef" .= w.capabilityRef , "viewContext" .= w.viewContext , "policyScope" .= w.policyScope , "status" .= w.status , "version" .= w.version , "createdAt" .= w.createdAt ] validWidgetStatuses :: [Text] validWidgetStatuses = ["active", "deprecated", "draft"] validWidgetStatus :: Text -> Bool validWidgetStatus status = status `elem` validWidgetStatuses missingWidgetCreateFields :: [(Text, Maybe Text)] -> [Text] missingWidgetCreateFields fields = [ name | (name, value) <- fields, maybe True (== "") value ] nonEmptyText :: Text -> Maybe Text nonEmptyText "" = Nothing nonEmptyText value = Just value