Allow displaying emails of users

libs/brig-types/src/Brig/Types/Swagger.hs

@@ -141,6 +141,9 @@ user = defineModel "User" $ do
         description "User ID"
     property "name" string' $
         description "Name"
+    property "email" string' $ do
+        description "Email"
+        optional
     property "assets" (array (ref asset)) $
         description "Profile assets"
     property "accent_id" int32' $ do

libs/brig-types/src/Brig/Types/User.hs

@@ -103,12 +103,41 @@ connectedProfile u = UserProfile
     , profileDeleted  = userDeleted u
     , profileExpire   = userExpire u
     , profileTeam     = userTeam u
+    -- We don't want to show the email by default;
+    -- However we do allow adding it back in intentionally later.
+    , profileEmail    = Nothing
     }
 
 publicProfile :: User -> UserProfile
-publicProfile u = (connectedProfile u)
-    { profileLocale = Nothing
-    }
+publicProfile u =
+    -- Note that we explicitly unpack and repack the types here rather than using
+    -- RecordWildCards or something similar because we want changes to the public profile
+    -- to be EXPLICIT and INTENTIONAL so we don't accidentally leak sensitive data.
+    let UserProfile { profileId
+                    , profileHandle
+                    , profileName
+                    , profilePict
+                    , profileAssets
+                    , profileAccentId
+                    , profileService
+                    , profileDeleted
+                    , profileExpire
+                    , profileTeam
+                    } = connectedProfile u
+    in UserProfile
+       { profileLocale   = Nothing
+       , profileEmail    = Nothing
+       , profileId
+       , profileHandle
+       , profileName
+       , profilePict
+       , profileAssets
+       , profileAccentId
+       , profileService
+       , profileDeleted
+       , profileExpire
+       , profileTeam
+       }
 
 -- | The data of an existing user.
 data User = User
@@ -134,6 +163,31 @@ data User = User
     }
     deriving (Eq, Show)
 
+
+-- | Configurations for whether to show a user's email to others.
+data EmailVisibility
+    = EmailVisibleIfOnTeam
+    {- ^ Anyone on a team can see the email of anyone else who is on a team.
+         Regardless of if they're on the SAME team.
+         This may sound strange; but certain on-premise hosters have many different teams
+         and still want them to see each-other's emails.
+    -}
+    | EmailVisibleToSelf
+    -- ^ Never show emails to anyone other than yourself
+    deriving (Eq, Show)
+
+instance FromJSON EmailVisibility where
+    parseJSON = withText "EmailVisibility" $ \case
+        "visible_if_on_team" -> pure EmailVisibleIfOnTeam
+        "visible_to_self"      -> pure EmailVisibleToSelf
+        _ -> fail
+            $  "unexpected value for EmailVisibility settings: "
+            <> "expected one of [visible_if_on_team, visible_to_same_team, visible_to_self]"
+
+instance ToJSON EmailVisibility where
+    toJSON EmailVisibleIfOnTeam = "visible_if_on_team"
+    toJSON EmailVisibleToSelf     = "visible_to_self"
+
 userEmail :: User -> Maybe Email
 userEmail = emailIdentity <=< userIdentity
 
@@ -160,6 +214,7 @@ data UserProfile = UserProfile
     , profileLocale   :: !(Maybe Locale)
     , profileExpire   :: !(Maybe UTCTimeMillis)
     , profileTeam     :: !(Maybe TeamId)
+    , profileEmail    :: !(Maybe Email)
     }
     deriving (Eq, Show)
 
@@ -213,6 +268,7 @@ instance FromJSON UserProfile where
                     <*> o .:? "locale"
                     <*> o .:? "expires_at"
                     <*> o .:? "team"
+                    <*> o .:? "email"
 
 instance ToJSON UserProfile where
     toJSON u = object
@@ -227,6 +283,7 @@ instance ToJSON UserProfile where
         # "locale"     .= profileLocale u
         # "expires_at" .= profileExpire u
         # "team"       .= profileTeam u
+        # "email"      .= profileEmail u
         # []
 
 instance FromJSON SelfProfile where

services/brig/brig.integration.yaml

@@ -141,6 +141,8 @@ optSettings:
   setDefaultLocale: en
   setMaxTeamSize: 32
   setMaxConvSize: 16
+optMutableSettings:
+  setEmailVisibility: visible_to_self
 
 logLevel: Warn
 logNetStrings: false

