Unified display info

share-api.cabal

@@ -148,7 +148,8 @@ library
       Share.Web.Share.DefinitionSearch
       Share.Web.Share.Diffs.Impl
       Share.Web.Share.Diffs.Types
-      Share.Web.Share.DisplayInfo
+      Share.Web.Share.DisplayInfo.Queries
+      Share.Web.Share.DisplayInfo.Types
       Share.Web.Share.Impl
       Share.Web.Share.Orgs.API
       Share.Web.Share.Orgs.Impl

src/Share/BackgroundJobs/Webhooks/Types.hs

@@ -15,7 +15,7 @@ import Data.Text qualified as Text
 import Share.Contribution (ContributionStatus)
 import Share.IDs
 import Share.Prelude
-import Share.Web.Share.DisplayInfo (UserDisplayInfo)
+import Share.Web.Share.DisplayInfo.Types (UserDisplayInfo)
 
 data BranchPayload = BranchPayload
   { branchId :: BranchId,

src/Share/Postgres/Users/Queries.hs

@@ -15,6 +15,7 @@ module Share.Postgres.Users.Queries
     userByGithubUserId,
     userByHandle,
     createFromGithubUser,
+    joinOrgIdsToUserIdsOf,
     NewOrPreExisting (..),
     getNewOrPreExisting,
     isNew,
@@ -48,7 +49,7 @@ import Share.Utils.Postgres
 import Share.Utils.URI (URIParam (..))
 import Share.Web.Authorization.Types qualified as AuthZ
 import Share.Web.Errors (EntityMissing (EntityMissing), ErrorID (..), ToServerError (..))
-import Share.Web.Share.DisplayInfo (UserDisplayInfo (..))
+import Share.Web.Share.DisplayInfo.Types (UserDisplayInfo (..), UserLike (..))
 
 -- | Efficiently resolve User Display Info for UserIds within a structure.
 userDisplayInfoOf :: (PG.QueryA m) => Traversal s t UserId UserDisplayInfo -> s -> m t
@@ -274,20 +275,43 @@ findOrCreateGithubUser authZReceipt ghu@(GithubUser _login githubUserId _avatarU
     Nothing -> do
       New <$> createFromGithubUser authZReceipt ghu primaryEmail userHandle
 
-searchUsersByNameOrHandlePrefix :: Query -> Limit -> PG.Transaction e [(User, Maybe OrgId)]
+searchUsersByNameOrHandlePrefix :: Query -> Limit -> PG.Transaction e [(UserLike UserId team OrgId)]
 searchUsersByNameOrHandlePrefix (Query prefix) (Limit limit) = do
   let q = likeEscape prefix <> "%"
-  PG.queryListRows @(User PG.:. (PG.Only (Maybe OrgId)))
+  PG.queryListRows @(UserId, Maybe OrgId)
     [PG.sql|
-    SELECT u.id, u.name, u.primary_email, u.avatar_url, u.handle, u.private, org.id
+    SELECT u.id, org.id
       FROM users u
       LEFT JOIN orgs org ON org.user_id = u.id
       WHERE (u.handle ILIKE #{q}
              OR u.name ILIKE #{q}
             ) AND NOT u.private
       LIMIT #{limit}
       |]
-    <&> fmap \(user PG.:. PG.Only mayOrgId) -> (user, mayOrgId)
+    <&> fmap \(userId, mayOrgId) -> case mayOrgId of
+      Just orgId -> UnifiedOrg orgId
+      Nothing -> UnifiedUser userId
+
+joinOrgIdsToUserIdsOf :: Traversal s t UserId (UserId, Maybe OrgId) -> s -> PG.Transaction e t
+joinOrgIdsToUserIdsOf trav s = do
+  s
+    & unsafePartsOf trav %%~ \userIds -> do
+      let usersTable = zip [0 :: Int32 ..] userIds
+      PG.queryListRows @(UserId, Maybe OrgId)
+        [PG.sql|
+      WITH values(ord, user_id) AS (
+        SELECT * FROM ^{PG.toTable usersTable}
+      )
+      SELECT u.id, org.id
+        FROM values
+          LEFT JOIN orgs org ON org.user_id = values.user_id
+          JOIN users u ON u.id = values.user_id
+      ORDER BY ord
+      |]
+        <&> fmap \(userId, mayOrgId) ->
+          if length userIds /= length userIds
+            then error "joinOrgIdsToUserIdsOf: Missing user ids."
+            else (userId, mayOrgId)
 
 data UserCreationError
   = UserHandleTaken UserHandle

src/Share/Web/Authorization/Types.hs

@@ -48,7 +48,7 @@ import Share.IDs
 import Share.Postgres qualified as PG
 import Share.Prelude
 import Share.Utils.API (AtKey (..))
-import Share.Web.Share.DisplayInfo
+import Share.Web.Share.DisplayInfo.Types
 
 data SubjectKind = UserSubjectKind | OrgSubjectKind | TeamSubjectKind
   deriving (Show)

src/Share/Web/Share/Branches/Types.hs

@@ -14,7 +14,7 @@ import Share.IDs
 import Share.IDs qualified as IDs
 import Share.Postgres.IDs
 import Share.Web.Share.Contributions.Types (ShareContribution)
-import Share.Web.Share.DisplayInfo (UserDisplayInfo)
+import Share.Web.Share.DisplayInfo.Types (UserDisplayInfo)
 import Share.Web.Share.Projects.Types
 
 branchToShareBranch :: BranchShortHand -> Branch CausalHash -> APIProject -> [ShareContribution UserDisplayInfo] -> ShareBranch

src/Share/Web/Share/Comments/API.hs

@@ -7,7 +7,7 @@ import Servant
 import Share.IDs
 import Share.Web.Share.Comments
 import Share.Web.Share.Comments.Types
-import Share.Web.Share.DisplayInfo (UserDisplayInfo)
+import Share.Web.Share.DisplayInfo.Types (UserDisplayInfo)
 
 type CommentResourceServer = UpdateComment :<|> DeleteComment
 

src/Share/Web/Share/Comments/Impl.hs

@@ -21,7 +21,7 @@ import Share.Web.Authorization qualified as AuthZ
 import Share.Web.Errors
 import Share.Web.Share.Comments
 import Share.Web.Share.Comments.Types
-import Share.Web.Share.DisplayInfo (UserDisplayInfo (..))
+import Share.Web.Share.DisplayInfo.Types (UserDisplayInfo (..))
 
 createCommentEndpoint ::
   Maybe Session ->

src/Share/Web/Share/Comments/Types.hs

@@ -9,7 +9,7 @@ module Share.Web.Share.Comments.Types where
 import Data.Aeson
 import Share.Prelude
 import Share.Web.Share.Comments (CommentEvent (..), RevisionNumber)
-import Share.Web.Share.DisplayInfo (UserDisplayInfo)
+import Share.Web.Share.DisplayInfo.Types (UserDisplayInfo)
 
 data CreateCommentRequest = CreateCommentRequest
   { content :: Text

src/Share/Web/Share/Contributions/API.hs

@@ -14,7 +14,7 @@ import Share.Utils.Servant (RequiredQueryParam)
 import Share.Web.Share.Comments.API qualified as Comments
 import Share.Web.Share.Contributions.Types
 import Share.Web.Share.Diffs.Types (ShareNamespaceDiffResponse, ShareTermDiffResponse, ShareTypeDiffResponse)
-import Share.Web.Share.DisplayInfo (UserDisplayInfo)
+import Share.Web.Share.DisplayInfo.Types (UserDisplayInfo)
 import Unison.Name (Name)
 
 type ContributionsByUserAPI = ListContributionsByUserEndpoint

src/Share/Web/Share/Contributions/Impl.hs

@@ -56,7 +56,7 @@ import Share.Web.Share.Contributions.MergeDetection qualified as MergeDetection
 import Share.Web.Share.Contributions.Types
 import Share.Web.Share.Diffs.Impl qualified as Diffs
 import Share.Web.Share.Diffs.Types (ShareNamespaceDiffResponse (..), ShareNamespaceDiffStatus (..), ShareTermDiffResponse (..), ShareTypeDiffResponse (..))
-import Share.Web.Share.DisplayInfo (UserDisplayInfo (..))
+import Share.Web.Share.DisplayInfo.Types (UserDisplayInfo (..))
 import Unison.Name (Name)
 import Unison.Server.Types
 import Unison.Syntax.Name qualified as Name

src/Share/Web/Share/Contributions/Types.hs

@@ -20,7 +20,7 @@ import Share.Utils.API (NullableUpdate, parseNullableUpdate)
 import Share.Utils.Logging qualified as Logging
 import Share.Web.Errors qualified as Err
 import Share.Web.Share.Comments (CommentEvent (..), commentEventTimestamp)
-import Share.Web.Share.DisplayInfo (UserDisplayInfo)
+import Share.Web.Share.DisplayInfo.Types (UserDisplayInfo)
 import U.Codebase.HashTags (CausalHash (..))
 import Unison.Hash qualified as Hash
 import Web.HttpApiData (ToHttpApiData (..))

src/Share/Web/Share/DisplayInfo/Queries.hs

@@ -0,0 +1,28 @@
+module Share.Web.Share.DisplayInfo.Queries (userLikeDisplayInfoOf, unifiedDisplayInfoForUserOf) where
+
+import Control.Lens
+import Share.IDs
+import Share.Postgres (Transaction)
+import Share.Postgres.Users.Queries qualified as UserQ
+import Share.Postgres.Users.Queries qualified as UsersQ
+import Share.Web.Share.DisplayInfo.Types
+import Share.Web.Share.Orgs.Queries qualified as OrgsQ
+import Share.Web.Share.Teams.Queries qualified as TeamsQ
+
+userLikeDisplayInfoOf :: Traversal s t UserLikeIds UnifiedDisplayInfo -> s -> Transaction e t
+userLikeDisplayInfoOf trav s = do
+  s & unsafePartsOf trav \userLikeIds -> do
+    withUsers <- userLikeIds & UsersQ.userDisplayInfoOf (traversed . unifiedUser_)
+    withTeams <- withUsers & TeamsQ.teamDisplayInfoOf (traversed . unifiedTeam_)
+    withOrgs <- withTeams & OrgsQ.orgDisplayInfoOf (traversed . unifiedOrg_)
+    pure withOrgs
+
+unifiedDisplayInfoForUserOf :: Traversal s t UserId UnifiedDisplayInfo -> s -> Transaction e t
+unifiedDisplayInfoForUserOf trav s = do
+  s & unsafePartsOf trav \userLikeIds -> do
+    userLikes <-
+      UserQ.joinOrgIdsToUserIdsOf traversed userLikeIds
+        <&> fmap \case
+          (_userId, Just orgId) -> UnifiedOrg orgId
+          (userId, Nothing) -> UnifiedUser userId
+    userLikes & userLikeDisplayInfoOf traversed

src/Share/Web/Share/DisplayInfo/Types.hs

@@ -0,0 +1,128 @@
+-- Standard ways of displaying core Share concepts.
+--
+-- This was consolidated to this module mostly to avoid circular imports.
+module Share.Web.Share.DisplayInfo.Types
+  ( UserDisplayInfo (..),
+    OrgDisplayInfo (..),
+    TeamDisplayInfo (..),
+    UserLike (..),
+    UnifiedDisplayInfo,
+    UserLikeIds,
+    unifiedUser_,
+    unifiedOrg_,
+    unifiedTeam_,
+  )
+where
+
+import Control.Lens
+import Data.Aeson (ToJSON (..))
+import Data.Aeson qualified as Aeson
+import Data.Aeson.Types (FromJSON)
+import Network.URI (URI)
+import Share.IDs
+import Share.Prelude
+import Share.Utils.URI (URIParam (..))
+
+-- | A single unified type for anywhere the frontend may need to display a user-like
+-- thing; whether org, team, or user.
+data UserLike user team org
+  = UnifiedUser user
+  | UnifiedOrg org
+  | UnifiedTeam team
+  deriving (Show, Eq, Ord)
+
+instance (ToJSON user, ToJSON team, ToJSON org) => ToJSON (UserLike user team org) where
+  toJSON = \case
+    UnifiedUser u -> Aeson.object ["kind" Aeson..= ("user" :: Text), "info" Aeson..= u]
+    UnifiedOrg o -> Aeson.object ["kind" Aeson..= ("org" :: Text), "info" Aeson..= o]
+    UnifiedTeam t -> Aeson.object ["kind" Aeson..= ("team" :: Text), "info" Aeson..= t]
+
+instance (FromJSON user, FromJSON team, FromJSON org) => FromJSON (UserLike user team org) where
+  parseJSON =
+    Aeson.withObject "UserLike" $ \o -> do
+      kind <- o Aeson..: "kind"
+      case kind of
+        ("user" :: Text) -> UnifiedUser <$> o Aeson..: "info"
+        ("org" :: Text) -> UnifiedOrg <$> o Aeson..: "info"
+        ("team" :: Text) -> UnifiedTeam <$> o Aeson..: "info"
+        _ -> fail $ "Unknown UserLike kind: " <> show kind
+
+type UnifiedDisplayInfo = UserLike UserDisplayInfo TeamDisplayInfo OrgDisplayInfo
+
+type UserLikeIds = UserLike UserId TeamId OrgId
+
+unifiedUser_ :: Traversal (UserLike user team org) (UserLike user' team org) user user'
+unifiedUser_ f = \case
+  (UnifiedUser u) -> UnifiedUser <$> f u
+  (UnifiedOrg o) -> pure $ UnifiedOrg o
+  (UnifiedTeam t) -> pure $ UnifiedTeam t
+
+unifiedOrg_ :: Traversal (UserLike user team org) (UserLike user team org') org org'
+unifiedOrg_ f = \case
+  (UnifiedUser u) -> pure $ UnifiedUser u
+  (UnifiedOrg o) -> UnifiedOrg <$> f o
+  (UnifiedTeam t) -> pure $ UnifiedTeam t
+
+unifiedTeam_ :: Traversal (UserLike user team org) (UserLike user team' org) team team'
+unifiedTeam_ f = \case
+  (UnifiedUser u) -> pure $ UnifiedUser u
+  (UnifiedOrg o) -> pure $ UnifiedOrg o
+  (UnifiedTeam t) -> UnifiedTeam <$> f t
+
+-- | Common type for displaying a user.
+data UserDisplayInfo = UserDisplayInfo
+  { handle :: UserHandle,
+    name :: Maybe Text,
+    avatarUrl :: Maybe URI,
+    userId :: UserId
+  }
+  deriving (Show, Eq, Ord)
+
+instance ToJSON UserDisplayInfo where
+  toJSON UserDisplayInfo {handle, name, avatarUrl, userId} =
+    Aeson.object
+      [ "handle" Aeson..= handle,
+        "name" Aeson..= name,
+        "avatarUrl" Aeson..= (URIParam <$> avatarUrl),
+        "userId" Aeson..= userId
+      ]
+
+instance FromJSON UserDisplayInfo where
+  parseJSON =
+    Aeson.withObject "UserDisplayInfo" $ \o -> do
+      handle <- o Aeson..: "handle"
+      name <- o Aeson..:? "name"
+      avatarUrl <- fmap unpackURI <$> o Aeson..:? "avatarUrl"
+      userId <- o Aeson..: "userId"
+      pure UserDisplayInfo {handle, name, avatarUrl, userId}
+
+-- | Common type for displaying an Org.
+data OrgDisplayInfo = OrgDisplayInfo
+  { user :: UserDisplayInfo,
+    orgId :: OrgId,
+    isCommercial :: Bool
+  }
+  deriving (Show, Eq, Ord)
+
+instance ToJSON OrgDisplayInfo where
+  toJSON OrgDisplayInfo {user, orgId, isCommercial} =
+    Aeson.object
+      [ "user" Aeson..= user,
+        "orgId" Aeson..= orgId,
+        "isCommercial" Aeson..= isCommercial
+      ]
+
+data TeamDisplayInfo = TeamDisplayInfo
+  { teamId :: TeamId,
+    name :: Text,
+    avatarUrl :: Maybe URI
+  }
+  deriving (Show, Eq, Ord)
+
+instance ToJSON TeamDisplayInfo where
+  toJSON TeamDisplayInfo {teamId, name, avatarUrl} =
+    Aeson.object
+      [ "teamId" Aeson..= teamId,
+        "name" Aeson..= name,
+        "avatarUrl" Aeson..= (URIParam <$> avatarUrl)
+      ]