Refactor Category: from ADT to Text.

Author: fisx

integration/test/Test/Apps.hs

@@ -103,9 +103,9 @@ testCreateApp = do
   bindResponse (getApp owner2 tid2 appId) $ \resp -> resp.status `shouldMatchInt` 200
   bindResponse (getApp regularMember2 tid appId) $ \resp -> resp.status `shouldMatchInt` 200
 
-  -- Category must be any of the values for the Category enum
+  -- Category can be any string, clients are responsible for sanitizing this.
   void $ bindResponse (createApp owner tid new {category = "notinenum"}) $ \resp -> do
-    resp.status `shouldMatchInt` 400
+    resp.status `shouldMatchInt` 200
 
   let foundUserType :: (HasCallStack) => Value -> String -> [String] -> App ()
       foundUserType searcher exactMatchTerm aTypes =

libs/wire-api/src/Wire/API/User.hs

@@ -52,10 +52,6 @@ module Wire.API.User
     AppInfo (..),
     PutApp (..),
     Category (..),
-    categoryTextMapping,
-    categoryMap,
-    categoryFromText,
-    categoryToText,
     CreatedApp (..),
     RefreshAppCookieResponse (..),
 
@@ -184,7 +180,6 @@ import Data.Default
 import Data.Domain (Domain (Domain))
 import Data.Either.Extra (maybeToEither)
 import Data.Handle (Handle)
-import Data.HashMap.Strict qualified as HM
 import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
 import Data.Id
 import Data.Json.Util (UTCTimeMillis, (#))
@@ -2125,68 +2120,15 @@ data PutApp = PutApp
   deriving (Arbitrary) via (GenericUniform PutApp)
   deriving (A.FromJSON, A.ToJSON, S.ToSchema) via Schema PutApp
 
-data Category
-  = Security
-  | Collaboration
-  | Productivity
-  | Automation
-  | Files
-  | AI
-  | Developer
-  | Support
-  | Finance
-  | HR
-  | Integration
-  | Compliance
-  | Other
+newtype Category = Category {fromCategory :: Text}
   deriving (Eq, Ord, Show, Read, Generic)
   deriving (Arbitrary) via GenericUniform Category
   deriving (A.FromJSON, A.ToJSON, S.ToSchema) via (Schema Category)
 
-categoryTextMapping :: [(Text, Category)]
-categoryTextMapping =
-  [ ("security", Security),
-    ("collaboration", Collaboration),
-    ("productivity", Productivity),
-    ("automation", Automation),
-    ("files", Files),
-    ("ai", AI),
-    ("developer", Developer),
-    ("support", Support),
-    ("finance", Finance),
-    ("hr", HR),
-    ("integration", Integration),
-    ("compliance", Compliance),
-    ("other", Other)
-  ]
-
-categoryMap :: HM.HashMap Text Category
-categoryMap = HM.fromList categoryTextMapping
-
-categoryFromText :: Text -> Maybe Category
-categoryFromText text' = HM.lookup text' categoryMap
-
-categoryToText :: Category -> Text
-categoryToText = \case
-  Security -> "security"
-  Collaboration -> "collaboration"
-  Productivity -> "productivity"
-  Automation -> "automation"
-  Files -> "files"
-  AI -> "ai"
-  Developer -> "developer"
-  Support -> "support"
-  Finance -> "finance"
-  HR -> "hr"
-  Integration -> "integration"
-  Compliance -> "compliance"
-  Other -> "other"
-
 instance ToSchema Category where
-  schema =
-    enum @Text "Category" $
-      mconcat $
-        map (uncurry element) categoryTextMapping
+  schema = over doc desc (Category <$> fromCategory .= schema @Text)
+    where
+      desc = S.description ?~ "Category name (if uncertain, pick \"other\")"
 
 instance ToSchema NewApp where
   schema =

libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/UserProfile_user.hs

@@ -89,7 +89,7 @@ testObject_UserProfile_user_2 =
       profileApp =
         Just $
           AppInfo
-            { category = Other,
+            { category = Category "other",
               description = unsafeRange "bloob"
             },
       profileSearchable = True

libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/App.hs

@@ -34,7 +34,7 @@ testObject_NewApp_1 =
     (either undefined id $ mkName "good name")
     mempty
     defaultAccentId
-    Other
+    (Category "other")
     (unsafeRange "good description")
     (plainTextPassword6Unsafe "good password")
 
@@ -44,15 +44,15 @@ testObject_CreatedApp_1 =
 
 testObject_AppInfo_1 :: AppInfo
 testObject_AppInfo_1 =
-  AppInfo Other (unsafeRange "good description")
+  AppInfo (Category "other") (unsafeRange "good description")
 
 testObject_PutApp_1 :: PutApp
 testObject_PutApp_1 =
   PutApp
     (Just (either undefined id $ mkName "good name"))
     (Just mempty)
     (Just defaultAccentId)
-    (Just Other)
+    (Just (Category "other"))
     (Just (unsafeRange "good description"))
 
 testObject_PutApp_2 :: PutApp

libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/ListUsersById.hs

@@ -78,7 +78,7 @@ profile2 =
       profileApp =
         Just $
           AppInfo
-            { category = Other,
+            { category = Category "other",
               description = unsafeRange "bloob"
             },
       profileSearchable = True

libs/wire-subsystems/src/Wire/AppStore.hs

@@ -58,7 +58,7 @@ instance PostgresMarshall (UUID, UUID, Value, Text, Text, UUID) StoredApp where
     ( postgresMarshall app.id,
       postgresMarshall app.teamId,
       postgresMarshall app.meta,
-      postgresMarshall (categoryToText app.category),
+      postgresMarshall (fromCategory app.category),
       postgresMarshall (fromRange app.description),
       postgresMarshall app.creator
     )
@@ -69,7 +69,7 @@ instance PostgresUnmarshall (UUID, UUID, Value, Text, Text, UUID) StoredApp wher
       <$> postgresUnmarshall uid
       <*> postgresUnmarshall teamId
       <*> postgresUnmarshall meta
-      <*> (postgresUnmarshall =<< maybe (Left $ "Category " <> category <> " not found") Right (categoryFromText category))
+      <*> postgresUnmarshall (Category category)
       <*> (maybe (Left "description out of bounds") Right . checked @0 @300 =<< postgresUnmarshall description)
       <*> postgresUnmarshall creator
 

libs/wire-subsystems/src/Wire/AppStore/Postgres.hs

@@ -108,7 +108,7 @@ updateAppImpl ::
   StoredAppUpdate ->
   Sem r (Either AppStoreError ())
 updateAppImpl (toUUID -> teamId) (toUUID -> appId) upd = do
-  found <- case (User.categoryToText <$> upd.category, fromRange <$> upd.description) of
+  found <- case (User.fromCategory <$> upd.category, fromRange <$> upd.description) of
     (Just cat, Just desc) ->
       runStatement (cat, desc, appId, teamId) $
         [maybeStatement|