fix(api): unblock production build

Web/Controller/Api/V2/Annotations.hs

@@ -17,7 +17,7 @@ instance Controller ApiV2AnnotationsController where
     action ApiV2IndexAnnotationsAction = do
         case requestMethod ?request of
             "GET"  -> listAnnotations
-            "POST" -> createAnnotation
+            "POST" -> createApiAnnotation
             _      -> respondWithStatus 405 $ object ["error" .= ("Method not allowed" :: Text)]
 
     action ApiV2ShowAnnotationAction { annotationId } = do
@@ -26,7 +26,7 @@ instance Controller ApiV2AnnotationsController where
         renderJson (annotationToJson ann)
 
     -- POST /api/v2/annotations
-    action ApiV2CreateAnnotationAction = createAnnotation
+    action ApiV2CreateAnnotationAction = createApiAnnotation
 
 listAnnotations :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
 listAnnotations = do
@@ -46,8 +46,8 @@ listAnnotations = do
     anns  <- q2 |> limit perPage |> offset off |> fetch
     renderJson $ paginatedResponse (map annotationToJson anns) page perPage total
 
-createAnnotation :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
+createApiAnnotation :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
-createAnnotation = do
+createApiAnnotation = do
     _consumer <- requireApiConsumer
     let widgetIdText = paramOrNothing @Text "widgetId"
         category     = paramOrNothing @Text "category"

Web/Controller/Api/V2/ApiConsumers.hs

@@ -20,7 +20,7 @@ instance Controller ApiV2ApiConsumersController where
     action ApiV2IndexApiConsumersAction = do
         case requestMethod ?request of
             "GET"  -> listApiConsumers
-            "POST" -> createApiConsumer
+            "POST" -> createApiConsumerRecord
             _      -> respondWithStatus 405 $ object ["error" .= ("Method not allowed" :: Text)]
 
     action ApiV2ShowApiConsumerAction { apiConsumerId } = do
@@ -28,7 +28,7 @@ instance Controller ApiV2ApiConsumersController where
         apiConsumer <- fetch apiConsumerId
         renderJson (apiConsumerToJson apiConsumer)
 
-    action ApiV2CreateApiConsumerAction = createApiConsumer
+    action ApiV2CreateApiConsumerAction = createApiConsumerRecord
 
     action ApiV2CreateApiConsumerKeyAction { apiConsumerId } = do
         when (requestMethod ?request /= "POST") do
@@ -48,8 +48,8 @@ listApiConsumers = do
         |> fetch
     renderJson $ paginatedResponse (map apiConsumerToJson consumers) page perPage total
 
-createApiConsumer :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
+createApiConsumerRecord :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
-createApiConsumer = do
+createApiConsumerRecord = do
     _consumer <- requireApiConsumer
     let name = paramOrNothing @Text "name"
         description = paramOrNothing @Text "description"

Web/Controller/Api/V2/HubCapabilityManifests.hs

@@ -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 #declaredWidgetTypes (toJSON declaredWidgetTypes)
-                        |> set #declaredEventTypes (toJSON (textArrayFieldFromRequestOrEmpty "declaredEventTypes"))
+                        |> set #declaredEventTypes (toJSON declaredEventTypes)
-                        |> set #declaredAnnotationCategories (toJSON (textArrayFieldFromRequestOrEmpty "declaredAnnotationCategories"))
+                        |> set #declaredAnnotationCategories (toJSON declaredAnnotationCategories)
-                        |> set #declaredPolicyScopes (toJSON (textArrayFieldFromRequestOrEmpty "declaredPolicyScopes"))
+                        |> 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")
+        declaredWidgetTypes = maybe manifest.declaredWidgetTypes toJSON maybeDeclaredWidgetTypes
-        declaredEventTypes = maybe manifest.declaredEventTypes toJSON (textArrayFieldFromRequest "declaredEventTypes")
+        declaredEventTypes = maybe manifest.declaredEventTypes toJSON maybeDeclaredEventTypes
-        declaredAnnotationCategories = maybe manifest.declaredAnnotationCategories toJSON (textArrayFieldFromRequest "declaredAnnotationCategories")
+        declaredAnnotationCategories = maybe manifest.declaredAnnotationCategories toJSON maybeDeclaredAnnotationCategories
-        declaredPolicyScopes = maybe manifest.declaredPolicyScopes toJSON (textArrayFieldFromRequest "declaredPolicyScopes")
+        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 ->
+        Just contentType | "application/json" `BS.isPrefixOf` contentType -> do
-            textArrayFieldFromJsonBody fieldName requestBodyJSON
+            body <- requestBodyJSON
+            pure $ textArrayFieldFromJsonBody fieldName body
         _ ->
-            let values = paramList @Text fieldName
+            let values = paramList @Text (TE.encodeUtf8 fieldName)
-            in if null values then Nothing else Just values
+            in pure $ if null values then Nothing else Just values
 
 textArrayFieldFromJsonBody :: Text -> Value -> Maybe [Text]
 textArrayFieldFromJsonBody fieldName (Object body) =

Web/Controller/Api/V2/Hubs.hs

