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
@@ -160,6 +189,7 @@ data UserProfile = UserProfile
     , profileLocale   :: !(Maybe Locale)
     , profileExpire   :: !(Maybe UTCTimeMillis)
     , profileTeam     :: !(Maybe TeamId)
+    , profileEmail    :: !(Maybe Email)
     }
     deriving (Eq, Show)
 
@@ -213,6 +243,7 @@ instance FromJSON UserProfile where
                     <*> o .:? "locale"
                     <*> o .:? "expires_at"
                     <*> o .:? "team"
+                    <*> o .:? "email"
 
 instance ToJSON UserProfile where
     toJSON u = object
@@ -227,6 +258,7 @@ instance ToJSON UserProfile where
         # "locale"     .= profileLocale u
         # "expires_at" .= profileExpire u
         # "team"       .= profileTeam u
+        # "email"      .= profileEmail u
         # []
 
 instance FromJSON SelfProfile where

libs/brig-types/test/unit/Test/Brig/Types/Arbitrary.hs

@@ -300,6 +300,7 @@ instance Arbitrary UserProfile where
         <*> arbitrary
         <*> arbitrary
         <*> arbitrary
+        <*> arbitrary
 
 instance Arbitrary RichField where
     arbitrary = RichField <$> arbitrary <*> arbitrary

libs/brig-types/test/unit/Test/Brig/Types/User.hs

@@ -16,7 +16,6 @@ import Brig.Types.Team.Invitation
 import Brig.Types.User
 import Data.Aeson
 import Data.Aeson.Types
-import Data.Proxy
 import Data.Typeable (typeOf)
 import Galley.Types.Teams
 import Test.Brig.Types.Arbitrary ()
@@ -70,41 +69,41 @@ unitTests =
 
 roundtripTests :: [TestTree]
 roundtripTests =
-    [ run @BindingNewTeamUser Proxy
-    , run @CheckHandles Proxy
-    , run @CompletePasswordReset Proxy
-    , run @DeleteUser Proxy
-    , run @DeletionCodeTimeout Proxy
-    , run @EmailRemove Proxy
-    , run @EmailUpdate Proxy
-    , run @HandleUpdate Proxy
-    , run @InvitationList Proxy
-    , run @Invitation Proxy
-    , run @InvitationRequest Proxy
-    , run @LocaleUpdate Proxy
-    , run @NewPasswordReset Proxy
-    , run @NewUser Proxy
-    , run @PasswordChange Proxy
-    , run @PhoneRemove Proxy
-    , run @PhoneUpdate Proxy
-    , run @ManagedByUpdate Proxy
-    , run @ReAuthUser Proxy
-    , run @SelfProfile Proxy
-    , run @TeamMember Proxy
-    , run @UpdateServiceWhitelist Proxy
-    , run @UserHandleInfo Proxy
-    , run @UserIdentity Proxy
-    , run @UserProfile Proxy
-    , run @User Proxy
-    , run @RichInfo Proxy
-    , run @UserUpdate Proxy
-    , run @RichInfoUpdate Proxy
-    , run @VerifyDeleteUser Proxy
+    [ run @BindingNewTeamUser
+    , run @CheckHandles
+    , run @CompletePasswordReset
+    , run @DeleteUser
+    , run @DeletionCodeTimeout
+    , run @EmailRemove
+    , run @EmailUpdate
+    , run @HandleUpdate
+    , run @InvitationList
+    , run @Invitation
+    , run @InvitationRequest
+    , run @LocaleUpdate
+    , run @NewPasswordReset
+    , run @NewUser
+    , run @PasswordChange
+    , run @PhoneRemove
+    , run @PhoneUpdate
+    , run @ManagedByUpdate
+    , run @ReAuthUser
+    , run @SelfProfile
+    , run @TeamMember
+    , run @UpdateServiceWhitelist
+    , run @UserHandleInfo
+    , run @UserIdentity
+    , run @UserProfile
+    , run @User
+    , run @RichInfo
+    , run @UserUpdate
+    , run @RichInfoUpdate
+    , run @VerifyDeleteUser
     ]
   where
     run :: forall a. (Arbitrary a, Typeable a, ToJSON a, FromJSON a, Eq a, Show a)
-        => Proxy a -> TestTree
-    run Proxy = testProperty msg trip
+        => TestTree
+    run = testProperty msg trip
       where
         msg = show $ typeOf (undefined :: a)
         trip (v :: a) = counterexample (show $ toJSON v)

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"
+
+    patch "/i/settings" (continue $ API.patchSettings) $
+         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
+    ( patchSettings
+    , 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
+patchSettings :: JsonRequest (MutableSettings' Maybe) -> Handler Response
+patchSettings 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
+
+
+-- | Get the current settings
+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)