Skip to content

Commit e91d882

Browse files
committed
Merge cp/org-emails
2 parents 5d585a1 + 4c98227 commit e91d882

18 files changed

Lines changed: 97 additions & 38 deletions

sql/2025-02-20_authz.sql

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -213,7 +213,6 @@ CREATE TRIGGER users_create_subject
213213

214214
CREATE TABLE orgs (
215215
id UUID DEFAULT uuid_generate_v4() PRIMARY KEY,
216-
-- There's no subject_id on the org, since the org is a user, and the user has a subject_id.
217216
user_id UUID UNIQUE NOT NULL REFERENCES users (id) ON DELETE CASCADE,
218217
-- Subject representing the org itself.
219218
-- Note that orgs also have a subject on their associated user, but since you can't log in as a subject that

sql/2025-05-01_org-updates.sql

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,27 @@
1+
ALTER TABLE users
2+
-- Add is_org column
3+
ADD COLUMN is_org boolean NOT NULL DEFAULT false,
4+
-- Add check that primary_email is not null unless is_org is true
5+
ADD CONSTRAINT primary_email_not_null_unless_org CHECK (
6+
is_org OR primary_email IS NOT NULL
7+
),
8+
-- Make primary_email nullable
9+
ALTER COLUMN primary_email DROP NOT NULL;
10+
11+
-- Update the is_org column for existing users
12+
WITH org_users(user_id) AS (
13+
SELECT DISTINCT o.user_id
14+
FROM orgs o
15+
) UPDATE users
16+
SET is_org = true
17+
WHERE id IN (SELECT ou.user_id FROM org_users ou);
18+
19+
-- Add a 'creator_user_id' to orgs just to track where they came from.
20+
-- This is distinct from the owners in the auth roles.
21+
ALTER TABLE orgs
22+
ADD COLUMN creator_user_id uuid NULL REFERENCES users (id) ON DELETE SET NULL
23+
;
24+
25+
ALTER TABLE orgs
26+
ADD COLUMN is_commercial boolean NOT NULL DEFAULT false
27+
;

src/Share/Postgres/Users/Queries.hs

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -198,7 +198,7 @@ userByHandle handle = do
198198
createFromGithubUser :: AuthZ.AuthZReceipt -> GithubUser -> GithubEmail -> UserHandle -> PG.Transaction UserCreationError User
199199
createFromGithubUser !authzReceipt (GithubUser _githubHandle githubUserId avatar_url user_name) primaryEmail userHandle = do
200200
let (GithubEmail {githubEmailEmail = user_email, githubEmailIsVerified = emailVerified}) = primaryEmail
201-
userId <- createUser authzReceipt user_email user_name (Just avatar_url) userHandle emailVerified
201+
userId <- createUser authzReceipt False (Just $ Email user_email) user_name (Just avatar_url) userHandle emailVerified
202202
PG.execute_
203203
[PG.sql|
204204
INSERT INTO github_users
@@ -214,15 +214,15 @@ createFromGithubUser !authzReceipt (GithubUser _githubHandle githubUserId avatar
214214
avatar_url = Just avatar_url,
215215
user_id = userId,
216216
user_name,
217-
user_email,
217+
user_email = Just $ Email user_email,
218218
visibility
219219
}
220220

221221
-- | Note: Since there's currently no way to choose a handle during user creation,
222222
-- manually creating users that aren't mapped to a github user WILL lock out any github
223223
-- user by that name from creating a share account. Use caution.
224-
createUser :: AuthZ.AuthZReceipt -> Text -> Maybe Text -> Maybe URIParam -> UserHandle -> Bool -> PG.Transaction UserCreationError UserId
225-
createUser !_authZReceipt userEmail userName avatarUrl userHandle emailVerified = do
224+
createUser :: AuthZ.AuthZReceipt -> Bool -> Maybe Email -> Maybe Text -> Maybe URIParam -> UserHandle -> Bool -> PG.Transaction UserCreationError UserId
225+
createUser !_authZReceipt isOrg userEmail userName avatarUrl userHandle emailVerified = do
226226
handleExists <-
227227
PG.queryExpect1Col
228228
[PG.sql|
@@ -238,8 +238,8 @@ createUser !_authZReceipt userEmail userName avatarUrl userHandle emailVerified
238238
PG.queryExpect1Col
239239
[PG.sql|
240240
INSERT INTO users
241-
(primary_email, email_verified, avatar_url, name, handle, private)
242-
VALUES (#{userEmail}, #{emailVerified}, #{avatarUrl}, #{userName}, #{userHandle}, #{private})
241+
(primary_email, email_verified, avatar_url, name, handle, private, is_org)
242+
VALUES (#{userEmail}, #{emailVerified}, #{avatarUrl}, #{userName}, #{userHandle}, #{private}, #{isOrg})
243243
RETURNING id
244244
|]
245245

src/Share/User.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@ instance Hasql.EncodeValue UserVisibility where
3131
data User = User
3232
{ user_id :: UserId,
3333
user_name :: Maybe Text,
34-
user_email :: Text,
34+
user_email :: Maybe Email,
3535
avatar_url :: Maybe URIParam,
3636
handle :: UserHandle,
3737
visibility :: UserVisibility

src/Share/Web/Share/DisplayInfo.hs

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -36,15 +36,17 @@ instance ToJSON UserDisplayInfo where
3636
-- | Common type for displaying an Org.
3737
data OrgDisplayInfo = OrgDisplayInfo
3838
{ user :: UserDisplayInfo,
39-
orgId :: OrgId
39+
orgId :: OrgId,
40+
isCommercial :: Bool
4041
}
4142
deriving (Show, Eq, Ord)
4243

4344
instance ToJSON OrgDisplayInfo where
44-
toJSON OrgDisplayInfo {user, orgId} =
45+
toJSON OrgDisplayInfo {user, orgId, isCommercial} =
4546
Aeson.object
4647
[ "user" Aeson..= user,
47-
"orgId" Aeson..= orgId
48+
"orgId" Aeson..= orgId,
49+
"isCommercial" Aeson..= isCommercial
4850
]
4951

5052
data TeamDisplayInfo = TeamDisplayInfo

src/Share/Web/Share/Impl.hs

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -367,12 +367,13 @@ searchEndpoint (MaybeAuthedUserID callerUserId) (Query query) (fromMaybe (Limit
367367
(users, projects) <- PG.runTransaction $ do
368368
users <- UserQ.searchUsersByNameOrHandlePrefix userQuery (Limit 5)
369369
projects <- Q.searchProjects callerUserId projectUserFilter projectQuery limit
370-
pure (users, projects)
370+
userResultsWithOrgInfo <- OrgQ.orgsByIdsOf (traversed . _2 . _Just) users
371+
pure (userResultsWithOrgInfo, projects)
371372
let userResults =
372373
users
373-
<&> \(User {user_name = name, avatar_url = avatarUrl, handle, user_id = userId}, mayOrgId) ->
374-
case mayOrgId of
375-
Just orgId -> SearchResultOrg (OrgDisplayInfo {user = UserDisplayInfo {handle, name, avatarUrl = unpackURI <$> avatarUrl, userId}, orgId})
374+
<&> \(User {user_name = name, avatar_url = avatarUrl, handle, user_id = userId}, mayOrgInfo) ->
375+
case mayOrgInfo of
376+
Just (Org {orgId, isCommercial}) -> SearchResultOrg (OrgDisplayInfo {user = UserDisplayInfo {handle, name, avatarUrl = unpackURI <$> avatarUrl, userId}, orgId, isCommercial})
376377
Nothing -> SearchResultUser (UserDisplayInfo {handle, name, avatarUrl = unpackURI <$> avatarUrl, userId})
377378
let projectResults =
378379
projects

src/Share/Web/Share/Orgs/Impl.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -59,10 +59,10 @@ server =
5959
in orgCreateEndpoint :<|> orgResourceServer
6060

6161
orgCreateEndpoint :: UserId -> CreateOrgRequest -> WebApp OrgDisplayInfo
62-
orgCreateEndpoint callerUserId (CreateOrgRequest {name, handle, avatarUrl, email, owner = ownerHandle}) = do
62+
orgCreateEndpoint callerUserId (CreateOrgRequest {name, handle, avatarUrl, email, owner = ownerHandle, isCommercial}) = do
6363
User {user_id = ownerUserId} <- PG.runTransaction (UserQ.userByHandle ownerHandle) `whenNothingM` respondError (EntityMissing (ErrorID "missing-user") "Owner not found")
6464
authZReceipt <- AuthZ.permissionGuard $ AuthZ.checkCreateOrg callerUserId ownerUserId
65-
orgId <- PG.runTransactionOrRespondError $ OrgOps.createOrg authZReceipt name handle email avatarUrl ownerUserId
65+
orgId <- PG.runTransactionOrRespondError $ OrgOps.createOrg authZReceipt name handle email avatarUrl ownerUserId callerUserId isCommercial
6666
PG.runTransaction $ OrgQ.orgDisplayInfoOf id orgId
6767

6868
rolesServer :: UserHandle -> API.OrgRolesRoutes (AsServerT WebApp)

src/Share/Web/Share/Orgs/Operations.hs

Lines changed: 7 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ module Share.Web.Share.Orgs.Operations
44
where
55

66
import Data.Set qualified as Set
7-
import Share.IDs (OrgHandle (..), OrgId, UserHandle (..), UserId)
7+
import Share.IDs (Email, OrgHandle (..), OrgId, UserHandle (..), UserId)
88
import Share.Postgres
99
import Share.Postgres.Users.Queries (UserCreationError)
1010
import Share.Postgres.Users.Queries qualified as UserQ
@@ -14,14 +14,16 @@ import Share.Web.Authorization.Types qualified as AuthZ
1414
import Share.Web.Share.Orgs.Queries qualified as OrgQ
1515
import Share.Web.Share.Roles.Queries qualified as RoleQ
1616

17-
createOrg :: AuthZ.AuthZReceipt -> Text -> OrgHandle -> Text -> Maybe URIParam -> UserId -> Transaction UserCreationError OrgId
18-
createOrg !authZReceipt name (OrgHandle handle) email avatarUrl owner = do
17+
createOrg :: AuthZ.AuthZReceipt -> Text -> OrgHandle -> Maybe Email -> Maybe URIParam -> UserId -> UserId -> Bool -> Transaction UserCreationError OrgId
18+
createOrg !authZReceipt name (OrgHandle handle) email avatarUrl owner creator isCommercial = do
1919
let emailVerified = False
20-
orgUserId <- UserQ.createUser authZReceipt email (Just name) avatarUrl (UserHandle handle) emailVerified
20+
let isOrg = True
21+
orgUserId <- UserQ.createUser authZReceipt isOrg email (Just name) avatarUrl (UserHandle handle) emailVerified
2122
(orgId, orgResourceId) <-
2223
queryExpect1Row
2324
[sql|
24-
INSERT INTO orgs (user_id) VALUES (#{orgUserId})
25+
INSERT INTO orgs (user_id, creator_user_id, is_commercial)
26+
VALUES (#{orgUserId}, #{creator}, #{isCommercial})
2527
RETURNING id, resource_id
2628
|]
2729
RoleQ.assignUserRoleMembership authZReceipt owner orgResourceId AuthZ.RoleOrgOwner

src/Share/Web/Share/Orgs/Queries.hs

Lines changed: 22 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@
33
module Share.Web.Share.Orgs.Queries
44
( orgByUserId,
55
orgByUserHandle,
6+
orgsByIdsOf,
67
listOrgRoles,
78
addOrgRoles,
89
removeOrgRoles,
@@ -23,33 +24,50 @@ import Share.Prelude
2324
import Share.Utils.URI
2425
import Share.Web.Authorization.Types
2526
import Share.Web.Share.DisplayInfo (OrgDisplayInfo (..), UserDisplayInfo (..))
26-
import Share.Web.Share.Orgs.Types (Org)
27+
import Share.Web.Share.Orgs.Types (Org (..))
2728

2829
orgByUserId :: UserId -> Transaction e (Maybe Org)
2930
orgByUserId orgUserId = do
3031
query1Row
3132
[sql|
32-
SELECT org.id FROM orgs org
33+
SELECT org.id, org.is_commercial
34+
FROM orgs org
3335
WHERE org.user_id = #{orgUserId}
3436
|]
3537

3638
orgByUserHandle :: UserHandle -> Transaction e (Maybe Org)
3739
orgByUserHandle orgHandle = do
3840
query1Row
3941
[sql|
40-
SELECT org.id
42+
SELECT org.id, org.is_commercial
4143
FROM orgs org
4244
JOIN users u ON org.user_id = u.id
4345
WHERE u.handle = #{orgHandle}
4446
|]
4547

48+
orgsByIdsOf :: (QueryA m) => Traversal s t OrgId Org -> s -> m t
49+
orgsByIdsOf trav s = do
50+
s
51+
& unsafePartsOf trav %%~ \orgIds -> do
52+
let orgTable = zip [0 :: Int32 ..] orgIds
53+
queryListRows
54+
[sql|
55+
WITH values(ord, org_id) AS (
56+
SELECT * FROM ^{toTable orgTable} AS t(ord, org_id)
57+
) SELECT org.id, org.is_commercial
58+
FROM values
59+
JOIN orgs org ON org.id = values.org_id
60+
ORDER BY values.ord
61+
|]
62+
4663
-- | Efficiently resolve Org Display Info for OrgIds within a structure.
4764
orgDisplayInfoOf :: (QueryA m) => Traversal s t OrgId OrgDisplayInfo -> s -> m t
4865
orgDisplayInfoOf trav s = do
4966
s
5067
& unsafePartsOf trav %%~ \orgIds -> do
5168
userDisplayInfos <- userDisplayInfoByOrgIdOf traversed orgIds
52-
pure $ zipWith (\orgId userDisplayInfo -> OrgDisplayInfo {orgId, user = userDisplayInfo}) orgIds userDisplayInfos
69+
orgs <- orgsByIdsOf traversed orgIds
70+
pure $ zipWith (\(Org {orgId, isCommercial}) userDisplayInfo -> OrgDisplayInfo {orgId, user = userDisplayInfo, isCommercial}) orgs userDisplayInfos
5371

5472
userDisplayInfoByOrgIdOf :: (QueryA m) => Traversal s t OrgId UserDisplayInfo -> s -> m t
5573
userDisplayInfoByOrgIdOf trav s = do

src/Share/Web/Share/Orgs/Types.hs

Lines changed: 10 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -16,18 +16,22 @@ import Share.Postgres (DecodeRow (..), decodeField)
1616
import Share.Utils.URI (URIParam)
1717
import Share.Web.Share.DisplayInfo (UserDisplayInfo)
1818

19-
newtype Org = Org {orgId :: OrgId}
20-
deriving (Show, Eq)
19+
data Org = Org {orgId :: OrgId, isCommercial :: Bool}
20+
deriving (Show, Eq, Ord)
2121

2222
instance DecodeRow Org where
23-
decodeRow = Org <$> decodeField
23+
decodeRow = do
24+
orgId <- decodeField
25+
isCommercial <- decodeField
26+
pure Org {..}
2427

2528
data CreateOrgRequest = CreateOrgRequest
2629
{ name :: Text,
2730
handle :: OrgHandle,
2831
avatarUrl :: Maybe URIParam,
2932
owner :: UserHandle,
30-
email :: Text
33+
email :: Maybe Email,
34+
isCommercial :: Bool
3135
}
3236
deriving (Show, Eq)
3337

@@ -37,7 +41,8 @@ instance FromJSON CreateOrgRequest where
3741
handle <- o .: "handle"
3842
avatarUrl <- o .:? "avatarUrl"
3943
owner <- o .: "owner"
40-
email <- o .: "email"
44+
email <- o .:? "email"
45+
isCommercial <- o .: "isCommercial"
4146
pure CreateOrgRequest {..}
4247

4348
data OrgMembersAddRequest = OrgMembersAddRequest

0 commit comments

Comments
 (0)