Allow null emails on orgs.

sql/2025-02-20_authz.sql

@@ -213,7 +213,6 @@ CREATE TRIGGER users_create_subject
 
 CREATE TABLE orgs (
   id UUID DEFAULT uuid_generate_v4() PRIMARY KEY,
-  -- There's no subject_id on the org, since the org is a user, and the user has a subject_id.
   user_id UUID UNIQUE NOT NULL REFERENCES users (id) ON DELETE CASCADE,
   -- Subject representing the org itself.
   -- 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

@@ -0,0 +1,27 @@
+ALTER TABLE users
+  -- Add is_org column
+  ADD COLUMN is_org boolean NOT NULL DEFAULT false,
+  -- Add check that primary_email is not null unless is_org is true
+  ADD CONSTRAINT primary_email_not_null_unless_org CHECK (
+    is_org OR primary_email IS NOT NULL
+  ),
+  -- Make primary_email nullable
+  ALTER COLUMN primary_email DROP NOT NULL;
+
+-- Update the is_org column for existing users
+WITH org_users(user_id) AS (
+  SELECT DISTINCT o.user_id
+  FROM orgs o
+) UPDATE users
+  SET is_org = true
+  WHERE id IN (SELECT ou.user_id FROM org_users ou);
+
+-- Add a 'creator_user_id' to orgs just to track where they came from.
+-- This is distinct from the owners in the auth roles.
+ALTER TABLE orgs
+  ADD COLUMN creator_user_id uuid NULL REFERENCES users (id) ON DELETE SET NULL
+;
+
+ALTER TABLE orgs
+  ADD COLUMN is_commercial boolean NOT NULL DEFAULT false
+;

src/Share/Postgres/Users/Queries.hs

@@ -203,7 +203,7 @@ createFromGithubUser !authzReceipt (GithubUser githubHandle githubUserId avatar_
     Nothing -> case IDs.fromText @UserHandle (Text.toLower githubHandle) of
       Left err -> throwError (InvalidUserHandle err githubHandle)
       Right handle -> pure handle
-  userId <- createUser authzReceipt user_email user_name (Just avatar_url) userHandle emailVerified
+  userId <- createUser authzReceipt False (Just $ Email user_email) user_name (Just avatar_url) userHandle emailVerified
   PG.execute_
     [PG.sql|
           INSERT INTO github_users
@@ -219,15 +219,15 @@ createFromGithubUser !authzReceipt (GithubUser githubHandle githubUserId avatar_
         avatar_url = Just avatar_url,
         user_id = userId,
         user_name,
-        user_email,
+        user_email = Just $ Email user_email,
         visibility
       }
 
 -- | Note: Since there's currently no way to choose a handle during user creation,
 -- manually creating users that aren't mapped to a github user WILL lock out any github
 -- user by that name from creating a share account. Use caution.
-createUser :: AuthZ.AuthZReceipt -> Text -> Maybe Text -> Maybe URIParam -> UserHandle -> Bool -> PG.Transaction UserCreationError UserId
-createUser !_authZReceipt userEmail userName avatarUrl userHandle emailVerified = do
+createUser :: AuthZ.AuthZReceipt -> Bool -> Maybe Email -> Maybe Text -> Maybe URIParam -> UserHandle -> Bool -> PG.Transaction UserCreationError UserId
+createUser !_authZReceipt isOrg userEmail userName avatarUrl userHandle emailVerified = do
   handleExists <-
     PG.queryExpect1Col
       [PG.sql|
@@ -243,8 +243,8 @@ createUser !_authZReceipt userEmail userName avatarUrl userHandle emailVerified
       PG.queryExpect1Col
         [PG.sql|
               INSERT INTO users
-                (primary_email, email_verified, avatar_url, name, handle, private)
-                VALUES (#{userEmail}, #{emailVerified}, #{avatarUrl}, #{userName}, #{userHandle}, #{private})
+                (primary_email, email_verified, avatar_url, name, handle, private, is_org)
+                VALUES (#{userEmail}, #{emailVerified}, #{avatarUrl}, #{userName}, #{userHandle}, #{private}, #{isOrg})
               RETURNING id
             |]
 

src/Share/User.hs

@@ -31,7 +31,7 @@ instance Hasql.EncodeValue UserVisibility where
 data User = User
   { user_id :: UserId,
     user_name :: Maybe Text,
-    user_email :: Text,
+    user_email :: Maybe Email,
     avatar_url :: Maybe URIParam,
     handle :: UserHandle,
     visibility :: UserVisibility

src/Share/Web/Share/DisplayInfo.hs

@@ -36,15 +36,17 @@ instance ToJSON UserDisplayInfo where
 -- | Common type for displaying an Org.
 data OrgDisplayInfo = OrgDisplayInfo
   { user :: UserDisplayInfo,
-    orgId :: OrgId
+    orgId :: OrgId,
+    isCommercial :: Bool
   }
   deriving (Show, Eq, Ord)
 
 instance ToJSON OrgDisplayInfo where
-  toJSON OrgDisplayInfo {user, orgId} =
+  toJSON OrgDisplayInfo {user, orgId, isCommercial} =
     Aeson.object
       [ "user" Aeson..= user,
-        "orgId" Aeson..= orgId
+        "orgId" Aeson..= orgId,
+        "isCommercial" Aeson..= isCommercial
       ]
 
 data TeamDisplayInfo = TeamDisplayInfo

src/Share/Web/Share/Impl.hs

@@ -367,12 +367,13 @@ searchEndpoint (MaybeAuthedUserID callerUserId) (Query query) (fromMaybe (Limit
   (users, projects) <- PG.runTransaction $ do
     users <- UserQ.searchUsersByNameOrHandlePrefix userQuery (Limit 5)
     projects <- Q.searchProjects callerUserId projectUserFilter projectQuery limit
-    pure (users, projects)
+    userResultsWithOrgInfo <- OrgQ.orgsByIdsOf (traversed . _2 . _Just) users
+    pure (userResultsWithOrgInfo, projects)
   let userResults =
         users
-          <&> \(User {user_name = name, avatar_url = avatarUrl, handle, user_id = userId}, mayOrgId) ->
-            case mayOrgId of
-              Just orgId -> SearchResultOrg (OrgDisplayInfo {user = UserDisplayInfo {handle, name, avatarUrl = unpackURI <$> avatarUrl, userId}, orgId})
+          <&> \(User {user_name = name, avatar_url = avatarUrl, handle, user_id = userId}, mayOrgInfo) ->
+            case mayOrgInfo of
+              Just (Org {orgId, isCommercial}) -> SearchResultOrg (OrgDisplayInfo {user = UserDisplayInfo {handle, name, avatarUrl = unpackURI <$> avatarUrl, userId}, orgId, isCommercial})
               Nothing -> SearchResultUser (UserDisplayInfo {handle, name, avatarUrl = unpackURI <$> avatarUrl, userId})
   let projectResults =
         projects

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

@@ -59,10 +59,10 @@ server =
    in orgCreateEndpoint :<|> orgResourceServer
 
 orgCreateEndpoint :: UserId -> CreateOrgRequest -> WebApp OrgDisplayInfo
-orgCreateEndpoint callerUserId (CreateOrgRequest {name, handle, avatarUrl, email, owner = ownerHandle}) = do
+orgCreateEndpoint callerUserId (CreateOrgRequest {name, handle, avatarUrl, email, owner = ownerHandle, isCommercial}) = do
   User {user_id = ownerUserId} <- PG.runTransaction (UserQ.userByHandle ownerHandle) `whenNothingM` respondError (EntityMissing (ErrorID "missing-user") "Owner not found")
   authZReceipt <- AuthZ.permissionGuard $ AuthZ.checkCreateOrg callerUserId ownerUserId
-  orgId <- PG.runTransactionOrRespondError $ OrgOps.createOrg authZReceipt name handle email avatarUrl ownerUserId
+  orgId <- PG.runTransactionOrRespondError $ OrgOps.createOrg authZReceipt name handle email avatarUrl ownerUserId callerUserId isCommercial
   PG.runTransaction $ OrgQ.orgDisplayInfoOf id orgId
 
 rolesServer :: UserHandle -> API.OrgRolesRoutes (AsServerT WebApp)

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

@@ -4,7 +4,7 @@ module Share.Web.Share.Orgs.Operations
 where
 
 import Data.Set qualified as Set
-import Share.IDs (OrgHandle (..), OrgId, UserHandle (..), UserId)
+import Share.IDs (Email, OrgHandle (..), OrgId, UserHandle (..), UserId)
 import Share.Postgres
 import Share.Postgres.Users.Queries (UserCreationError)
 import Share.Postgres.Users.Queries qualified as UserQ
@@ -14,14 +14,16 @@ import Share.Web.Authorization.Types qualified as AuthZ
 import Share.Web.Share.Orgs.Queries qualified as OrgQ
 import Share.Web.Share.Roles.Queries qualified as RoleQ
 
-createOrg :: AuthZ.AuthZReceipt -> Text -> OrgHandle -> Text -> Maybe URIParam -> UserId -> Transaction UserCreationError OrgId
-createOrg !authZReceipt name (OrgHandle handle) email avatarUrl owner = do
+createOrg :: AuthZ.AuthZReceipt -> Text -> OrgHandle -> Maybe Email -> Maybe URIParam -> UserId -> UserId -> Bool -> Transaction UserCreationError OrgId
+createOrg !authZReceipt name (OrgHandle handle) email avatarUrl owner creator isCommercial = do
   let emailVerified = False
-  orgUserId <- UserQ.createUser authZReceipt email (Just name) avatarUrl (UserHandle handle) emailVerified
+  let isOrg = True
+  orgUserId <- UserQ.createUser authZReceipt isOrg email (Just name) avatarUrl (UserHandle handle) emailVerified
   (orgId, orgResourceId) <-
     queryExpect1Row
       [sql|
-    INSERT INTO orgs (user_id) VALUES (#{orgUserId})
+    INSERT INTO orgs (user_id, creator_user_id, is_commercial)
+      VALUES (#{orgUserId}, #{creator}, #{isCommercial})
       RETURNING id, resource_id
     |]
   RoleQ.assignUserRoleMembership authZReceipt owner orgResourceId AuthZ.RoleOrgOwner

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

@@ -3,6 +3,7 @@
 module Share.Web.Share.Orgs.Queries
   ( orgByUserId,
     orgByUserHandle,
+    orgsByIdsOf,
     listOrgRoles,
     addOrgRoles,
     removeOrgRoles,
@@ -23,33 +24,50 @@ import Share.Prelude
 import Share.Utils.URI
 import Share.Web.Authorization.Types
 import Share.Web.Share.DisplayInfo (OrgDisplayInfo (..), UserDisplayInfo (..))
-import Share.Web.Share.Orgs.Types (Org)
+import Share.Web.Share.Orgs.Types (Org (..))
 
 orgByUserId :: UserId -> Transaction e (Maybe Org)
 orgByUserId orgUserId = do
   query1Row
     [sql|
-      SELECT org.id FROM orgs org
+      SELECT org.id, org.is_commercial
+      FROM orgs org
       WHERE org.user_id = #{orgUserId}
     |]
 
 orgByUserHandle :: UserHandle -> Transaction e (Maybe Org)
 orgByUserHandle orgHandle = do
   query1Row
     [sql|
-      SELECT org.id
+      SELECT org.id, org.is_commercial
         FROM orgs org
         JOIN users u ON org.user_id = u.id
       WHERE u.handle = #{orgHandle}
     |]
 
+orgsByIdsOf :: (QueryA m) => Traversal s t OrgId Org -> s -> m t
+orgsByIdsOf trav s = do
+  s
+    & unsafePartsOf trav %%~ \orgIds -> do
+      let orgTable = zip [0 :: Int32 ..] orgIds
+      queryListRows
+        [sql|
+          WITH values(ord, org_id)  AS (
+            SELECT * FROM ^{toTable orgTable} AS t(ord, org_id)
+          ) SELECT org.id, org.is_commercial
+            FROM values
+            JOIN orgs org ON org.id = values.org_id
+          ORDER BY values.ord
+        |]
+
 -- | Efficiently resolve Org Display Info for OrgIds within a structure.
 orgDisplayInfoOf :: (QueryA m) => Traversal s t OrgId OrgDisplayInfo -> s -> m t
 orgDisplayInfoOf trav s = do
   s
     & unsafePartsOf trav %%~ \orgIds -> do
       userDisplayInfos <- userDisplayInfoByOrgIdOf traversed orgIds
-      pure $ zipWith (\orgId userDisplayInfo -> OrgDisplayInfo {orgId, user = userDisplayInfo}) orgIds userDisplayInfos
+      orgs <- orgsByIdsOf traversed orgIds
+      pure $ zipWith (\(Org {orgId, isCommercial}) userDisplayInfo -> OrgDisplayInfo {orgId, user = userDisplayInfo, isCommercial}) orgs userDisplayInfos
 
 userDisplayInfoByOrgIdOf :: (QueryA m) => Traversal s t OrgId UserDisplayInfo -> s -> m t
 userDisplayInfoByOrgIdOf trav s = do

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

@@ -16,18 +16,22 @@ import Share.Postgres (DecodeRow (..), decodeField)
 import Share.Utils.URI (URIParam)
 import Share.Web.Share.DisplayInfo (UserDisplayInfo)
 
-newtype Org = Org {orgId :: OrgId}
-  deriving (Show, Eq)
+data Org = Org {orgId :: OrgId, isCommercial :: Bool}
+  deriving (Show, Eq, Ord)
 
 instance DecodeRow Org where
-  decodeRow = Org <$> decodeField
+  decodeRow = do
+    orgId <- decodeField
+    isCommercial <- decodeField
+    pure Org {..}
 
 data CreateOrgRequest = CreateOrgRequest
   { name :: Text,
     handle :: OrgHandle,
     avatarUrl :: Maybe URIParam,
     owner :: UserHandle,
-    email :: Text
+    email :: Maybe Email,
+    isCommercial :: Bool
   }
   deriving (Show, Eq)
 
@@ -37,7 +41,8 @@ instance FromJSON CreateOrgRequest where
     handle <- o .: "handle"
     avatarUrl <- o .:? "avatarUrl"
     owner <- o .: "owner"
-    email <- o .: "email"
+    email <- o .:? "email"
+    isCommercial <- o .: "isCommercial"
     pure CreateOrgRequest {..}
 
 data OrgMembersAddRequest = OrgMembersAddRequest

src/Share/Web/Share/Types.hs

@@ -140,7 +140,7 @@ data UserAccountInfo = UserAccountInfo
     name :: Maybe Text,
     avatarUrl :: Maybe URIParam,
     userId :: UserId,
-    primaryEmail :: Text,
+    primaryEmail :: Maybe Email,
     -- List of tours which the user has completed.
     completedTours :: [TourId],
     organizationMemberships :: [UserHandle],

src/Share/Web/Support/Zendesk.hs

@@ -9,14 +9,14 @@ module Share.Web.Support.Zendesk where
 import Control.Monad.Reader
 import Data.Aeson
 import Data.Either (fromRight)
+import Servant
+import Servant.Client
 import Share.Env qualified as Env
 import Share.IDs
 import Share.Prelude
 import Share.Utils.Servant.Client (runClient)
 import Share.Web.App
 import Share.Web.Support.Types
-import Servant
-import Servant.Client
 
 -- | Field Id for the Share Handle custom ticket field. See https://unison-computing.zendesk.com/admin/objects-rules/tickets/ticket-fields
 zendeskShareHandleFieldId :: Int
@@ -42,7 +42,7 @@ data ZendeskTicket = ZendeskTicket
     body :: Text,
     priority :: Priority,
     requesterName :: Text,
-    requesterEmail :: Text,
+    requesterEmail :: Maybe Email,
     shareHandle :: UserHandle,
     shareUserId :: UserId
   }

src/Share/Web/Types.hs

@@ -41,7 +41,7 @@ data UserInfo = UserInfo
     name :: Maybe Text,
     picture :: Maybe URIParam,
     profile :: URIParam, -- Link to the user's profile page
-    email :: Text,
+    email :: Maybe Email,
     -- Additional claims
     handle :: UserHandle
   }

transcripts/share-apis/orgs/org-create-by-admin.json

@@ -1,5 +1,6 @@
 {
   "body": {
+    "isCommercial": true,
     "orgId": "ORG-<UUID>",
     "user": {
       "avatarUrl": "https://example.com/anvil.png",

transcripts/share-apis/orgs/run.zsh

@@ -15,7 +15,8 @@ fetch "$unauthorized_user" POST org-create-unauthorized '/orgs' '{
   "handle": "acme",
   "avatarUrl": "https://example.com/anvil.png",
   "owner": "unauthorized",
-  "email": "wile.e.coyote@example.com"
+  "email": "wile.e.coyote@example.com",
+  "isCommercial": false
 }'
 
 # Admin can create an org and assign any owner.
@@ -24,7 +25,7 @@ fetch "$admin_user" POST org-create-by-admin '/orgs' '{
   "handle": "acme",
   "avatarUrl": "https://example.com/anvil.png",
   "owner": "transcripts",
-  "email": "wile.e.coyote@example.com"
+  "isCommercial": true
 }'
 
 

transcripts/share-apis/roles/grant-project-contributor.json

@@ -36,6 +36,7 @@
         ],
         "subject": {
           "data": {
+            "isCommercial": false,
             "orgId": "ORG-<UUID>",
             "user": {
               "avatarUrl": "https://www.gravatar.com/avatar/205e460b479e2e5b48aec07710c08d50?f=y&d=retro",

transcripts/share-apis/roles/org-roles-list.json

@@ -22,6 +22,7 @@
         ],
         "subject": {
           "data": {
+            "isCommercial": false,
             "orgId": "ORG-<UUID>",
             "user": {
               "avatarUrl": "https://www.gravatar.com/avatar/205e460b479e2e5b48aec07710c08d50?f=y&d=retro",

transcripts/share-apis/roles/revoke-project-contributor.json

@@ -22,6 +22,7 @@
         ],
         "subject": {
           "data": {
+            "isCommercial": false,
             "orgId": "ORG-<UUID>",
             "user": {
               "avatarUrl": "https://www.gravatar.com/avatar/205e460b479e2e5b48aec07710c08d50?f=y&d=retro",