"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "services/galley/src/Galley/API/Util.hs" between
wire-server-2020-06-10.tar.gz and wire-server-2020-06-19.tar.gz

About: Wire (server) offers end-to-end encrypted messaging, file-sharing, video and voice calls, and guest rooms for external communication (back-end server).

Util.hs  (wire-server-2020-06-10):Util.hs  (wire-server-2020-06-19)
skipping to change at line 25 skipping to change at line 25
-- You should have received a copy of the GNU Affero General Public License alon g -- You should have received a copy of the GNU Affero General Public License alon g
-- with this program. If not, see <https://www.gnu.org/licenses/>. -- with this program. If not, see <https://www.gnu.org/licenses/>.
module Galley.API.Util where module Galley.API.Util where
import Brig.Types (Relation (..)) import Brig.Types (Relation (..))
import Brig.Types.Intra (ReAuthUser (..)) import Brig.Types.Intra (ReAuthUser (..))
import Control.Lens ((.~), (^.), view) import Control.Lens ((.~), (^.), view)
import Control.Monad.Catch import Control.Monad.Catch
import Data.ByteString.Conversion import Data.ByteString.Conversion
import Data.Domain (Domain)
import Data.Id as Id import Data.Id as Id
import Data.IdMapping (MappedOrLocalId (Local, Mapped), partitionMappedOrLocalId s) import Data.IdMapping (MappedOrLocalId (Local, Mapped), partitionMappedOrLocalId s)
import Data.List.NonEmpty (nonEmpty) import Data.List.NonEmpty (nonEmpty)
import Data.Misc (PlainTextPassword (..)) import Data.Misc (PlainTextPassword (..))
import qualified Data.Set as Set import qualified Data.Set as Set
import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy as LT
import Data.Time import Data.Time
import Galley.API.Error import Galley.API.Error
import Galley.App import Galley.App
import qualified Galley.Data as Data import qualified Galley.Data as Data
import Galley.Data.Services (BotMember, newBotMember) import Galley.Data.Services (BotMember, newBotMember)
import qualified Galley.Data.Types as DataTypes import qualified Galley.Data.Types as DataTypes
import Galley.Intra.Push import Galley.Intra.Push
import Galley.Intra.User import Galley.Intra.User
import Galley.Options (defEnableFederation, optSettings, setEnableFederation) import Galley.Options (optSettings, setEnableFederationWithDomain)
import Galley.Types import Galley.Types
import Galley.Types.Conversations.Roles import Galley.Types.Conversations.Roles
import Galley.Types.Teams import Galley.Types.Teams
import Imports import Imports
import Network.HTTP.Types import Network.HTTP.Types
import Network.Wai import Network.Wai
import Network.Wai.Predicate hiding (Error) import Network.Wai.Predicate hiding (Error)
import Network.Wai.Utilities import Network.Wai.Utilities
import qualified System.Logger.Class as Log
import UnliftIO (concurrently) import UnliftIO (concurrently)
type JSON = Media "application" "json" type JSON = Media "application" "json"
ensureAccessRole :: AccessRole -> [(UserId, Maybe TeamMember)] -> Galley () ensureAccessRole :: AccessRole -> [(UserId, Maybe TeamMember)] -> Galley ()
ensureAccessRole role users = case role of ensureAccessRole role users = case role of
PrivateAccessRole -> throwM convAccessDenied PrivateAccessRole -> throwM convAccessDenied
TeamAccessRole -> TeamAccessRole ->
when (any (isNothing . snd) users) $ when (any (isNothing . snd) users) $
throwM notATeamMember throwM notATeamMember
skipping to change at line 113 skipping to change at line 115
ensureReAuthorised :: UserId -> Maybe PlainTextPassword -> Galley () ensureReAuthorised :: UserId -> Maybe PlainTextPassword -> Galley ()
ensureReAuthorised u secret = do ensureReAuthorised u secret = do
reAuthed <- reAuthUser u (ReAuthUser secret) reAuthed <- reAuthUser u (ReAuthUser secret)
unless reAuthed $ unless reAuthed $
throwM reAuthFailed throwM reAuthFailed
-- | Given a member in a conversation, check if the given action -- | Given a member in a conversation, check if the given action
-- is permitted. -- is permitted.
-- If not, throw 'Member'; if the user is found and does not have the given perm ission, throw -- If not, throw 'Member'; if the user is found and does not have the given perm ission, throw
-- 'operationDenied'. Otherwise, return the found user. -- 'operationDenied'. Otherwise, return the found user.
ensureActionAllowed :: Action -> Member -> Galley () ensureActionAllowed :: Action -> InternalMember a -> Galley ()
ensureActionAllowed action mem = case isActionAllowed action (memConvRoleName me m) of ensureActionAllowed action mem = case isActionAllowed action (memConvRoleName me m) of
Just True -> return () Just True -> return ()
Just False -> throwM (actionDenied action) Just False -> throwM (actionDenied action)
Nothing -> throwM (badRequest "Custom roles not supported") Nothing -> throwM (badRequest "Custom roles not supported")
-- Actually, this will "never" happen due to the -- Actually, this will "never" happen due to the
-- fact that there can be no custom roles at the moment -- fact that there can be no custom roles at the moment
-- | Ensure that the set of actions provided are not "greater" than the user's -- | Ensure that the set of actions provided are not "greater" than the user's
-- own. This is used to ensure users cannot "elevate" allowed actions -- own. This is used to ensure users cannot "elevate" allowed actions
-- This function needs to be review when custom roles are introduced since onl y -- This function needs to be review when custom roles are introduced since onl y
-- custom roles can cause `roleNameToActions` to return a Nothing -- custom roles can cause `roleNameToActions` to return a Nothing
ensureConvRoleNotElevated :: Member -> RoleName -> Galley () ensureConvRoleNotElevated :: InternalMember a -> RoleName -> Galley ()
ensureConvRoleNotElevated origMember targetRole = do ensureConvRoleNotElevated origMember targetRole = do
case (roleNameToActions targetRole, roleNameToActions (memConvRoleName origMem ber)) of case (roleNameToActions targetRole, roleNameToActions (memConvRoleName origMem ber)) of
(Just targetActions, Just memberActions) -> (Just targetActions, Just memberActions) ->
unless (Set.isSubsetOf targetActions memberActions) $ unless (Set.isSubsetOf targetActions memberActions) $
throwM invalidActions throwM invalidActions
(_, _) -> (_, _) ->
throwM (badRequest "Custom roles not supported") throwM (badRequest "Custom roles not supported")
-- | If a team memeber is not given throw 'notATeamMember'; if the given team -- | If a team memeber is not given throw 'notATeamMember'; if the given team
-- member does not have the given permission, throw 'operationDenied'. -- member does not have the given permission, throw 'operationDenied'.
skipping to change at line 165 skipping to change at line 167
permissionCheckTeamConv zusr cnv perm = Data.conversation cnv >>= \case permissionCheckTeamConv zusr cnv perm = Data.conversation cnv >>= \case
Just cnv' -> case Data.convTeam cnv' of Just cnv' -> case Data.convTeam cnv' of
Just tid -> void $ permissionCheck perm =<< Data.teamMember tid zusr Just tid -> void $ permissionCheck perm =<< Data.teamMember tid zusr
Nothing -> pure () Nothing -> pure ()
Nothing -> throwM convNotFound Nothing -> throwM convNotFound
-- | Try to accept a 1-1 conversation, promoting connect conversations as approp riate. -- | Try to accept a 1-1 conversation, promoting connect conversations as approp riate.
acceptOne2One :: UserId -> Data.Conversation -> Maybe ConnId -> Galley Data.Conv ersation acceptOne2One :: UserId -> Data.Conversation -> Maybe ConnId -> Galley Data.Conv ersation
acceptOne2One usr conv conn = case Data.convType conv of acceptOne2One usr conv conn = case Data.convType conv of
One2OneConv -> One2OneConv ->
if makeIdOpaque usr `isMember` mems if Local usr `isMember` mems
then return conv then return conv
else do else do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
mm <- snd <$> Data.addMember now cid usr mm <- snd <$> Data.addMember now cid usr
return $ conv {Data.convMembers = mems <> toList mm} return $ conv {Data.convMembers = mems <> toList mm}
ConnectConv -> case mems of ConnectConv -> case mems of
[_, _] | makeIdOpaque usr `isMember` mems -> promote [_, _] | Local usr `isMember` mems -> promote
[_, _] -> throwM convNotFound [_, _] -> throwM convNotFound
_ -> do _ -> do
when (length mems > 2) $ when (length mems > 2) $
throwM badConvState throwM badConvState
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
(e, mm) <- Data.addMember now cid usr (e, mm) <- Data.addMember now cid usr
conv' <- if isJust (find ((usr /=) . memId) mems) then promote else pure c onv conv' <- if isJust (find ((Local usr /=) . memId) mems) then promote else pure conv
let mems' = mems <> toList mm let mems' = mems <> toList mm
for_ (newPush ListComplete (evtFrom e) (ConvEvent e) (recipient <$> mems') ) $ \p -> for_ (newPush ListComplete (evtFrom e) (ConvEvent e) (recipient <$> mems') ) $ \p ->
push1 $ p & pushConn .~ conn & pushRoute .~ RouteDirect push1 $ p & pushConn .~ conn & pushRoute .~ RouteDirect
return $ conv' {Data.convMembers = mems'} return $ conv' {Data.convMembers = mems'}
_ -> throwM $ invalidOp "accept: invalid conversation type" _ -> throwM $ invalidOp "accept: invalid conversation type"
where where
cid = Data.convId conv cid = Data.convId conv
mems = Data.convMembers conv mems = Data.convMembers conv
promote = do promote = do
Data.acceptConnect cid Data.acceptConnect cid
return $ conv {Data.convType = One2OneConv} return $ conv {Data.convType = One2OneConv}
badConvState = badConvState =
Error status500 "bad-state" $ Error status500 "bad-state" $
"Connect conversation with more than 2 members: " "Connect conversation with more than 2 members: "
<> LT.pack (show cid) <> LT.pack (show cid)
isBot :: Member -> Bool isBot :: InternalMember a -> Bool
isBot = isJust . memService isBot = isJust . memService
isMember :: Foldable m => OpaqueUserId -> m Member -> Bool isMember :: (Eq a, Foldable m) => a -> m (InternalMember a) -> Bool
isMember u = isJust . find ((u ==) . makeIdOpaque . memId) isMember u = isJust . find ((u ==) . memId)
findMember :: Data.Conversation -> UserId -> Maybe Member findMember :: Data.Conversation -> MappedOrLocalId Id.U -> Maybe Member
findMember c u = find ((u ==) . memId) (Data.convMembers c) findMember c u = find ((u ==) . memId) (Data.convMembers c)
botsAndUsers :: Foldable t => t Member -> ([BotMember], [Member]) botsAndUsers :: (Log.MonadLogger m, Traversable t) => t Member -> m ([BotMember]
botsAndUsers = foldr fn ([], []) , [Member])
botsAndUsers = fmap fold . traverse botOrUser
where where
fn m ~(bb, mm) = case newBotMember m of botOrUser m = case memService m of
Nothing -> (bb, m : mm) Just _ -> do
Just b -> (b : bb, mm) -- we drop invalid bots here, which shouldn't happen
bot <- mkBotMember m
pure (toList bot, [])
Nothing ->
pure ([], [m])
mkBotMember :: Log.MonadLogger m => Member -> m (Maybe BotMember)
mkBotMember m = case memId m of
Mapped _ -> do
Log.warn $ Log.msg @Text "Bot member with qualified user ID found, ignor
ing it."
pure Nothing -- remote members can't be bots for now
Local localMemId ->
pure $ newBotMember (m {memId = localMemId} :: LocalMember)
location :: ToByteString a => a -> Response -> Response location :: ToByteString a => a -> Response -> Response
location = addHeader hLocation . toByteString' location = addHeader hLocation . toByteString'
nonTeamMembers :: [Member] -> [TeamMember] -> [Member] nonTeamMembers :: [Member] -> [TeamMember] -> [Member]
nonTeamMembers cm tm = filter (not . flip isTeamMember tm . memId) cm nonTeamMembers cm tm = filter (not . isMemberOfTeam . memId) cm
where
isMemberOfTeam = \case
Local uid -> isTeamMember uid tm
Mapped _ -> False -- teams and their members are always on the same backen
d
convMembsAndTeamMembs :: [Member] -> [TeamMember] -> [Recipient] convMembsAndTeamMembs :: [Member] -> [TeamMember] -> [Recipient]
convMembsAndTeamMembs convMembs teamMembs = convMembsAndTeamMembs convMembs teamMembs =
fmap userRecipient . setnub $ map memId convMembs <> map (view userId) teamMem bs fmap userRecipient . setnub $ map memId convMembs <> map (Local . view userId) teamMembs
where where
setnub = Set.toList . Set.fromList setnub = Set.toList . Set.fromList
membersToRecipients :: Maybe UserId -> [TeamMember] -> [Recipient] membersToRecipients :: Maybe UserId -> [TeamMember] -> [Recipient]
membersToRecipients Nothing = map (userRecipient . view userId) membersToRecipients Nothing = map (userRecipient . Local . view userId)
membersToRecipients (Just u) = map userRecipient . filter (/= u) . map (view use membersToRecipients (Just u) = map (userRecipient . Local) . filter (/= u) . map
rId) (view userId)
-- | Note that we use 2 nearly identical functions but slightly different
-- semantics; when using `getSelfMember`, if that user is _not_ part of -- semantics; when using `getSelfMember`, if that user is _not_ part of
-- the conversation, we don't want to disclose that such a conversation -- the conversation, we don't want to disclose that such a conversation
-- with that id exists. -- with that id exists.
getSelfMember :: Foldable t => UserId -> t Member -> Galley Member getSelfMember :: Foldable t => UserId -> t Member -> Galley LocalMember
getSelfMember = getMember convNotFound getSelfMember = getMember convNotFound
getOtherMember :: Foldable t => UserId -> t Member -> Galley Member getOtherMember :: Foldable t => UserId -> t Member -> Galley LocalMember
getOtherMember = getMember convMemberNotFound getOtherMember = getMember convMemberNotFound
getMember :: Foldable t => Error -> UserId -> t Member -> Galley Member -- | Since we search by local user ID, we know that the member must be local.
getMember :: Foldable t => Error -> UserId -> t Member -> Galley LocalMember
getMember ex u ms = do getMember ex u ms = do
let member = find ((u ==) . memId) ms let member = find ((Local u ==) . memId) ms
case member of case member of
Just m -> return m Just m -> return (m {memId = u})
Nothing -> throwM ex Nothing -> throwM ex
getConversationAndCheckMembership :: UserId -> MappedOrLocalId Id.C -> Galley Da ta.Conversation getConversationAndCheckMembership :: UserId -> MappedOrLocalId Id.C -> Galley Da ta.Conversation
getConversationAndCheckMembership = getConversationAndCheckMembershipWithError c onvAccessDenied getConversationAndCheckMembership = getConversationAndCheckMembershipWithError c onvAccessDenied
getConversationAndCheckMembershipWithError :: Error -> UserId -> MappedOrLocalId Id.C -> Galley Data.Conversation getConversationAndCheckMembershipWithError :: Error -> UserId -> MappedOrLocalId Id.C -> Galley Data.Conversation
getConversationAndCheckMembershipWithError ex zusr = \case getConversationAndCheckMembershipWithError ex zusr = \case
Mapped idMapping -> Mapped idMapping ->
throwM . federationNotImplemented $ pure idMapping throwM . federationNotImplemented $ pure idMapping
Local convId -> do Local convId -> do
-- should we merge resolving to qualified ID and looking up the conversation ? -- should we merge resolving to qualified ID and looking up the conversation ?
c <- Data.conversation convId >>= ifNothing convNotFound c <- Data.conversation convId >>= ifNothing convNotFound
when (DataTypes.isConvDeleted c) $ do when (DataTypes.isConvDeleted c) $ do
Data.deleteConversation convId Data.deleteConversation convId
throwM convNotFound throwM convNotFound
unless (makeIdOpaque zusr `isMember` Data.convMembers c) $ unless (Local zusr `isMember` Data.convMembers c) $
throwM ex throwM ex
return c return c
-- | Deletion requires a permission check, but also a 'Role' comparison:
-- Owners can only be deleted by another owner (and not themselves).
--
-- FUTUREWORK: do not do this with 'Role', but introduce permissions "can delete
owner", "can
-- delete admin", etc.
canDeleteMember :: TeamMember -> TeamMember -> Bool
canDeleteMember deleter deletee
| getRole deletee == RoleOwner =
getRole deleter == RoleOwner -- owners can only be deleted by another owner
&& (deleter ^. userId /= deletee ^. userId) -- owner cannot delete itself
| otherwise =
True
where
-- (team members having no role is an internal error, but we don't want to d
eal with that
-- here, so we pick a reasonable default.)
getRole mem = fromMaybe RoleMember $ permissionsRole $ mem ^. permissions
--------------------------------------------------------------------------------
-- Federation
viewFederationDomain :: Galley (Maybe Domain)
viewFederationDomain = view (options . optSettings . setEnableFederationWithDoma
in)
isFederationEnabled :: Galley Bool
isFederationEnabled = isJust <$> viewFederationDomain
-- FUTUREWORK(federation, #1178): implement function to resolve IDs in batch -- FUTUREWORK(federation, #1178): implement function to resolve IDs in batch
-- | this exists as a shim to find and mark places where we need to handle 'Opaq ueUserId's. -- | this exists as a shim to find and mark places where we need to handle 'Opaq ueUserId's.
resolveOpaqueUserId :: OpaqueUserId -> Galley (MappedOrLocalId Id.U) resolveOpaqueUserId :: OpaqueUserId -> Galley (MappedOrLocalId Id.U)
resolveOpaqueUserId (Id opaque) = do resolveOpaqueUserId (Id opaque) = do
mEnabled <- view (options . optSettings . setEnableFederation) isFederationEnabled >>= \case
case fromMaybe defEnableFederation mEnabled of
False -> False ->
-- don't check the ID mapping, just assume it's local -- don't check the ID mapping, just assume it's local
pure . Local $ Id opaque pure . Local $ Id opaque
True -> True ->
-- FUTUREWORK(federation, #1178): implement database lookup -- FUTUREWORK(federation, #1178): implement database lookup
pure . Local $ Id opaque pure . Local $ Id opaque
-- | this exists as a shim to find and mark places where we need to handle 'Opaq ueConvId's. -- | this exists as a shim to find and mark places where we need to handle 'Opaq ueConvId's.
resolveOpaqueConvId :: OpaqueConvId -> Galley (MappedOrLocalId Id.C) resolveOpaqueConvId :: OpaqueConvId -> Galley (MappedOrLocalId Id.C)
resolveOpaqueConvId (Id opaque) = do resolveOpaqueConvId (Id opaque) = do
mEnabled <- view (options . optSettings . setEnableFederation) isFederationEnabled >>= \case
case fromMaybe defEnableFederation mEnabled of
False -> False ->
-- don't check the ID mapping, just assume it's local -- don't check the ID mapping, just assume it's local
pure . Local $ Id opaque pure . Local $ Id opaque
True -> True ->
-- FUTUREWORK(federation, #1178): implement database lookup -- FUTUREWORK(federation, #1178): implement database lookup
pure . Local $ Id opaque pure . Local $ Id opaque
canDeleteMember :: TeamMember -> TeamMember -> Bool
canDeleteMember deleter deletee
| getRole deletee == RoleOwner =
getRole deleter == RoleOwner -- owners can only be deleted by another owner
&& (deleter ^. userId /= deletee ^. userId) -- owner cannot delete itself
| otherwise =
True
where
-- (team members having no role is an internal error, but we don't want to d
eal with that
-- here, so we pick a reasonable default.)
getRole mem = fromMaybe RoleMember $ permissionsRole $ mem ^. permissions
 End of changes. 27 change blocks. 
30 lines changed or deleted 79 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)