services/brig/package.yaml

@@ -12,6 +12,7 @@ ghc-options:
 - -funbox-strict-fields
 dependencies:
 - aeson >=0.11
+- barbies
 - base ==4.*
 - base64-bytestring >=1.0
 - bloodhound >=0.13

services/brig/src/Brig/API.hs

@@ -38,6 +38,7 @@ import qualified Brig.API.Client               as API
 import qualified Brig.API.Connection           as API
 import qualified Brig.API.Properties           as API
 import qualified Brig.API.User                 as API
+import qualified Brig.API.Settings             as API
 import qualified Brig.Data.User                as Data
 import qualified Brig.Team.Util                as Team
 import qualified Brig.User.API.Auth            as Auth
@@ -73,6 +74,12 @@ sitemap o = do
     get "/i/monitoring" (continue $ const $ view metrics >>= fmap json . render) $
         accept "application" "json"
 
+    get "/i/settings" (continue $ API.getSettings) $
+        accept "application" "json"
+
+    put "/i/settings" (continue $ API.putSettings) $
+         jsonRequest @(MutableSettings' Maybe)
+
     post "/i/users/:id/auto-connect" (continue autoConnect) $
         accept "application" "json"
         .&. capture "id"

services/brig/src/Brig/API/Settings.hs

@@ -0,0 +1,38 @@
+module Brig.API.Settings
+    ( putSettings
+    , getSettings
+    ) where
+
+import Imports
+
+import           Brig.API.Handler          (Handler, JSON)
+import           Brig.App                  (mutableSettings)
+import           Brig.Options              (MutableSettings, MutableSettings')
+import           Control.Lens
+import           Data.Barbie               (bzipWith)
+import           Network.HTTP.Types.Status (status200)
+import           Network.Wai               (Response)
+import           Network.Wai.Utilities     (JsonRequest, empty, json, parseBody', setStatus)
+
+-- | Update the provided settings accordingly
+putSettings :: JsonRequest (MutableSettings' Maybe) -> Handler Response
+putSettings body = do
+    newSettings <- parseBody' body
+    mSettingsVar <- view mutableSettings
+    atomically $ do
+        mSettings <- readTVar mSettingsVar
+        let mergedSettings :: MutableSettings
+            mergedSettings = bzipWith fromMaybe' mSettings newSettings
+        writeTVar mSettingsVar mergedSettings
+    return $ (setStatus status200 empty)
+  where
+    fromMaybe' :: Identity a -> Maybe a -> Identity a
+    fromMaybe' a ma = maybe a Identity ma
+
+
+-- | Update the provided settings accordingly
+getSettings :: JSON -> Handler Response
+getSettings _ = do
+    mSet <- view mutableSettings >>= readTVarIO
+    return . setStatus status200
+           $ json mSet

services/brig/src/Brig/API/User.hs

@@ -837,14 +837,29 @@ lookupProfiles :: UserId   -- ^ User 'A' on whose behalf the profiles are reques
 lookupProfiles self others = do
     users <- Data.lookupUsers others >>= mapM userGC
     css   <- toMap <$> Data.lookupConnectionStatus (map userId users) [self]
-    return $ map (toProfile css) users
+    Identity emailVisibility <- view mutableSettings >>= readTVarIO >>= pure . setEmailVisibility
+    return $ map (toProfile emailVisibility css) users
   where
+    toMap :: [ConnectionStatus] -> Map UserId Relation
     toMap = Map.fromList . map (csFrom &&& csStatus)
-    toProfile css u =
+    toProfile :: EmailVisibility -> Map UserId Relation -> User -> UserProfile
+    toProfile emailVisibility css u =
         let cs = Map.lookup (userId u) css
-        in if userId u == self || cs == Just Accepted || cs == Just Sent
-            then connectedProfile u
-            else publicProfile u
+            profileEmail' = getEmailForProfile u emailVisibility
+            baseProfile = if userId u == self || cs == Just Accepted || cs == Just Sent
+                            then connectedProfile u
+                            else publicProfile u
+         in baseProfile{ profileEmail = profileEmail'}
+
+-- | Gets the email if it's visible to the requester according to configured settings
+getEmailForProfile :: User -- ^ The user who's profile is being requested
+                   -> EmailVisibility
+                   -> Maybe Email
+getEmailForProfile _ EmailVisibleToSelf = Nothing
+getEmailForProfile u EmailVisibleIfOnTeam =
+    if isJust (userTeam u)
+        then userEmail u
+        else Nothing
 
 -- | Obtain a profile for a user as he can see himself.
 lookupSelfProfile :: UserId -> AppIO (Maybe SelfProfile)

services/brig/src/Brig/App.hs

@@ -24,6 +24,7 @@ module Brig.App
     , nexmoCreds
     , twilioCreds
     , settings
+    , mutableSettings
     , currentTime
     , geoDb
     , zauthEnv
@@ -134,6 +135,7 @@ data Env = Env
     , _httpManager   :: Manager
     , _extGetManager :: (Manager, [Fingerprint Rsa] -> SSL.SSL -> IO ())
     , _settings      :: Settings
+    , _mutableSettings :: TVar Opt.MutableSettings
     , _nexmoCreds    :: Nexmo.Credentials
     , _twilioCreds   :: Twilio.Credentials
     , _geoDb         :: Maybe (IORef GeoIp.GeoDB)
@@ -172,6 +174,7 @@ newEnv o = do
     g   <- geoSetup lgr w $ Opt.geoDb o
     (turn, turnV2) <- turnSetup lgr w sha512 (Opt.turn o)
     let sett = Opt.optSettings o
+    mSett <- newTVarIO $ Opt.optMutableSettings o
     nxm <- initCredentials (Opt.setNexmo sett)
     twl <- initCredentials (Opt.setTwilio sett)
     stomp <- case (Opt.stomp o, Opt.setStomp sett) of
@@ -185,35 +188,36 @@ newEnv o = do
         StompQueue q -> pure (StompQueue q)
         SqsQueue q -> SqsQueue <$> AWS.getQueueUrl (aws ^. AWS.amazonkaEnv) q
     return $! Env
-        { _cargohold     = mkEndpoint $ Opt.cargohold o
-        , _galley        = mkEndpoint $ Opt.galley o
-        , _gundeck       = mkEndpoint $ Opt.gundeck o
-        , _casClient     = cas
-        , _smtpEnv       = emailSMTP
-        , _awsEnv        = aws
-        , _stompEnv      = stomp
-        , _metrics       = mtr
-        , _applog        = lgr
-        , _internalEvents = eventsQueue
-        , _requestId     = def
-        , _usrTemplates  = utp
-        , _provTemplates = ptp
-        , _tmTemplates   = ttp
-        , _templateBranding = branding
-        , _httpManager   = mgr
-        , _extGetManager = ext
-        , _settings      = sett
-        , _nexmoCreds    = nxm
-        , _twilioCreds   = twl
-        , _geoDb         = g
-        , _turnEnv       = turn
-        , _turnEnvV2     = turnV2
-        , _fsWatcher     = w
-        , _currentTime   = clock
-        , _zauthEnv      = zau
-        , _digestMD5     = md5
-        , _digestSHA256  = sha256
-        , _indexEnv      = mkIndexEnv o lgr mgr mtr
+        { _cargohold         = mkEndpoint $ Opt.cargohold o
+        , _galley            = mkEndpoint $ Opt.galley o
+        , _gundeck           = mkEndpoint $ Opt.gundeck o
+        , _casClient         = cas
+        , _smtpEnv           = emailSMTP
+        , _awsEnv            = aws
+        , _stompEnv          = stomp
+        , _metrics           = mtr
+        , _applog            = lgr
+        , _internalEvents    = eventsQueue
+        , _requestId         = def
+        , _usrTemplates      = utp
+        , _provTemplates     = ptp
+        , _tmTemplates       = ttp
+        , _templateBranding  = branding
+        , _httpManager       = mgr
+        , _extGetManager     = ext
+        , _settings          = sett
+        , _mutableSettings   = mSett
+        , _nexmoCreds        = nxm
+        , _twilioCreds       = twl
+        , _geoDb             = g
+        , _turnEnv           = turn
+        , _turnEnvV2         = turnV2
+        , _fsWatcher         = w
+        , _currentTime       = clock
+        , _zauthEnv          = zau
+        , _digestMD5         = md5
+        , _digestSHA256      = sha256
+        , _indexEnv          = mkIndexEnv o lgr mgr mtr
         }
   where
     emailConn _   (Opt.EmailAWS aws) = return (Just aws, Nothing)