@@ -15,7 +15,7 @@ instance Controller ApiV2HubsController where
     action ApiV2IndexHubsAction = do
         case requestMethod ?request of
             "GET"  -> listHubs
-            "POST" -> createHub
+            "POST" -> createApiHub
             _      -> respondWithStatus 405 $ object ["error" .= ("Method not allowed" :: Text)]
 
     action ApiV2ShowHubAction { hubId } = do
@@ -23,7 +23,7 @@ instance Controller ApiV2HubsController where
         hub <- fetch hubId
         renderJson (hubToJson hub)
 
-    action ApiV2CreateHubAction = createHub
+    action ApiV2CreateHubAction = createApiHub
 
 listHubs :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
 listHubs = do
@@ -38,8 +38,8 @@ listHubs = do
         |> fetch
     renderJson $ paginatedResponse (map hubToJson hubs) page perPage total
 
-createHub :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
+createApiHub :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
-createHub = do
+createApiHub = do
     _consumer <- requireApiConsumer
     let slug   = paramOrNothing @Text "slug"
         name   = paramOrNothing @Text "name"

Web/Controller/Api/V2/InteractionEvents.hs

@@ -27,7 +27,7 @@ instance Controller ApiV2InteractionEventsController where
     action ApiV2IndexInteractionEventsAction = do
         case requestMethod ?request of
             "GET"  -> listInteractionEvents
-            "POST" -> createInteractionEvent
+            "POST" -> createApiInteractionEvent
             _      -> respondWithStatus 405 $ object ["error" .= ("Method not allowed" :: Text)]
 
     action ApiV2ShowInteractionEventAction { interactionEventId } = do
@@ -36,7 +36,7 @@ instance Controller ApiV2InteractionEventsController where
         renderJson (eventToJson event)
 
     -- POST /api/v2/interaction-events
-    action ApiV2CreateInteractionEventAction = createInteractionEvent
+    action ApiV2CreateInteractionEventAction = createApiInteractionEvent
 
 listInteractionEvents :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
 listInteractionEvents = do
@@ -57,13 +57,13 @@ listInteractionEvents = do
     events <- q2 |> limit perPage |> offset off |> fetch
     renderJson $ paginatedResponse (map eventToJson events) page perPage total
 
-createInteractionEvent :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
+createApiInteractionEvent :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
-createInteractionEvent = do
+createApiInteractionEvent = do
     consumer <- requireApiConsumer
+    metadata <- metadataFromRequest
     let widgetIdText = paramOrNothing @Text "widgetId"
         eventType    = paramOrNothing @Text "eventType"
         viewContext  = paramOrNothing @Text "viewContext"
-        metadata     = metadataFromRequest
 
     let missing = catMaybes
             [ if isNothing widgetIdText then Just ("widgetId" :: Text) else Nothing
@@ -155,13 +155,14 @@ manifestAllowsEvent eventType declaredEventTypes =
 metadataParamOrEmpty :: Maybe A.Value -> A.Value
 metadataParamOrEmpty = fromMaybe (object [])
 
-metadataFromRequest :: (?context :: ControllerContext) => A.Value
+metadataFromRequest :: (?context :: ControllerContext, ?request :: Request) => IO A.Value
 metadataFromRequest =
     case getHeader "Content-Type" of
-        Just contentType | "application/json" `BS.isPrefixOf` contentType ->
+        Just contentType | "application/json" `BS.isPrefixOf` contentType -> do
-            metadataParamOrEmpty (metadataFromJsonBody requestBodyJSON)
+            body <- requestBodyJSON
+            pure $ metadataParamOrEmpty (metadataFromJsonBody body)
         _ ->
-            metadataParamOrEmpty (metadataFromText =<< paramOrNothing @Text "metadata")
+            pure $ metadataParamOrEmpty (metadataFromText =<< paramOrNothing @Text "metadata")
 
 metadataFromJsonBody :: A.Value -> Maybe A.Value
 metadataFromJsonBody (Object body) = KM.lookup "metadata" body

Web/Controller/Api/V2/Widgets.hs

@@ -17,7 +17,7 @@ instance Controller ApiV2WidgetsController where
     action ApiV2IndexWidgetsAction = do
         case requestMethod ?request of
             "GET"  -> listWidgets
-            "POST" -> createWidget
+            "POST" -> createApiWidget
             _      -> respondWithStatus 405 $ object ["error" .= ("Method not allowed" :: Text)]
 
     action ApiV2ShowWidgetAction { widgetId } = do
@@ -25,7 +25,7 @@ instance Controller ApiV2WidgetsController where
         widget <- fetch widgetId
         renderJson (widgetToJson widget)
 
-    action ApiV2CreateWidgetAction = createWidget
+    action ApiV2CreateWidgetAction = createApiWidget
 
 listWidgets :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
 listWidgets = do
@@ -40,8 +40,8 @@ listWidgets = do
         |> fetch
     renderJson $ paginatedResponse (map widgetToJson widgets) page perPage total
 
-createWidget :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
+createApiWidget :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
-createWidget = do
+createApiWidget = do
     _consumer <- requireApiConsumer
     let hubIdText     = paramOrNothing @Text "hubId"
         name          = paramOrNothing @Text "name"