feat: add v2 hub and widget create endpoints

2026-05-16 08:34:20 +02:00
parent 0a4646bf44
commit 4ebc04e1f4
11 changed files with 536 additions and 154 deletions
--- a/Web/Controller/Api/V2/Annotations.hs
+++ b/Web/Controller/Api/V2/Annotations.hs
@@ -10,25 +10,15 @@ import Web.Controller.Api.V2.Auth
    , respondWithStatus )
 import Application.Helper.TypeRegistry (validateAnnotationCategory)
 import qualified Data.UUID as UUID
+import Network.Wai (requestMethod)

 instance Controller ApiV2AnnotationsController where

    action ApiV2IndexAnnotationsAction = do
-        _consumer <- requireApiConsumer
-        (page, perPage) <- getPageParams
-        let mWidgetId = paramOrNothing @(Id Widget) "widgetId"
-            mCategory = paramOrNothing @Text "category"
-        let off = (page - 1) * perPage
-        let baseQ = query @Annotation |> orderByDesc #createdAt
-        let q1 = case mWidgetId of
-                    Just wId -> baseQ |> filterWhere (#widgetId, wId)
-                    Nothing  -> baseQ
-        let q2 = case mCategory of
-                    Just cat -> q1 |> filterWhere (#category, cat)
-                    Nothing  -> q1
-        total <- q2 |> fetchCount
-        anns  <- q2 |> limit perPage |> offset off |> fetch
-        renderJson $ paginatedResponse (map annotationToJson anns) page perPage total
+        case requestMethod ?request of
+            "GET"  -> listAnnotations
+            "POST" -> createAnnotation
+            _      -> respondWithStatus 405 $ object ["error" .= ("Method not allowed" :: Text)]

    action ApiV2ShowAnnotationAction { annotationId } = do
        _consumer <- requireApiConsumer
@@ -36,54 +26,75 @@ instance Controller ApiV2AnnotationsController where
        renderJson (annotationToJson ann)

    -- POST /api/v2/annotations
-    action ApiV2CreateAnnotationAction = do
-        _consumer <- requireApiConsumer
-        let widgetIdText = paramOrNothing @Text "widgetId"
-            category     = paramOrNothing @Text "category"
-            body         = paramOrNothing @Text "body"
+    action ApiV2CreateAnnotationAction = createAnnotation

-        let missing = catMaybes
-                [ if isNothing widgetIdText then Just ("widgetId" :: Text) else Nothing
-                , if isNothing category     then Just "category"            else Nothing
-                , if isNothing body         then Just "body"                else Nothing
-                ]
-        unless (null missing) do
-            respondWithStatus 422 $ object
-                [ "error"   .= ("Missing required fields" :: Text)
-                , "missing" .= missing
-                ]
+listAnnotations :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
+listAnnotations = do
+    _consumer <- requireApiConsumer
+    (page, perPage) <- getPageParams
+    let mWidgetId = paramOrNothing @(Id Widget) "widgetId"
+        mCategory = paramOrNothing @Text "category"
+    let off = (page - 1) * perPage
+    let baseQ = query @Annotation |> orderByDesc #createdAt
+    let q1 = case mWidgetId of
+                Just wId -> baseQ |> filterWhere (#widgetId, wId)
+                Nothing  -> baseQ
+    let q2 = case mCategory of
+                Just cat -> q1 |> filterWhere (#category, cat)
+                Nothing  -> q1
+    total <- q2 |> fetchCount
+    anns  <- q2 |> limit perPage |> offset off |> fetch
+    renderJson $ paginatedResponse (map annotationToJson anns) page perPage total

-        let Just wIdText = widgetIdText
-            Just cat     = category
-            Just bodyTxt = body
+createAnnotation :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
+createAnnotation = do
+    _consumer <- requireApiConsumer
+    let widgetIdText = paramOrNothing @Text "widgetId"
+        category     = paramOrNothing @Text "category"
+        body         = paramOrNothing @Text "body"

-        catResult <- liftIO $ validateAnnotationCategory cat
-        case catResult of
-            Left _ -> respondWithStatus 422 $ object
-                [ "error"    .= ("Unregistered annotation category" :: Text)
-                , "code"     .= ("unregistered_category" :: Text)
-                , "value"    .= cat
-                , "registry" .= ("/api/v2/annotation-categories" :: Text)
-                ]
-            Right () -> pure ()
+    let missing = catMaybes
+            [ if isNothing widgetIdText then Just ("widgetId" :: Text) else Nothing
+            , if isNothing category     then Just "category"            else Nothing
+            , if isNothing body         then Just "body"                else Nothing
+            ]
+    unless (null missing) do
+        respondWithStatus 422 $ object
+            [ "error"   .= ("Missing required fields" :: Text)
+            , "missing" .= missing
+            ]

-        case UUID.fromText wIdText of
-            Nothing -> respondWithStatus 422 $ object
-                ["error" .= ("widgetId must be a valid UUID" :: Text)]
-            Just rawId -> do
-                let wId = Id rawId :: Id Widget
-                mWidget <- fetchOneOrNothing wId
-                case mWidget of
-                    Nothing -> respondWithStatus 422 $ object
-                        ["error" .= ("Widget not found" :: Text)]
-                    Just _widget -> do
-                        ann <- newRecord @Annotation
-                            |> set #widgetId wId
-                            |> set #category cat
-                            |> set #body bodyTxt
-                            |> set #actorType "api"
-                            |> createRecord
-                        renderJson (annotationToJson ann)
+    let Just wIdText = widgetIdText
+        Just cat     = category
+        Just bodyTxt = body
+
+    catResult <- liftIO $ validateAnnotationCategory cat
+    case catResult of
+        Left _ -> respondWithStatus 422 $ object
+            [ "error"    .= ("Unregistered annotation category" :: Text)
+            , "code"     .= ("unregistered_category" :: Text)
+            , "value"    .= cat
+            , "registry" .= ("/api/v2/annotation-categories" :: Text)
+            ]
+        Right () -> pure ()
+
+    case UUID.fromText wIdText of
+        Nothing -> respondWithStatus 422 $ object
+            ["error" .= ("widgetId must be a valid UUID" :: Text)]
+        Just rawId -> do
+            let wId = Id rawId :: Id Widget
+            mWidget <- fetchOneOrNothing wId
+            case mWidget of
+                Nothing -> respondWithStatus 422 $ object
+                    ["error" .= ("Widget not found" :: Text)]
+                Just _widget -> do
+                    ann <- newRecord @Annotation
+                        |> set #widgetId wId
+                        |> set #category cat
+                        |> set #body bodyTxt
+                        |> set #actorType "api"
+                        |> createRecord
+                    respondWithStatus 201 (annotationToJson ann)

 annotationToJson :: Annotation -> Value
 annotationToJson a = object