diff --git a/changelog.d/5-internal/pr-3083 b/changelog.d/5-internal/pr-3083
new file mode 100644
index 0000000000..e18a6f9a6f
--- /dev/null
+++ b/changelog.d/5-internal/pr-3083
@@ -0,0 +1 @@
+Automatically track CallsFed constraints via a GHC plugin
diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API.hs b/libs/wire-api-federation/src/Wire/API/Federation/API.hs
index e576e32bec..d94f1c6096 100644
--- a/libs/wire-api-federation/src/Wire/API/Federation/API.hs
+++ b/libs/wire-api-federation/src/Wire/API/Federation/API.hs
@@ -55,7 +55,7 @@ type instance FedApi 'Brig = BrigApi
type instance FedApi 'Cargohold = CargoholdApi
-type HasFedEndpoint comp api name = (HasUnsafeFedEndpoint comp api name, CallsFed comp name)
+type HasFedEndpoint comp api name = (HasUnsafeFedEndpoint comp api name)
-- | Like 'HasFedEndpoint', but doesn't propagate a 'CallsFed' constraint.
-- Useful for tests, but unsafe in the sense that incorrect usage will allow
@@ -63,9 +63,15 @@ type HasFedEndpoint comp api name = (HasUnsafeFedEndpoint comp api name, CallsFe
type HasUnsafeFedEndpoint comp api name = 'Just api ~ LookupEndpoint (FedApi comp) name
-- | Return a client for a named endpoint.
+--
+-- This function introduces an 'AddAnnotation' constraint, which is
+-- automatically solved by the @transitive-anns@ plugin, and pushes the
+-- resulting information around in a side-channel. See the documentation at
+-- 'Wire.API.MakesFederatedCall.exposeAnnotations' for a better understanding
+-- of the information flow here.
fedClient ::
- forall (comp :: Component) (name :: Symbol) m api.
- (CallsFed comp name, HasFedEndpoint comp api name, HasClient m api, m ~ FederatorClient comp) =>
+ forall (comp :: Component) (name :: Symbol) m (showcomp :: Symbol) api x.
+ (AddAnnotation 'Remote showcomp name x, showcomp ~ ShowComponent comp, HasFedEndpoint comp api name, HasClient m api, m ~ FederatorClient comp) =>
Client m api
fedClient = clientIn (Proxy @api) (Proxy @m)
@@ -75,7 +81,7 @@ fedClientIn ::
Client m api
fedClientIn = clientIn (Proxy @api) (Proxy @m)
--- | Like 'fedClientIn', but doesn't propagate a 'CallsFed' constraint. Inteded
+-- | Like 'fedClientIn', but doesn't propagate a 'CallsFed' constraint. Intended
-- to be used in test situations only.
unsafeFedClientIn ::
forall (comp :: Component) (name :: Symbol) m api.
diff --git a/libs/wire-api/default.nix b/libs/wire-api/default.nix
index 85423f45c6..8b7f20896e 100644
--- a/libs/wire-api/default.nix
+++ b/libs/wire-api/default.nix
@@ -91,6 +91,7 @@
, tasty-quickcheck
, text
, time
+, transitive-anns
, types-common
, unliftio
, unordered-containers
@@ -186,6 +187,7 @@ mkDerivation {
tagged
text
time
+ transitive-anns
types-common
unordered-containers
uri-bytestring
diff --git a/libs/wire-api/src/Wire/API/MakesFederatedCall.hs b/libs/wire-api/src/Wire/API/MakesFederatedCall.hs
index 78de951841..0e0f627db4 100644
--- a/libs/wire-api/src/Wire/API/MakesFederatedCall.hs
+++ b/libs/wire-api/src/Wire/API/MakesFederatedCall.hs
@@ -15,6 +15,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
{-# LANGUAGE OverloadedLists #-}
+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
module Wire.API.MakesFederatedCall
( CallsFed,
@@ -22,6 +23,11 @@ module Wire.API.MakesFederatedCall
Component (..),
callsFed,
unsafeCallsFed,
+ AddAnnotation,
+ Location (..),
+ ShowComponent,
+ Annotation,
+ exposeAnnotations,
)
where
@@ -39,9 +45,33 @@ import Servant.Client
import Servant.Server
import Servant.Swagger
import Test.QuickCheck (Arbitrary)
+import TransitiveAnns.Types
import Unsafe.Coerce (unsafeCoerce)
import Wire.Arbitrary (GenericUniform (..))
+-- | This function exists only to provide a convenient place for the
+-- @transitive-anns@ plugin to solve the 'ToHasAnnotations' constraint. This is
+-- highly magical and warrants a note.
+--
+-- The call @'exposeAnnotations' (some expr here)@ will expand to @some expr
+-- here@, additionally generating wanted 'HasAnnotation' constraints for every
+-- 'AddAnnotation' constraint in the _transitive call closure_ of @some expr
+-- here@.
+--
+-- The use case is always going to be @'callsFed' ('exposeAnnotations' expr)@,
+-- where 'exposeAnnotations' re-introduces all of the constraints we've been
+-- squirreling away, and 'callsFed' is responsible for discharging them. It
+-- would be very desirable to combine these into one call, but the semantics of
+-- solving 'ToHasAnnotations' attaches the wanted calls to the same place as
+-- the call itself, which means the wanteds appear just after our opportunity
+-- to solve them via 'callsFed'. This is likely not a hard limitation.
+--
+-- The @x@ parameter here is intentionally ambiguous, existing as a unique
+-- skolem to prevent GHC from caching the results of solving
+-- 'ToHasAnnotations'. Callers needn't worry about it.
+exposeAnnotations :: ToHasAnnotations x => a -> a
+exposeAnnotations = id
+
data Component
= Brig
| Galley
@@ -56,7 +86,7 @@ data Component
-- The only way to discharge this constraint is via 'callsFed', which should be
-- invoked for each federated call when connecting handlers to the server
-- definition.
-class CallsFed (comp :: Component) (name :: Symbol)
+type CallsFed (comp :: Component) = HasAnnotation 'Remote (ShowComponent comp)
-- | A typeclass with the same layout as 'CallsFed', which exists only so we
-- can discharge 'CallsFeds' constraints by unsafely coercing this one.
@@ -91,7 +121,7 @@ instance RoutesToPaths api => RoutesToPaths (MakesFederatedCall comp name :> api
getRoutes = getRoutes @api
-- | Get a symbol representation of our component.
-type family ShowComponent (x :: Component) :: Symbol where
+type family ShowComponent (x :: Component) = (res :: Symbol) | res -> x where
ShowComponent 'Brig = "brig"
ShowComponent 'Galley = "galley"
ShowComponent 'Cargohold = "cargohold"
@@ -127,6 +157,10 @@ instance HasClient m api => HasClient m (MakesFederatedCall comp name :> api ::
class SolveCallsFed c r a where
-- | Safely discharge a 'CallsFed' constraint. Intended to be used when
-- connecting your handler to the server router.
+ --
+ -- This function should always be called with an argument of
+ -- 'exposeAnnotations'. See the documentation there for more information on
+ -- why.
callsFed :: (c => r) -> a
instance (c ~ ((k, d) :: Constraint), SolveCallsFed d r a) => SolveCallsFed c r (Dict k -> a) where
diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs
index d7b08b83cb..65dc97b08b 100644
--- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs
+++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs
@@ -715,6 +715,7 @@ type ConversationAPI =
( Summary "Update membership of the specified user (deprecated)"
:> Description "Use `PUT /conversations/:cnv_domain/:cnv/members/:usr_domain/:usr` instead"
:> MakesFederatedCall 'Galley "on-conversation-updated"
+ :> MakesFederatedCall 'Galley "on-mls-message-sent"
:> MakesFederatedCall 'Galley "on-new-remote-conversation"
:> ZLocalUser
:> ZConn
@@ -739,6 +740,7 @@ type ConversationAPI =
( Summary "Update membership of the specified user"
:> Description "**Note**: at least one field has to be provided."
:> MakesFederatedCall 'Galley "on-conversation-updated"
+ :> MakesFederatedCall 'Galley "on-mls-message-sent"
:> MakesFederatedCall 'Galley "on-new-remote-conversation"
:> ZLocalUser
:> ZConn
@@ -765,6 +767,7 @@ type ConversationAPI =
( Summary "Update conversation name (deprecated)"
:> Description "Use `/conversations/:domain/:conv/name` instead."
:> MakesFederatedCall 'Galley "on-conversation-updated"
+ :> MakesFederatedCall 'Galley "on-mls-message-sent"
:> MakesFederatedCall 'Galley "on-new-remote-conversation"
:> CanThrow ('ActionDenied 'ModifyConversationName)
:> CanThrow 'ConvNotFound
@@ -785,6 +788,7 @@ type ConversationAPI =
( Summary "Update conversation name (deprecated)"
:> Description "Use `/conversations/:domain/:conv/name` instead."
:> MakesFederatedCall 'Galley "on-conversation-updated"
+ :> MakesFederatedCall 'Galley "on-mls-message-sent"
:> MakesFederatedCall 'Galley "on-new-remote-conversation"
:> CanThrow ('ActionDenied 'ModifyConversationName)
:> CanThrow 'ConvNotFound
@@ -805,6 +809,7 @@ type ConversationAPI =
"update-conversation-name"
( Summary "Update conversation name"
:> MakesFederatedCall 'Galley "on-conversation-updated"
+ :> MakesFederatedCall 'Galley "on-mls-message-sent"
:> MakesFederatedCall 'Galley "on-new-remote-conversation"
:> CanThrow ('ActionDenied 'ModifyConversationName)
:> CanThrow 'ConvNotFound
@@ -828,6 +833,7 @@ type ConversationAPI =
( Summary "Update the message timer for a conversation (deprecated)"
:> Description "Use `/conversations/:domain/:cnv/message-timer` instead."
:> MakesFederatedCall 'Galley "on-conversation-updated"
+ :> MakesFederatedCall 'Galley "on-mls-message-sent"
:> MakesFederatedCall 'Galley "on-new-remote-conversation"
:> ZLocalUser
:> ZConn
@@ -849,6 +855,7 @@ type ConversationAPI =
"update-conversation-message-timer"
( Summary "Update the message timer for a conversation"
:> MakesFederatedCall 'Galley "on-conversation-updated"
+ :> MakesFederatedCall 'Galley "on-mls-message-sent"
:> MakesFederatedCall 'Galley "on-new-remote-conversation"
:> ZLocalUser
:> ZConn
@@ -873,6 +880,7 @@ type ConversationAPI =
( Summary "Update receipt mode for a conversation (deprecated)"
:> Description "Use `PUT /conversations/:domain/:cnv/receipt-mode` instead."
:> MakesFederatedCall 'Galley "on-conversation-updated"
+ :> MakesFederatedCall 'Galley "on-mls-message-sent"
:> MakesFederatedCall 'Galley "on-new-remote-conversation"
:> MakesFederatedCall 'Galley "update-conversation"
:> ZLocalUser
@@ -895,6 +903,7 @@ type ConversationAPI =
"update-conversation-receipt-mode"
( Summary "Update receipt mode for a conversation"
:> MakesFederatedCall 'Galley "on-conversation-updated"
+ :> MakesFederatedCall 'Galley "on-mls-message-sent"
:> MakesFederatedCall 'Galley "on-new-remote-conversation"
:> MakesFederatedCall 'Galley "update-conversation"
:> ZLocalUser
diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamConversation.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamConversation.hs
index 759b83c6cc..76753f48f2 100644
--- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamConversation.hs
+++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamConversation.hs
@@ -69,6 +69,7 @@ type TeamConversationAPI =
"delete-team-conversation"
( Summary "Remove a team conversation"
:> MakesFederatedCall 'Galley "on-conversation-updated"
+ :> MakesFederatedCall 'Galley "on-mls-message-sent"
:> MakesFederatedCall 'Galley "on-new-remote-conversation"
:> CanThrow ('ActionDenied 'DeleteConversation)
:> CanThrow 'ConvNotFound
diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal
index 3be0437bb4..8571f041dd 100644
--- a/libs/wire-api/wire-api.cabal
+++ b/libs/wire-api/wire-api.cabal
@@ -280,6 +280,7 @@ library
, tagged
, text >=0.11
, time >=1.4
+ , transitive-anns
, types-common >=0.16
, unordered-containers >=0.2
, uri-bytestring >=0.2
diff --git a/nix/haskell-pins.nix b/nix/haskell-pins.nix
index a27571e81c..366d092910 100644
--- a/nix/haskell-pins.nix
+++ b/nix/haskell-pins.nix
@@ -57,6 +57,13 @@
{ lib, fetchgit }: hself: hsuper:
let
gitPins = {
+ transitive-anns = {
+ src = fetchgit {
+ url = "https://github.com/wireapp/transitive-anns";
+ rev = "c3bdc423f84bf15fe8b3618b5dddd5764fc8a470";
+ sha256 = "sha256-mWBZ2uY0shlxNRceyC2Zu1f3Kr4IDtT/rOL7CKWgilA=";
+ };
+ };
HaskellNet-SSL = {
src = fetchgit {
url = "https://github.com/dpwright/HaskellNet-SSL";
diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal
index 84aefd052f..50cf268ba5 100644
--- a/services/brig/brig.cabal
+++ b/services/brig/brig.cabal
@@ -179,7 +179,7 @@ library
-O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates
-Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path
-funbox-strict-fields -fplugin=Polysemy.Plugin
- -Wredundant-constraints
+ -fplugin=TransitiveAnns.Plugin -Wredundant-constraints
build-depends:
aeson >=2.0.1.0
@@ -292,6 +292,7 @@ library
, time-units
, tinylog >=0.10
, transformers >=0.3
+ , transitive-anns
, types-common >=0.16
, types-common-aws
, types-common-journal >=0.1
diff --git a/services/brig/default.nix b/services/brig/default.nix
index 611148f0dc..e503c7492c 100644
--- a/services/brig/default.nix
+++ b/services/brig/default.nix
@@ -137,6 +137,7 @@
, time-units
, tinylog
, transformers
+, transitive-anns
, types-common
, types-common-aws
, types-common-journal
@@ -276,6 +277,7 @@ mkDerivation {
time-units
tinylog
transformers
+ transitive-anns
types-common
types-common-aws
types-common-journal
diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs
index b89733053e..ff7ed5aa91 100644
--- a/services/brig/src/Brig/API/Auth.hs
+++ b/services/brig/src/Brig/API/Auth.hs
@@ -43,7 +43,6 @@ import Network.HTTP.Types
import Network.Wai.Utilities ((!>>))
import qualified Network.Wai.Utilities.Error as Wai
import Polysemy
-import Wire.API.Federation.API
import Wire.API.User
import Wire.API.User.Auth hiding (access)
import Wire.API.User.Auth.LegalHold
@@ -51,7 +50,6 @@ import Wire.API.User.Auth.ReAuth
import Wire.API.User.Auth.Sso
accessH ::
- CallsFed 'Brig "on-user-deleted-connections" =>
Maybe ClientId ->
[Either Text SomeUserToken] ->
Maybe (Either Text SomeAccessToken) ->
@@ -63,7 +61,7 @@ accessH mcid ut' mat' = do
>>= either (uncurry (access mcid)) (uncurry (access mcid))
access ::
- (TokenPair u a, CallsFed 'Brig "on-user-deleted-connections") =>
+ (TokenPair u a) =>
Maybe ClientId ->
NonEmpty (Token u) ->
Maybe (Token a) ->
@@ -78,7 +76,7 @@ sendLoginCode (SendLoginCode phone call force) = do
c <- wrapClientE (Auth.sendLoginCode phone call force) !>> sendLoginCodeError
pure $ LoginCodeTimeout (pendingLoginTimeout c)
-login :: (Member GalleyProvider r, CallsFed 'Brig "on-user-deleted-connections") => Login -> Maybe Bool -> Handler r SomeAccess
+login :: (Member GalleyProvider r) => Login -> Maybe Bool -> Handler r SomeAccess
login l (fromMaybe False -> persist) = do
let typ = if persist then PersistentCookie else SessionCookie
c <- Auth.login l typ !>> loginError
@@ -130,13 +128,13 @@ removeCookies :: Local UserId -> RemoveCookies -> Handler r ()
removeCookies lusr (RemoveCookies pw lls ids) =
wrapClientE (Auth.revokeAccess (tUnqualified lusr) pw ids lls) !>> authError
-legalHoldLogin :: (Member GalleyProvider r, CallsFed 'Brig "on-user-deleted-connections") => LegalHoldLogin -> Handler r SomeAccess
+legalHoldLogin :: (Member GalleyProvider r) => LegalHoldLogin -> Handler r SomeAccess
legalHoldLogin lhl = do
let typ = PersistentCookie -- Session cookie isn't a supported use case here
c <- Auth.legalHoldLogin lhl typ !>> legalHoldLoginError
traverse mkUserTokenCookie c
-ssoLogin :: CallsFed 'Brig "on-user-deleted-connections" => SsoLogin -> Maybe Bool -> Handler r SomeAccess
+ssoLogin :: SsoLogin -> Maybe Bool -> Handler r SomeAccess
ssoLogin l (fromMaybe False -> persist) = do
let typ = if persist then PersistentCookie else SessionCookie
c <- wrapHttpClientE (Auth.ssoLogin l typ) !>> loginError
diff --git a/services/brig/src/Brig/API/Client.hs b/services/brig/src/Brig/API/Client.hs
index 02a3488783..3ac4f7e255 100644
--- a/services/brig/src/Brig/API/Client.hs
+++ b/services/brig/src/Brig/API/Client.hs
@@ -93,7 +93,6 @@ import Polysemy (Member)
import Servant (Link, ToHttpApiData (toUrlPiece))
import System.Logger.Class (field, msg, val, (~~))
import qualified System.Logger.Class as Log
-import Wire.API.Federation.API
import Wire.API.Federation.API.Brig (GetUserClients (GetUserClients))
import Wire.API.Federation.Error
import Wire.API.MLS.Credential (ClientIdentity (..))
@@ -116,12 +115,12 @@ lookupLocalClient uid = wrapClient . Data.lookupClient uid
lookupLocalClients :: UserId -> (AppT r) [Client]
lookupLocalClients = wrapClient . Data.lookupClients
-lookupPubClient :: CallsFed 'Brig "get-user-clients" => Qualified UserId -> ClientId -> ExceptT ClientError (AppT r) (Maybe PubClient)
+lookupPubClient :: Qualified UserId -> ClientId -> ExceptT ClientError (AppT r) (Maybe PubClient)
lookupPubClient qid cid = do
clients <- lookupPubClients qid
pure $ find ((== cid) . pubClientId) clients
-lookupPubClients :: CallsFed 'Brig "get-user-clients" => Qualified UserId -> ExceptT ClientError (AppT r) [PubClient]
+lookupPubClients :: Qualified UserId -> ExceptT ClientError (AppT r) [PubClient]
lookupPubClients qid@(Qualified uid domain) = do
getForUser <$> lookupPubClientsBulk [qid]
where
@@ -130,7 +129,7 @@ lookupPubClients qid@(Qualified uid domain) = do
um <- userMap <$> Map.lookup domain (qualifiedUserMap qmap)
Set.toList <$> Map.lookup uid um
-lookupPubClientsBulk :: CallsFed 'Brig "get-user-clients" => [Qualified UserId] -> ExceptT ClientError (AppT r) (QualifiedUserMap (Set PubClient))
+lookupPubClientsBulk :: [Qualified UserId] -> ExceptT ClientError (AppT r) (QualifiedUserMap (Set PubClient))
lookupPubClientsBulk qualifiedUids = do
loc <- qualifyLocal ()
let (localUsers, remoteUsers) = partitionQualified loc qualifiedUids
@@ -146,7 +145,7 @@ lookupLocalPubClientsBulk :: [UserId] -> ExceptT ClientError (AppT r) (UserMap (
lookupLocalPubClientsBulk = lift . wrapClient . Data.lookupPubClientsBulk
addClient ::
- (Member GalleyProvider r, CallsFed 'Brig "on-user-deleted-connections") =>
+ (Member GalleyProvider r) =>
UserId ->
Maybe ConnId ->
Maybe IP ->
@@ -158,7 +157,7 @@ addClient = addClientWithReAuthPolicy Data.reAuthForNewClients
-- a superset of the clients known to galley.
addClientWithReAuthPolicy ::
forall r.
- (Member GalleyProvider r, CallsFed 'Brig "on-user-deleted-connections") =>
+ (Member GalleyProvider r) =>
Data.ReAuthPolicy ->
UserId ->
Maybe ConnId ->
@@ -239,7 +238,6 @@ rmClient u con clt pw =
lift $ execDelete u (Just con) client
claimPrekey ::
- CallsFed 'Brig "claim-prekey" =>
LegalholdProtectee ->
UserId ->
Domain ->
@@ -266,15 +264,14 @@ claimLocalPrekey protectee user client = do
claimRemotePrekey ::
( MonadReader Env m,
Log.MonadLogger m,
- MonadClient m,
- CallsFed 'Brig "claim-prekey"
+ MonadClient m
) =>
Qualified UserId ->
ClientId ->
ExceptT ClientError m (Maybe ClientPrekey)
claimRemotePrekey quser client = fmapLT ClientFederationError $ Federation.claimPrekey quser client
-claimPrekeyBundle :: CallsFed 'Brig "claim-prekey-bundle" => LegalholdProtectee -> Domain -> UserId -> ExceptT ClientError (AppT r) PrekeyBundle
+claimPrekeyBundle :: LegalholdProtectee -> Domain -> UserId -> ExceptT ClientError (AppT r) PrekeyBundle
claimPrekeyBundle protectee domain uid = do
isLocalDomain <- (domain ==) <$> viewFederationDomain
if isLocalDomain
@@ -287,13 +284,13 @@ claimLocalPrekeyBundle protectee u = do
guardLegalhold protectee (mkUserClients [(u, clients)])
PrekeyBundle u . catMaybes <$> lift (mapM (wrapHttp . Data.claimPrekey u) clients)
-claimRemotePrekeyBundle :: CallsFed 'Brig "claim-prekey-bundle" => Qualified UserId -> ExceptT ClientError (AppT r) PrekeyBundle
+claimRemotePrekeyBundle :: Qualified UserId -> ExceptT ClientError (AppT r) PrekeyBundle
claimRemotePrekeyBundle quser = do
Federation.claimPrekeyBundle quser !>> ClientFederationError
claimMultiPrekeyBundles ::
forall r.
- (Member (Concurrency 'Unsafe) r, CallsFed 'Brig "claim-multi-prekey-bundle") =>
+ (Member (Concurrency 'Unsafe) r) =>
LegalholdProtectee ->
QualifiedUserClients ->
ExceptT ClientError (AppT r) QualifiedUserClientPrekeyMap
@@ -413,7 +410,7 @@ pubClient c =
pubClientClass = clientClass c
}
-legalHoldClientRequested :: CallsFed 'Brig "on-user-deleted-connections" => UserId -> LegalHoldClientRequest -> (AppT r) ()
+legalHoldClientRequested :: UserId -> LegalHoldClientRequest -> (AppT r) ()
legalHoldClientRequested targetUser (LegalHoldClientRequest _requester lastPrekey') =
wrapHttpClient $ Intra.onUserEvent targetUser Nothing lhClientEvent
where
@@ -424,7 +421,7 @@ legalHoldClientRequested targetUser (LegalHoldClientRequest _requester lastPreke
lhClientEvent :: UserEvent
lhClientEvent = LegalHoldClientRequested eventData
-removeLegalHoldClient :: CallsFed 'Brig "on-user-deleted-connections" => UserId -> (AppT r) ()
+removeLegalHoldClient :: UserId -> (AppT r) ()
removeLegalHoldClient uid = do
clients <- wrapClient $ Data.lookupClients uid
-- Should only be one; but just in case we'll treat it as a list
diff --git a/services/brig/src/Brig/API/Connection.hs b/services/brig/src/Brig/API/Connection.hs
index 01af7e65ea..9296a403c7 100644
--- a/services/brig/src/Brig/API/Connection.hs
+++ b/services/brig/src/Brig/API/Connection.hs
@@ -60,7 +60,6 @@ import Wire.API.Connection hiding (relationWithHistory)
import Wire.API.Conversation hiding (Member)
import Wire.API.Error
import qualified Wire.API.Error.Brig as E
-import Wire.API.Federation.API
import Wire.API.Routes.Public.Util (ResponseForExistedCreated (..))
ensureIsActivated :: Local UserId -> MaybeT (AppT r) ()
@@ -76,7 +75,7 @@ ensureNotSameTeam self target = do
throwE ConnectSameBindingTeamUsers
createConnection ::
- (Member GalleyProvider r, CallsFed 'Brig "send-connection-action") =>
+ (Member GalleyProvider r) =>
Local UserId ->
ConnId ->
Qualified UserId ->
@@ -211,7 +210,6 @@ checkLegalholdPolicyConflict uid1 uid2 = do
oneway status2 status1
updateConnection ::
- CallsFed 'Brig "send-connection-action" =>
Local UserId ->
Qualified UserId ->
Relation ->
diff --git a/services/brig/src/Brig/API/Connection/Remote.hs b/services/brig/src/Brig/API/Connection/Remote.hs
index 0138d049ca..34e7eef34d 100644
--- a/services/brig/src/Brig/API/Connection/Remote.hs
+++ b/services/brig/src/Brig/API/Connection/Remote.hs
@@ -38,7 +38,6 @@ import Data.Qualified
import Imports
import Network.Wai.Utilities.Error
import Wire.API.Connection
-import Wire.API.Federation.API
import Wire.API.Federation.API.Brig
( NewConnectionResponse (..),
RemoteConnectionAction (..),
@@ -188,7 +187,6 @@ pushEvent self mzcon connection = do
Intra.onConnectionEvent (tUnqualified self) mzcon event
performLocalAction ::
- CallsFed 'Brig "send-connection-action" =>
Local UserId ->
Maybe ConnId ->
Remote UserId ->
@@ -253,7 +251,6 @@ performRemoteAction self other mconnection action = do
reaction _ = Nothing
createConnectionToRemoteUser ::
- CallsFed 'Brig "send-connection-action" =>
Local UserId ->
ConnId ->
Remote UserId ->
@@ -263,7 +260,6 @@ createConnectionToRemoteUser self zcon other = do
fst <$> performLocalAction self (Just zcon) other mconnection LocalConnect
updateConnectionToRemoteUser ::
- CallsFed 'Brig "send-connection-action" =>
Local UserId ->
Remote UserId ->
Relation ->
diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs
index 60f3005741..f0e8eee1ef 100644
--- a/services/brig/src/Brig/API/Internal.hs
+++ b/services/brig/src/Brig/API/Internal.hs
@@ -149,8 +149,8 @@ accountAPI ::
) =>
ServerT BrigIRoutes.AccountAPI (Handler r)
accountAPI =
- Named @"createUserNoVerify" (callsFed createUserNoVerify)
- :<|> Named @"createUserNoVerifySpar" (callsFed createUserNoVerifySpar)
+ Named @"createUserNoVerify" (callsFed (exposeAnnotations createUserNoVerify))
+ :<|> Named @"createUserNoVerifySpar" (callsFed (exposeAnnotations createUserNoVerifySpar))
teamsAPI :: ServerT BrigIRoutes.TeamsAPI (Handler r)
teamsAPI = Named @"updateSearchVisibilityInbound" Index.updateSearchVisibilityInbound
@@ -163,8 +163,8 @@ userAPI =
authAPI :: (Member GalleyProvider r) => ServerT BrigIRoutes.AuthAPI (Handler r)
authAPI =
- Named @"legalhold-login" (callsFed legalHoldLogin)
- :<|> Named @"sso-login" (callsFed ssoLogin)
+ Named @"legalhold-login" (callsFed (exposeAnnotations legalHoldLogin))
+ :<|> Named @"sso-login" (callsFed (exposeAnnotations ssoLogin))
:<|> Named @"login-code" getLoginCode
:<|> Named @"reauthenticate" reauthenticate
@@ -442,9 +442,7 @@ sitemap = unsafeCallsFed @'Brig @"on-user-deleted-connections" $ do
-- | Add a client without authentication checks
addClientInternalH ::
- ( Member GalleyProvider r,
- CallsFed 'Brig "on-user-deleted-connections"
- ) =>
+ (Member GalleyProvider r) =>
UserId ::: Maybe Bool ::: JsonRequest NewClient ::: Maybe ConnId ::: JSON ->
(Handler r) Response
addClientInternalH (usr ::: mSkipReAuth ::: req ::: connId ::: _) = do
@@ -452,9 +450,7 @@ addClientInternalH (usr ::: mSkipReAuth ::: req ::: connId ::: _) = do
setStatus status201 . json <$> addClientInternal usr mSkipReAuth new connId
addClientInternal ::
- ( Member GalleyProvider r,
- CallsFed 'Brig "on-user-deleted-connections"
- ) =>
+ (Member GalleyProvider r) =>
UserId ->
Maybe Bool ->
NewClient ->
@@ -466,13 +462,13 @@ addClientInternal usr mSkipReAuth new connId = do
| otherwise = Data.reAuthForNewClients
API.addClientWithReAuthPolicy policy usr connId Nothing new !>> clientError
-legalHoldClientRequestedH :: (CallsFed 'Brig "on-user-deleted-connections") => UserId ::: JsonRequest LegalHoldClientRequest ::: JSON -> (Handler r) Response
+legalHoldClientRequestedH :: UserId ::: JsonRequest LegalHoldClientRequest ::: JSON -> (Handler r) Response
legalHoldClientRequestedH (targetUser ::: req ::: _) = do
clientRequest <- parseJsonBody req
lift $ API.legalHoldClientRequested targetUser clientRequest
pure $ setStatus status200 empty
-removeLegalHoldClientH :: (CallsFed 'Brig "on-user-deleted-connections") => UserId ::: JSON -> (Handler r) Response
+removeLegalHoldClientH :: UserId ::: JSON -> (Handler r) Response
removeLegalHoldClientH (uid ::: _) = do
lift $ API.removeLegalHoldClient uid
pure $ setStatus status200 empty
@@ -497,8 +493,7 @@ internalListFullClients (UserSet usrs) =
createUserNoVerify ::
( Member BlacklistStore r,
Member GalleyProvider r,
- Member (UserPendingActivationStore p) r,
- CallsFed 'Brig "on-user-deleted-connections"
+ Member (UserPendingActivationStore p) r
) =>
NewUser ->
(Handler r) (Either RegisterError SelfProfile)
@@ -516,9 +511,7 @@ createUserNoVerify uData = lift . runExceptT $ do
pure . SelfProfile $ usr
createUserNoVerifySpar ::
- ( Member GalleyProvider r,
- CallsFed 'Brig "on-user-deleted-connections"
- ) =>
+ (Member GalleyProvider r) =>
NewUserSpar ->
(Handler r) (Either CreateUserSparError SelfProfile)
createUserNoVerifySpar uData =
@@ -535,7 +528,7 @@ createUserNoVerifySpar uData =
in API.activate key code (Just uid) !>> CreateUserSparRegistrationError . activationErrorToRegisterError
pure . SelfProfile $ usr
-deleteUserNoAuthH :: (CallsFed 'Brig "on-user-deleted-connections") => UserId -> (Handler r) Response
+deleteUserNoAuthH :: UserId -> (Handler r) Response
deleteUserNoAuthH uid = do
r <- lift $ wrapHttp $ API.ensureAccountDeleted uid
case r of
@@ -638,7 +631,7 @@ newtype GetPasswordResetCodeResp = GetPasswordResetCodeResp (PasswordResetKey, P
instance ToJSON GetPasswordResetCodeResp where
toJSON (GetPasswordResetCodeResp (k, c)) = object ["key" .= k, "code" .= c]
-changeAccountStatusH :: (CallsFed 'Brig "on-user-deleted-connections") => UserId ::: JsonRequest AccountStatusUpdate -> (Handler r) Response
+changeAccountStatusH :: UserId ::: JsonRequest AccountStatusUpdate -> (Handler r) Response
changeAccountStatusH (usr ::: req) = do
status <- suStatus <$> parseJsonBody req
wrapHttpClientE (API.changeSingleAccountStatus usr status) !>> accountStatusError
@@ -675,7 +668,7 @@ getConnectionsStatus (ConnectionsStatusRequestV2 froms mtos mrel) = do
where
filterByRelation l rel = filter ((== rel) . csv2Status) l
-revokeIdentityH :: (CallsFed 'Brig "on-user-deleted-connections") => Either Email Phone -> (Handler r) Response
+revokeIdentityH :: Either Email Phone -> (Handler r) Response
revokeIdentityH emailOrPhone = do
lift $ API.revokeIdentity emailOrPhone
pure $ setStatus status200 empty
@@ -722,7 +715,7 @@ addPhonePrefixH (_ ::: req) = do
void . lift $ API.phonePrefixInsert prefix
pure empty
-updateSSOIdH :: (CallsFed 'Brig "on-user-deleted-connections") => UserId ::: JSON ::: JsonRequest UserSSOId -> (Handler r) Response
+updateSSOIdH :: UserId ::: JSON ::: JsonRequest UserSSOId -> (Handler r) Response
updateSSOIdH (uid ::: _ ::: req) = do
ssoid :: UserSSOId <- parseJsonBody req
success <- lift $ wrapClient $ Data.updateSSOId uid (Just ssoid)
@@ -732,7 +725,7 @@ updateSSOIdH (uid ::: _ ::: req) = do
pure empty
else pure . setStatus status404 $ plain "User does not exist or has no team."
-deleteSSOIdH :: (CallsFed 'Brig "on-user-deleted-connections") => UserId ::: JSON -> (Handler r) Response
+deleteSSOIdH :: UserId ::: JSON -> (Handler r) Response
deleteSSOIdH (uid ::: _) = do
success <- lift $ wrapClient $ Data.updateSSOId uid Nothing
if success
@@ -788,18 +781,18 @@ getRichInfoMulti :: [UserId] -> (Handler r) [(UserId, RichInfo)]
getRichInfoMulti uids =
lift (wrapClient $ API.lookupRichInfoMultiUsers uids)
-updateHandleH :: (CallsFed 'Brig "on-user-deleted-connections") => UserId ::: JSON ::: JsonRequest HandleUpdate -> (Handler r) Response
+updateHandleH :: UserId ::: JSON ::: JsonRequest HandleUpdate -> (Handler r) Response
updateHandleH (uid ::: _ ::: body) = empty <$ (updateHandle uid =<< parseJsonBody body)
-updateHandle :: (CallsFed 'Brig "on-user-deleted-connections") => UserId -> HandleUpdate -> (Handler r) ()
+updateHandle :: UserId -> HandleUpdate -> (Handler r) ()
updateHandle uid (HandleUpdate handleUpd) = do
handle <- validateHandle handleUpd
API.changeHandle uid Nothing handle API.AllowSCIMUpdates !>> changeHandleError
-updateUserNameH :: (CallsFed 'Brig "on-user-deleted-connections") => UserId ::: JSON ::: JsonRequest NameUpdate -> (Handler r) Response
+updateUserNameH :: UserId ::: JSON ::: JsonRequest NameUpdate -> (Handler r) Response
updateUserNameH (uid ::: _ ::: body) = empty <$ (updateUserName uid =<< parseJsonBody body)
-updateUserName :: (CallsFed 'Brig "on-user-deleted-connections") => UserId -> NameUpdate -> (Handler r) ()
+updateUserName :: UserId -> NameUpdate -> (Handler r) ()
updateUserName uid (NameUpdate nameUpd) = do
name <- either (const $ throwStd (errorToWai @'E.InvalidUser)) pure $ mkName nameUpd
let uu =
diff --git a/services/brig/src/Brig/API/MLS/KeyPackages.hs b/services/brig/src/Brig/API/MLS/KeyPackages.hs
index 63379c4de8..74742fe176 100644
--- a/services/brig/src/Brig/API/MLS/KeyPackages.hs
+++ b/services/brig/src/Brig/API/MLS/KeyPackages.hs
@@ -55,7 +55,6 @@ uploadKeyPackages lusr cid (kpuKeyPackages -> kps) = do
lift . wrapClient $ Data.insertKeyPackages (tUnqualified lusr) cid kps'
claimKeyPackages ::
- CallsFed 'Brig "claim-key-packages" =>
Local UserId ->
Qualified UserId ->
Maybe ClientId ->
@@ -97,7 +96,6 @@ claimLocalKeyPackages qusr skipOwn target = do
<$> wrapClientM (Data.claimKeyPackage target c)
claimRemoteKeyPackages ::
- CallsFed 'Brig "claim-key-packages" =>
Local UserId ->
Remote UserId ->
Handler r KeyPackageBundle
diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs
index 7c194f07ea..0eaefc2f7d 100644
--- a/services/brig/src/Brig/API/Public.hs
+++ b/services/brig/src/Brig/API/Public.hs
@@ -237,35 +237,35 @@ servantSitemap =
where
userAPI :: ServerT UserAPI (Handler r)
userAPI =
- Named @"get-user-unqualified" (callsFed getUserUnqualifiedH)
- :<|> Named @"get-user-qualified" (callsFed getUser)
+ Named @"get-user-unqualified" (callsFed (exposeAnnotations getUserUnqualifiedH))
+ :<|> Named @"get-user-qualified" (callsFed (exposeAnnotations getUser))
:<|> Named @"update-user-email" updateUserEmail
- :<|> Named @"get-handle-info-unqualified" (callsFed getHandleInfoUnqualifiedH)
- :<|> Named @"get-user-by-handle-qualified" (callsFed Handle.getHandleInfo)
- :<|> Named @"list-users-by-unqualified-ids-or-handles" (callsFed listUsersByUnqualifiedIdsOrHandles)
- :<|> Named @"list-users-by-ids-or-handles" (callsFed listUsersByIdsOrHandles)
+ :<|> Named @"get-handle-info-unqualified" (callsFed (exposeAnnotations getHandleInfoUnqualifiedH))
+ :<|> Named @"get-user-by-handle-qualified" (callsFed (exposeAnnotations Handle.getHandleInfo))
+ :<|> Named @"list-users-by-unqualified-ids-or-handles" (callsFed (exposeAnnotations listUsersByUnqualifiedIdsOrHandles))
+ :<|> Named @"list-users-by-ids-or-handles" (callsFed (exposeAnnotations listUsersByIdsOrHandles))
:<|> Named @"send-verification-code" sendVerificationCode
:<|> Named @"get-rich-info" getRichInfo
selfAPI :: ServerT SelfAPI (Handler r)
selfAPI =
Named @"get-self" getSelf
- :<|> Named @"delete-self" (callsFed deleteSelfUser)
- :<|> Named @"put-self" (callsFed updateUser)
+ :<|> Named @"delete-self" (callsFed (exposeAnnotations deleteSelfUser))
+ :<|> Named @"put-self" (callsFed (exposeAnnotations updateUser))
:<|> Named @"change-phone" changePhone
- :<|> Named @"remove-phone" (callsFed removePhone)
- :<|> Named @"remove-email" (callsFed removeEmail)
+ :<|> Named @"remove-phone" (callsFed (exposeAnnotations removePhone))
+ :<|> Named @"remove-email" (callsFed (exposeAnnotations removeEmail))
:<|> Named @"check-password-exists" checkPasswordExists
:<|> Named @"change-password" changePassword
- :<|> Named @"change-locale" (callsFed changeLocale)
- :<|> Named @"change-handle" (callsFed changeHandle)
+ :<|> Named @"change-locale" (callsFed (exposeAnnotations changeLocale))
+ :<|> Named @"change-handle" (callsFed (exposeAnnotations changeHandle))
accountAPI :: ServerT AccountAPI (Handler r)
accountAPI =
- Named @"register" (callsFed createUser)
- :<|> Named @"verify-delete" (callsFed verifyDeleteUser)
- :<|> Named @"get-activate" (callsFed activate)
- :<|> Named @"post-activate" (callsFed activateKey)
+ Named @"register" (callsFed (exposeAnnotations createUser))
+ :<|> Named @"verify-delete" (callsFed (exposeAnnotations verifyDeleteUser))
+ :<|> Named @"get-activate" (callsFed (exposeAnnotations activate))
+ :<|> Named @"post-activate" (callsFed (exposeAnnotations activateKey))
:<|> Named @"post-activate-send" sendActivationCode
:<|> Named @"post-password-reset" beginPasswordReset
:<|> Named @"post-password-reset-complete" completePasswordReset
@@ -274,27 +274,29 @@ servantSitemap =
clientAPI :: ServerT ClientAPI (Handler r)
clientAPI =
- Named @"get-user-clients-unqualified" (callsFed getUserClientsUnqualified)
- :<|> Named @"get-user-clients-qualified" (callsFed getUserClientsQualified)
- :<|> Named @"get-user-client-unqualified" (callsFed getUserClientUnqualified)
- :<|> Named @"get-user-client-qualified" (callsFed getUserClientQualified)
- :<|> Named @"list-clients-bulk" (callsFed listClientsBulk)
- :<|> Named @"list-clients-bulk-v2" (callsFed listClientsBulkV2)
- :<|> Named @"list-clients-bulk@v2" (callsFed listClientsBulkV2)
+ Named @"get-user-clients-unqualified" (callsFed (exposeAnnotations getUserClientsUnqualified))
+ :<|> Named @"get-user-clients-qualified" (callsFed (exposeAnnotations getUserClientsQualified))
+ :<|> Named @"get-user-client-unqualified" (callsFed (exposeAnnotations getUserClientUnqualified))
+ :<|> Named @"get-user-client-qualified" (callsFed (exposeAnnotations getUserClientQualified))
+ :<|> Named @"list-clients-bulk" (callsFed (exposeAnnotations listClientsBulk))
+ :<|> Named @"list-clients-bulk-v2" (callsFed (exposeAnnotations listClientsBulkV2))
+ :<|> Named @"list-clients-bulk@v2" (callsFed (exposeAnnotations listClientsBulkV2))
prekeyAPI :: ServerT PrekeyAPI (Handler r)
prekeyAPI =
- Named @"get-users-prekeys-client-unqualified" (callsFed getPrekeyUnqualifiedH)
- :<|> Named @"get-users-prekeys-client-qualified" (callsFed getPrekeyH)
- :<|> Named @"get-users-prekey-bundle-unqualified" (callsFed getPrekeyBundleUnqualifiedH)
- :<|> Named @"get-users-prekey-bundle-qualified" (callsFed getPrekeyBundleH)
+ Named @"get-users-prekeys-client-unqualified" (callsFed (exposeAnnotations getPrekeyUnqualifiedH))
+ :<|> Named @"get-users-prekeys-client-qualified" (callsFed (exposeAnnotations getPrekeyH))
+ :<|> Named @"get-users-prekey-bundle-unqualified" (callsFed (exposeAnnotations getPrekeyBundleUnqualifiedH))
+ :<|> Named @"get-users-prekey-bundle-qualified" (callsFed (exposeAnnotations getPrekeyBundleH))
:<|> Named @"get-multi-user-prekey-bundle-unqualified" getMultiUserPrekeyBundleUnqualifiedH
- :<|> Named @"get-multi-user-prekey-bundle-qualified" (callsFed getMultiUserPrekeyBundleH)
+ :<|> Named @"get-multi-user-prekey-bundle-qualified" (callsFed (exposeAnnotations getMultiUserPrekeyBundleH))
userClientAPI :: ServerT UserClientAPI (Handler r)
userClientAPI =
- Named @"add-client" (callsFed addClient)
- :<|> Named @"update-client" updateClient
+ Named @"add-client" (callsFed (exposeAnnotations addClient))
+ :<|> Named
+ @"update-client"
+ updateClient
:<|> Named @"delete-client" deleteClient
:<|> Named @"list-clients" listClients
:<|> Named @"get-client" getClient
@@ -306,15 +308,15 @@ servantSitemap =
connectionAPI :: ServerT ConnectionAPI (Handler r)
connectionAPI =
- Named @"create-connection-unqualified" (callsFed createConnectionUnqualified)
- :<|> Named @"create-connection" (callsFed createConnection)
+ Named @"create-connection-unqualified" (callsFed (exposeAnnotations createConnectionUnqualified))
+ :<|> Named @"create-connection" (callsFed (exposeAnnotations createConnection))
:<|> Named @"list-local-connections" listLocalConnections
:<|> Named @"list-connections" listConnections
:<|> Named @"get-connection-unqualified" getLocalConnection
:<|> Named @"get-connection" getConnection
- :<|> Named @"update-connection-unqualified" (callsFed updateLocalConnection)
- :<|> Named @"update-connection" (callsFed updateConnection)
- :<|> Named @"search-contacts" (callsFed Search.search)
+ :<|> Named @"update-connection-unqualified" (callsFed (exposeAnnotations updateLocalConnection))
+ :<|> Named @"update-connection" (callsFed (exposeAnnotations updateConnection))
+ :<|> Named @"search-contacts" (callsFed (exposeAnnotations Search.search))
propertiesAPI :: ServerT PropertiesAPI (Handler r)
propertiesAPI =
@@ -329,7 +331,7 @@ servantSitemap =
mlsAPI :: ServerT MLSAPI (Handler r)
mlsAPI =
Named @"mls-key-packages-upload" uploadKeyPackages
- :<|> Named @"mls-key-packages-claim" (callsFed claimKeyPackages)
+ :<|> Named @"mls-key-packages-claim" (callsFed (exposeAnnotations claimKeyPackages))
:<|> Named @"mls-key-packages-count" countKeyPackages
userHandleAPI :: ServerT UserHandleAPI (Handler r)
@@ -343,9 +345,9 @@ servantSitemap =
authAPI :: ServerT AuthAPI (Handler r)
authAPI =
- Named @"access" (callsFed accessH)
+ Named @"access" (callsFed (exposeAnnotations accessH))
:<|> Named @"send-login-code" sendLoginCode
- :<|> Named @"login" (callsFed login)
+ :<|> Named @"login" (callsFed (exposeAnnotations login))
:<|> Named @"logout" logoutH
:<|> Named @"change-self-email" changeSelfEmailH
:<|> Named @"list-cookies" listCookies
@@ -433,22 +435,22 @@ listPropertyKeysAndValues u = do
keysAndVals <- fmap Map.fromList . lift $ wrapClient (API.lookupPropertyKeysAndValues u)
Public.PropertyKeysAndValues <$> traverse parseStoredPropertyValue keysAndVals
-getPrekeyUnqualifiedH :: (CallsFed 'Brig "claim-prekey") => UserId -> UserId -> ClientId -> (Handler r) Public.ClientPrekey
+getPrekeyUnqualifiedH :: UserId -> UserId -> ClientId -> (Handler r) Public.ClientPrekey
getPrekeyUnqualifiedH zusr user client = do
domain <- viewFederationDomain
getPrekeyH zusr (Qualified user domain) client
-getPrekeyH :: (CallsFed 'Brig "claim-prekey") => UserId -> Qualified UserId -> ClientId -> (Handler r) Public.ClientPrekey
+getPrekeyH :: UserId -> Qualified UserId -> ClientId -> (Handler r) Public.ClientPrekey
getPrekeyH zusr (Qualified user domain) client = do
mPrekey <- API.claimPrekey (ProtectedUser zusr) user domain client !>> clientError
ifNothing (notFound "prekey not found") mPrekey
-getPrekeyBundleUnqualifiedH :: (CallsFed 'Brig "claim-prekey-bundle") => UserId -> UserId -> (Handler r) Public.PrekeyBundle
+getPrekeyBundleUnqualifiedH :: UserId -> UserId -> (Handler r) Public.PrekeyBundle
getPrekeyBundleUnqualifiedH zusr uid = do
domain <- viewFederationDomain
API.claimPrekeyBundle (ProtectedUser zusr) domain uid !>> clientError
-getPrekeyBundleH :: (CallsFed 'Brig "claim-prekey-bundle") => UserId -> Qualified UserId -> (Handler r) Public.PrekeyBundle
+getPrekeyBundleH :: UserId -> Qualified UserId -> (Handler r) Public.PrekeyBundle
getPrekeyBundleH zusr (Qualified uid domain) =
API.claimPrekeyBundle (ProtectedUser zusr) domain uid !>> clientError
@@ -464,7 +466,7 @@ getMultiUserPrekeyBundleUnqualifiedH zusr userClients = do
API.claimLocalMultiPrekeyBundles (ProtectedUser zusr) userClients !>> clientError
getMultiUserPrekeyBundleH ::
- (Member (Concurrency 'Unsafe) r, CallsFed 'Brig "claim-multi-prekey-bundle") =>
+ (Member (Concurrency 'Unsafe) r) =>
UserId ->
Public.QualifiedUserClients ->
(Handler r) Public.QualifiedUserClientPrekeyMap
@@ -479,9 +481,7 @@ getMultiUserPrekeyBundleH zusr qualUserClients = do
API.claimMultiPrekeyBundles (ProtectedUser zusr) qualUserClients !>> clientError
addClient ::
- ( Member GalleyProvider r,
- CallsFed 'Brig "on-user-deleted-connections"
- ) =>
+ (Member GalleyProvider r) =>
UserId ->
ConnId ->
Maybe IpAddr ->
@@ -512,28 +512,28 @@ listClients zusr =
getClient :: UserId -> ClientId -> (Handler r) (Maybe Public.Client)
getClient zusr clientId = lift $ API.lookupLocalClient zusr clientId
-getUserClientsUnqualified :: (CallsFed 'Brig "get-user-clients") => UserId -> (Handler r) [Public.PubClient]
+getUserClientsUnqualified :: UserId -> (Handler r) [Public.PubClient]
getUserClientsUnqualified uid = do
localdomain <- viewFederationDomain
API.lookupPubClients (Qualified uid localdomain) !>> clientError
-getUserClientsQualified :: (CallsFed 'Brig "get-user-clients") => Qualified UserId -> (Handler r) [Public.PubClient]
+getUserClientsQualified :: Qualified UserId -> (Handler r) [Public.PubClient]
getUserClientsQualified quid = API.lookupPubClients quid !>> clientError
-getUserClientUnqualified :: (CallsFed 'Brig "get-user-clients") => UserId -> ClientId -> (Handler r) Public.PubClient
+getUserClientUnqualified :: UserId -> ClientId -> (Handler r) Public.PubClient
getUserClientUnqualified uid cid = do
localdomain <- viewFederationDomain
x <- API.lookupPubClient (Qualified uid localdomain) cid !>> clientError
ifNothing (notFound "client not found") x
-listClientsBulk :: (CallsFed 'Brig "get-user-clients") => UserId -> Range 1 MaxUsersForListClientsBulk [Qualified UserId] -> (Handler r) (Public.QualifiedUserMap (Set Public.PubClient))
+listClientsBulk :: UserId -> Range 1 MaxUsersForListClientsBulk [Qualified UserId] -> (Handler r) (Public.QualifiedUserMap (Set Public.PubClient))
listClientsBulk _zusr limitedUids =
API.lookupPubClientsBulk (fromRange limitedUids) !>> clientError
-listClientsBulkV2 :: (CallsFed 'Brig "get-user-clients") => UserId -> Public.LimitedQualifiedUserIdList MaxUsersForListClientsBulk -> (Handler r) (Public.WrappedQualifiedUserMap (Set Public.PubClient))
+listClientsBulkV2 :: UserId -> Public.LimitedQualifiedUserIdList MaxUsersForListClientsBulk -> (Handler r) (Public.WrappedQualifiedUserMap (Set Public.PubClient))
listClientsBulkV2 zusr userIds = Public.Wrapped <$> listClientsBulk zusr (Public.qualifiedUsers userIds)
-getUserClientQualified :: (CallsFed 'Brig "get-user-clients") => Qualified UserId -> ClientId -> (Handler r) Public.PubClient
+getUserClientQualified :: Qualified UserId -> ClientId -> (Handler r) Public.PubClient
getUserClientQualified quid cid = do
x <- API.lookupPubClient quid cid !>> clientError
ifNothing (notFound "client not found") x
@@ -591,8 +591,7 @@ createAccessToken method uid cid proof = do
createUser ::
( Member BlacklistStore r,
Member GalleyProvider r,
- Member (UserPendingActivationStore p) r,
- CallsFed 'Brig "on-user-deleted-connections"
+ Member (UserPendingActivationStore p) r
) =>
Public.NewUserPublic ->
(Handler r) (Either Public.RegisterError Public.RegisterSuccess)
@@ -670,9 +669,7 @@ getSelf self =
>>= ifNothing (errorToWai @'E.UserNotFound)
getUserUnqualifiedH ::
- ( Member GalleyProvider r,
- CallsFed 'Brig "get-users-by-ids"
- ) =>
+ (Member GalleyProvider r) =>
UserId ->
UserId ->
(Handler r) (Maybe Public.UserProfile)
@@ -681,9 +678,7 @@ getUserUnqualifiedH self uid = do
getUser self (Qualified uid domain)
getUser ::
- ( Member GalleyProvider r,
- CallsFed 'Brig "get-users-by-ids"
- ) =>
+ (Member GalleyProvider r) =>
UserId ->
Qualified UserId ->
(Handler r) (Maybe Public.UserProfile)
@@ -694,8 +689,7 @@ getUser self qualifiedUserId = do
-- FUTUREWORK: Make servant understand that at least one of these is required
listUsersByUnqualifiedIdsOrHandles ::
( Member GalleyProvider r,
- Member (Concurrency 'Unsafe) r,
- CallsFed 'Brig "get-users-by-ids"
+ Member (Concurrency 'Unsafe) r
) =>
UserId ->
Maybe (CommaSeparatedList UserId) ->
@@ -719,8 +713,7 @@ listUsersByUnqualifiedIdsOrHandles self mUids mHandles = do
listUsersByIdsOrHandles ::
forall r.
( Member GalleyProvider r,
- Member (Concurrency 'Unsafe) r,
- CallsFed 'Brig "get-users-by-ids"
+ Member (Concurrency 'Unsafe) r
) =>
UserId ->
Public.ListUsersQuery ->
@@ -752,7 +745,7 @@ newtype GetActivationCodeResp
instance ToJSON GetActivationCodeResp where
toJSON (GetActivationCodeResp (k, c)) = object ["key" .= k, "code" .= c]
-updateUser :: (CallsFed 'Brig "on-user-deleted-connections") => UserId -> ConnId -> Public.UserUpdate -> (Handler r) (Maybe Public.UpdateProfileError)
+updateUser :: UserId -> ConnId -> Public.UserUpdate -> (Handler r) (Maybe Public.UpdateProfileError)
updateUser uid conn uu = do
eithErr <- lift $ runExceptT $ API.updateUser uid (Just conn) uu API.ForbidSCIMUpdates
pure $ either Just (const Nothing) eithErr
@@ -771,11 +764,11 @@ changePhone u _ (Public.puPhone -> phone) = lift . exceptTToMaybe $ do
let apair = (activationKey adata, activationCode adata)
lift . wrapClient $ sendActivationSms pn apair loc
-removePhone :: (CallsFed 'Brig "on-user-deleted-connections") => UserId -> ConnId -> (Handler r) (Maybe Public.RemoveIdentityError)
+removePhone :: UserId -> ConnId -> (Handler r) (Maybe Public.RemoveIdentityError)
removePhone self conn =
lift . exceptTToMaybe $ API.removePhone self conn
-removeEmail :: (CallsFed 'Brig "on-user-deleted-connections") => UserId -> ConnId -> (Handler r) (Maybe Public.RemoveIdentityError)
+removeEmail :: UserId -> ConnId -> (Handler r) (Maybe Public.RemoveIdentityError)
removeEmail self conn =
lift . exceptTToMaybe $ API.removeEmail self conn
@@ -785,7 +778,7 @@ checkPasswordExists = fmap isJust . lift . wrapClient . API.lookupPassword
changePassword :: UserId -> Public.PasswordChange -> (Handler r) (Maybe Public.ChangePasswordError)
changePassword u cp = lift . exceptTToMaybe $ API.changePassword u cp
-changeLocale :: (CallsFed 'Brig "on-user-deleted-connections") => UserId -> ConnId -> Public.LocaleUpdate -> (Handler r) ()
+changeLocale :: UserId -> ConnId -> Public.LocaleUpdate -> (Handler r) ()
changeLocale u conn l = lift $ API.changeLocale u conn l
-- | (zusr is ignored by this handler, ie. checking handles is allowed as long as you have
@@ -809,9 +802,7 @@ checkHandles _ (Public.CheckHandles hs num) = do
-- 'Handle.getHandleInfo') returns UserProfile to reduce traffic between backends
-- in a federated scenario.
getHandleInfoUnqualifiedH ::
- ( Member GalleyProvider r,
- CallsFed 'Brig "get-user-by-handle",
- CallsFed 'Brig "get-users-by-ids"
+ ( Member GalleyProvider r
) =>
UserId ->
Handle ->
@@ -821,7 +812,7 @@ getHandleInfoUnqualifiedH self handle = do
Public.UserHandleInfo . Public.profileQualifiedId
<$$> Handle.getHandleInfo self (Qualified handle domain)
-changeHandle :: (CallsFed 'Brig "on-user-deleted-connections") => UserId -> ConnId -> Public.HandleUpdate -> (Handler r) (Maybe Public.ChangeHandleError)
+changeHandle :: UserId -> ConnId -> Public.HandleUpdate -> (Handler r) (Maybe Public.ChangeHandleError)
changeHandle u conn (Public.HandleUpdate h) = lift . exceptTToMaybe $ do
handle <- maybe (throwError Public.ChangeHandleInvalid) pure $ parseHandle h
API.changeHandle u (Just conn) handle API.ForbidSCIMUpdates
@@ -878,9 +869,7 @@ customerExtensionCheckBlockedDomains email = do
customerExtensionBlockedDomain domain
createConnectionUnqualified ::
- ( Member GalleyProvider r,
- CallsFed 'Brig "send-connection-action"
- ) =>
+ (Member GalleyProvider r) =>
UserId ->
ConnId ->
Public.ConnectionRequest ->
@@ -891,9 +880,7 @@ createConnectionUnqualified self conn cr = do
API.createConnection lself conn (tUntagged target) !>> connError
createConnection ::
- ( Member GalleyProvider r,
- CallsFed 'Brig "send-connection-action"
- ) =>
+ (Member GalleyProvider r) =>
UserId ->
ConnId ->
Qualified UserId ->
@@ -902,12 +889,12 @@ createConnection self conn target = do
lself <- qualifyLocal self
API.createConnection lself conn target !>> connError
-updateLocalConnection :: (CallsFed 'Brig "send-connection-action") => UserId -> ConnId -> UserId -> Public.ConnectionUpdate -> (Handler r) (Public.UpdateResult Public.UserConnection)
+updateLocalConnection :: UserId -> ConnId -> UserId -> Public.ConnectionUpdate -> (Handler r) (Public.UpdateResult Public.UserConnection)
updateLocalConnection self conn other update = do
lother <- qualifyLocal other
updateConnection self conn (tUntagged lother) update
-updateConnection :: (CallsFed 'Brig "send-connection-action") => UserId -> ConnId -> Qualified UserId -> Public.ConnectionUpdate -> (Handler r) (Public.UpdateResult Public.UserConnection)
+updateConnection :: UserId -> ConnId -> Qualified UserId -> Public.ConnectionUpdate -> (Handler r) (Public.UpdateResult Public.UserConnection)
updateConnection self conn other update = do
let newStatus = Public.cuStatus update
lself <- qualifyLocal self
@@ -973,16 +960,14 @@ getConnection self other = do
lift . wrapClient $ Data.lookupConnection lself other
deleteSelfUser ::
- ( Member GalleyProvider r,
- CallsFed 'Brig "on-user-deleted-connections"
- ) =>
+ (Member GalleyProvider r) =>
UserId ->
Public.DeleteUser ->
(Handler r) (Maybe Code.Timeout)
deleteSelfUser u body =
API.deleteSelfUser u (Public.deleteUserPassword body) !>> deleteUserError
-verifyDeleteUser :: (CallsFed 'Brig "on-user-deleted-connections") => Public.VerifyDeleteUser -> Handler r ()
+verifyDeleteUser :: Public.VerifyDeleteUser -> Handler r ()
verifyDeleteUser body = API.verifyDeleteUser body !>> deleteUserError
updateUserEmail ::
@@ -1017,9 +1002,7 @@ updateUserEmail zuserId emailOwnerId (Public.EmailUpdate email) = do
-- activation
activate ::
- ( Member GalleyProvider r,
- CallsFed 'Brig "on-user-deleted-connections"
- ) =>
+ (Member GalleyProvider r) =>
Public.ActivationKey ->
Public.ActivationCode ->
(Handler r) ActivationRespWithStatus
@@ -1029,9 +1012,7 @@ activate k c = do
-- docs/reference/user/activation.md {#RefActivationSubmit}
activateKey ::
- ( Member GalleyProvider r,
- CallsFed 'Brig "on-user-deleted-connections"
- ) =>
+ (Member GalleyProvider r) =>
Public.Activate ->
(Handler r) ActivationRespWithStatus
activateKey (Public.Activate tgt code dryrun)
diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs
index 55f9336c08..d8944a4ea4 100644
--- a/services/brig/src/Brig/API/User.hs
+++ b/services/brig/src/Brig/API/User.hs
@@ -171,7 +171,6 @@ import UnliftIO.Async
import Wire.API.Connection
import Wire.API.Error
import qualified Wire.API.Error.Brig as E
-import Wire.API.Federation.API
import Wire.API.Federation.Error
import Wire.API.Routes.Internal.Brig.Connection
import qualified Wire.API.Routes.Internal.Galley.TeamsIntra as Team
@@ -228,9 +227,7 @@ verifyUniquenessAndCheckBlacklist uk = do
createUserSpar ::
forall r.
- ( Member GalleyProvider r,
- CallsFed 'Brig "on-user-deleted-connections"
- ) =>
+ (Member GalleyProvider r) =>
NewUserSpar ->
ExceptT CreateUserSparError (AppT r) CreateUserResult
createUserSpar new = do
@@ -295,8 +292,7 @@ createUser ::
forall r p.
( Member BlacklistStore r,
Member GalleyProvider r,
- Member (UserPendingActivationStore p) r,
- CallsFed 'Brig "on-user-deleted-connections"
+ Member (UserPendingActivationStore p) r
) =>
NewUser ->
ExceptT RegisterError (AppT r) CreateUserResult
@@ -578,7 +574,7 @@ checkRestrictedUserCreation new = do
-------------------------------------------------------------------------------
-- Update Profile
-updateUser :: CallsFed 'Brig "on-user-deleted-connections" => UserId -> Maybe ConnId -> UserUpdate -> AllowSCIMUpdates -> ExceptT UpdateProfileError (AppT r) ()
+updateUser :: UserId -> Maybe ConnId -> UserUpdate -> AllowSCIMUpdates -> ExceptT UpdateProfileError (AppT r) ()
updateUser uid mconn uu allowScim = do
for_ (uupName uu) $ \newName -> do
mbUser <- lift . wrapClient $ Data.lookupUser WithPendingInvitations uid
@@ -596,7 +592,7 @@ updateUser uid mconn uu allowScim = do
-------------------------------------------------------------------------------
-- Update Locale
-changeLocale :: CallsFed 'Brig "on-user-deleted-connections" => UserId -> ConnId -> LocaleUpdate -> (AppT r) ()
+changeLocale :: UserId -> ConnId -> LocaleUpdate -> (AppT r) ()
changeLocale uid conn (LocaleUpdate loc) = do
wrapClient $ Data.updateLocale uid loc
wrapHttpClient $ Intra.onUserEvent uid (Just conn) (localeUpdate uid loc)
@@ -604,7 +600,7 @@ changeLocale uid conn (LocaleUpdate loc) = do
-------------------------------------------------------------------------------
-- Update ManagedBy
-changeManagedBy :: CallsFed 'Brig "on-user-deleted-connections" => UserId -> ConnId -> ManagedByUpdate -> (AppT r) ()
+changeManagedBy :: UserId -> ConnId -> ManagedByUpdate -> (AppT r) ()
changeManagedBy uid conn (ManagedByUpdate mb) = do
wrapClient $ Data.updateManagedBy uid mb
wrapHttpClient $ Intra.onUserEvent uid (Just conn) (managedByUpdate uid mb)
@@ -612,7 +608,7 @@ changeManagedBy uid conn (ManagedByUpdate mb) = do
--------------------------------------------------------------------------------
-- Change Handle
-changeHandle :: CallsFed 'Brig "on-user-deleted-connections" => UserId -> Maybe ConnId -> Handle -> AllowSCIMUpdates -> ExceptT ChangeHandleError (AppT r) ()
+changeHandle :: UserId -> Maybe ConnId -> Handle -> AllowSCIMUpdates -> ExceptT ChangeHandleError (AppT r) ()
changeHandle uid mconn hdl allowScim = do
when (isBlacklistedHandle hdl) $
throwE ChangeHandleInvalid
@@ -768,7 +764,7 @@ changePhone u phone = do
-------------------------------------------------------------------------------
-- Remove Email
-removeEmail :: CallsFed 'Brig "on-user-deleted-connections" => UserId -> ConnId -> ExceptT RemoveIdentityError (AppT r) ()
+removeEmail :: UserId -> ConnId -> ExceptT RemoveIdentityError (AppT r) ()
removeEmail uid conn = do
ident <- lift $ fetchUserIdentity uid
case ident of
@@ -782,7 +778,7 @@ removeEmail uid conn = do
-------------------------------------------------------------------------------
-- Remove Phone
-removePhone :: CallsFed 'Brig "on-user-deleted-connections" => UserId -> ConnId -> ExceptT RemoveIdentityError (AppT r) ()
+removePhone :: UserId -> ConnId -> ExceptT RemoveIdentityError (AppT r) ()
removePhone uid conn = do
ident <- lift $ fetchUserIdentity uid
case ident of
@@ -800,7 +796,7 @@ removePhone uid conn = do
-------------------------------------------------------------------------------
-- Forcefully revoke a verified identity
-revokeIdentity :: CallsFed 'Brig "on-user-deleted-connections" => Either Email Phone -> AppT r ()
+revokeIdentity :: Either Email Phone -> AppT r ()
revokeIdentity key = do
let uk = either userEmailKey userPhoneKey key
mu <- wrapClient $ Data.lookupKey uk
@@ -844,8 +840,7 @@ changeAccountStatus ::
MonadMask m,
MonadHttp m,
HasRequestId m,
- MonadUnliftIO m,
- CallsFed 'Brig "on-user-deleted-connections"
+ MonadUnliftIO m
) =>
List1 UserId ->
AccountStatus ->
@@ -871,8 +866,7 @@ changeSingleAccountStatus ::
MonadMask m,
MonadHttp m,
HasRequestId m,
- MonadUnliftIO m,
- CallsFed 'Brig "on-user-deleted-connections"
+ MonadUnliftIO m
) =>
UserId ->
AccountStatus ->
@@ -897,7 +891,7 @@ mkUserEvent usrs status =
-- Activation
activate ::
- (Member GalleyProvider r, CallsFed 'Brig "on-user-deleted-connections") =>
+ (Member GalleyProvider r) =>
ActivationTarget ->
ActivationCode ->
-- | The user for whom to activate the key.
@@ -906,7 +900,7 @@ activate ::
activate tgt code usr = activateWithCurrency tgt code usr Nothing
activateWithCurrency ::
- (Member GalleyProvider r, CallsFed 'Brig "on-user-deleted-connections") =>
+ (Member GalleyProvider r) =>
ActivationTarget ->
ActivationCode ->
-- | The user for whom to activate the key.
@@ -946,7 +940,7 @@ preverify tgt code = do
key <- mkActivationKey tgt
void $ Data.verifyCode key code
-onActivated :: CallsFed 'Brig "on-user-deleted-connections" => ActivationEvent -> (AppT r) (UserId, Maybe UserIdentity, Bool)
+onActivated :: ActivationEvent -> (AppT r) (UserId, Maybe UserIdentity, Bool)
onActivated (AccountActivated account) = do
let uid = userId (accountUser account)
Log.debug $ field "user" (toByteString uid) . field "action" (Log.val "User.onActivated")
@@ -1163,9 +1157,7 @@ mkPasswordResetKey ident = case ident of
-- TODO: communicate deletions of SSO users to SSO service.
deleteSelfUser ::
forall r.
- ( Member GalleyProvider r,
- CallsFed 'Brig "on-user-deleted-connections"
- ) =>
+ (Member GalleyProvider r) =>
UserId ->
Maybe PlainTextPassword ->
ExceptT DeleteUserError (AppT r) (Maybe Timeout)
@@ -1241,7 +1233,7 @@ deleteSelfUser uid pwd = do
-- | Conclude validation and scheduling of user's deletion request that was initiated in
-- 'deleteUser'. Called via @post /delete@.
-verifyDeleteUser :: CallsFed 'Brig "on-user-deleted-connections" => VerifyDeleteUser -> ExceptT DeleteUserError (AppT r) ()
+verifyDeleteUser :: VerifyDeleteUser -> ExceptT DeleteUserError (AppT r) ()
verifyDeleteUser d = do
let key = verifyDeleteUserKey d
let code = verifyDeleteUserCode d
@@ -1261,8 +1253,7 @@ ensureAccountDeleted ::
HasRequestId m,
MonadUnliftIO m,
MonadClient m,
- MonadReader Env m,
- CallsFed 'Brig "on-user-deleted-connections"
+ MonadReader Env m
) =>
UserId ->
m DeleteUserResult
@@ -1307,8 +1298,7 @@ deleteAccount ::
MonadHttp m,
HasRequestId m,
MonadUnliftIO m,
- MonadClient m,
- CallsFed 'Brig "on-user-deleted-connections"
+ MonadClient m
) =>
UserAccount ->
m ()
@@ -1417,7 +1407,7 @@ userGC u = case userExpire u of
pure u
lookupProfile ::
- (Member GalleyProvider r, CallsFed 'Brig "get-users-by-ids") =>
+ (Member GalleyProvider r) =>
Local UserId ->
Qualified UserId ->
ExceptT FederationError (AppT r) (Maybe UserProfile)
@@ -1434,8 +1424,7 @@ lookupProfile self other =
-- If 'self' is an unknown 'UserId', return '[]'.
lookupProfiles ::
( Member GalleyProvider r,
- Member (Concurrency 'Unsafe) r,
- CallsFed 'Brig "get-users-by-ids"
+ Member (Concurrency 'Unsafe) r
) =>
-- | User 'self' on whose behalf the profiles are requested.
Local UserId ->
@@ -1449,7 +1438,7 @@ lookupProfiles self others =
(bucketQualified others)
lookupProfilesFromDomain ::
- (Member GalleyProvider r, CallsFed 'Brig "get-users-by-ids") =>
+ (Member GalleyProvider r) =>
Local UserId ->
Qualified [UserId] ->
ExceptT FederationError (AppT r) [UserProfile]
@@ -1462,8 +1451,7 @@ lookupProfilesFromDomain self =
lookupRemoteProfiles ::
( MonadIO m,
MonadReader Env m,
- MonadLogger m,
- CallsFed 'Brig "get-users-by-ids"
+ MonadLogger m
) =>
Remote [UserId] ->
ExceptT FederationError m [UserProfile]
diff --git a/services/brig/src/Brig/Federation/Client.hs b/services/brig/src/Brig/Federation/Client.hs
index 37eb4924ba..1b38057912 100644
--- a/services/brig/src/Brig/Federation/Client.hs
+++ b/services/brig/src/Brig/Federation/Client.hs
@@ -47,7 +47,6 @@ import Wire.API.UserMap
getUserHandleInfo ::
( MonadReader Env m,
MonadIO m,
- CallsFed 'Brig "get-user-by-handle",
Log.MonadLogger m
) =>
Remote Handle ->
@@ -59,7 +58,6 @@ getUserHandleInfo (tUntagged -> Qualified handle domain) = do
getUsersByIds ::
( MonadReader Env m,
MonadIO m,
- CallsFed 'Brig "get-users-by-ids",
Log.MonadLogger m
) =>
Domain ->
@@ -70,7 +68,7 @@ getUsersByIds domain uids = do
runBrigFederatorClient domain $ fedClient @'Brig @"get-users-by-ids" uids
claimPrekey ::
- (MonadReader Env m, MonadIO m, Log.MonadLogger m, CallsFed 'Brig "claim-prekey") =>
+ (MonadReader Env m, MonadIO m, Log.MonadLogger m) =>
Qualified UserId ->
ClientId ->
ExceptT FederationError m (Maybe ClientPrekey)
@@ -81,7 +79,6 @@ claimPrekey (Qualified user domain) client = do
claimPrekeyBundle ::
( MonadReader Env m,
MonadIO m,
- CallsFed 'Brig "claim-prekey-bundle",
Log.MonadLogger m
) =>
Qualified UserId ->
@@ -93,8 +90,7 @@ claimPrekeyBundle (Qualified user domain) = do
claimMultiPrekeyBundle ::
( Log.MonadLogger m,
MonadReader Env m,
- MonadIO m,
- CallsFed 'Brig "claim-multi-prekey-bundle"
+ MonadIO m
) =>
Domain ->
UserClients ->
@@ -106,8 +102,7 @@ claimMultiPrekeyBundle domain uc = do
searchUsers ::
( MonadReader Env m,
MonadIO m,
- Log.MonadLogger m,
- CallsFed 'Brig "search-users"
+ Log.MonadLogger m
) =>
Domain ->
SearchRequest ->
@@ -119,8 +114,7 @@ searchUsers domain searchTerm = do
getUserClients ::
( MonadReader Env m,
MonadIO m,
- Log.MonadLogger m,
- CallsFed 'Brig "get-user-clients"
+ Log.MonadLogger m
) =>
Domain ->
GetUserClients ->
@@ -130,7 +124,7 @@ getUserClients domain guc = do
runBrigFederatorClient domain $ fedClient @'Brig @"get-user-clients" guc
sendConnectionAction ::
- (MonadReader Env m, MonadIO m, Log.MonadLogger m, CallsFed 'Brig "send-connection-action") =>
+ (MonadReader Env m, MonadIO m, Log.MonadLogger m) =>
Local UserId ->
Remote UserId ->
RemoteConnectionAction ->
diff --git a/services/brig/src/Brig/IO/Intra.hs b/services/brig/src/Brig/IO/Intra.hs
index 72edb33fcc..3c98f8ab9a 100644
--- a/services/brig/src/Brig/IO/Intra.hs
+++ b/services/brig/src/Brig/IO/Intra.hs
@@ -96,7 +96,6 @@ import qualified System.Logger.Extended as ExLog
import Wire.API.Connection
import Wire.API.Conversation
import Wire.API.Event.Conversation (Connect (Connect))
-import Wire.API.Federation.API
import Wire.API.Federation.API.Brig
import Wire.API.Federation.Error
import Wire.API.Properties
@@ -118,8 +117,7 @@ onUserEvent ::
MonadHttp m,
HasRequestId m,
MonadUnliftIO m,
- MonadClient m,
- CallsFed 'Brig "on-user-deleted-connections"
+ MonadClient m
) =>
UserId ->
Maybe ConnId ->
@@ -249,8 +247,7 @@ dispatchNotifications ::
MonadHttp m,
HasRequestId m,
MonadUnliftIO m,
- MonadClient m,
- CallsFed 'Brig "on-user-deleted-connections"
+ MonadClient m
) =>
UserId ->
Maybe ConnId ->
@@ -299,8 +296,7 @@ notifyUserDeletionRemotes ::
forall m.
( MonadReader Env m,
MonadClient m,
- MonadLogger m,
- CallsFed 'Brig "on-user-deleted-connections"
+ MonadLogger m
) =>
UserId ->
m ()
diff --git a/services/brig/src/Brig/InternalEvent/Process.hs b/services/brig/src/Brig/InternalEvent/Process.hs
index 05bab66a89..f9082c8c5b 100644
--- a/services/brig/src/Brig/InternalEvent/Process.hs
+++ b/services/brig/src/Brig/InternalEvent/Process.hs
@@ -39,7 +39,6 @@ import Imports
import System.Logger.Class (field, msg, val, (~~))
import qualified System.Logger.Class as Log
import UnliftIO (timeout)
-import Wire.API.Federation.API
-- | Handle an internal event.
--
@@ -52,8 +51,7 @@ onEvent ::
MonadHttp m,
HasRequestId m,
MonadUnliftIO m,
- MonadClient m,
- CallsFed 'Brig "on-user-deleted-connections"
+ MonadClient m
) =>
InternalNotification ->
m ()
diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs
index 414a0d24c2..ee2f2b0d8d 100644
--- a/services/brig/src/Brig/Team/API.hs
+++ b/services/brig/src/Brig/Team/API.hs
@@ -66,7 +66,6 @@ import qualified System.Logger.Class as Log
import Util.Logging (logFunction, logTeam)
import Wire.API.Error
import qualified Wire.API.Error.Brig as E
-import Wire.API.Federation.API
import qualified Wire.API.Routes.Internal.Galley.TeamsIntra as Team
import Wire.API.Routes.Named
import Wire.API.Routes.Public.Brig
@@ -98,8 +97,7 @@ servantAPI =
routesInternal ::
( Member BlacklistStore r,
Member GalleyProvider r,
- Member (UserPendingActivationStore p) r,
- CallsFed 'Brig "on-user-deleted-connections"
+ Member (UserPendingActivationStore p) r
) =>
Routes a (Handler r) ()
routesInternal = do
@@ -365,25 +363,25 @@ getInvitationByEmail email = do
inv <- lift $ wrapClient $ DB.lookupInvitationByEmail HideInvitationUrl email
maybe (throwStd (notFound "Invitation not found")) pure inv
-suspendTeamH :: (Member GalleyProvider r, CallsFed 'Brig "on-user-deleted-connections") => JSON ::: TeamId -> (Handler r) Response
+suspendTeamH :: (Member GalleyProvider r) => JSON ::: TeamId -> (Handler r) Response
suspendTeamH (_ ::: tid) = do
empty <$ suspendTeam tid
-suspendTeam :: (Member GalleyProvider r, CallsFed 'Brig "on-user-deleted-connections") => TeamId -> (Handler r) ()
+suspendTeam :: (Member GalleyProvider r) => TeamId -> (Handler r) ()
suspendTeam tid = do
changeTeamAccountStatuses tid Suspended
lift $ wrapClient $ DB.deleteInvitations tid
lift $ liftSem $ GalleyProvider.changeTeamStatus tid Team.Suspended Nothing
unsuspendTeamH ::
- (Member GalleyProvider r, CallsFed 'Brig "on-user-deleted-connections") =>
+ (Member GalleyProvider r) =>
JSON ::: TeamId ->
(Handler r) Response
unsuspendTeamH (_ ::: tid) = do
empty <$ unsuspendTeam tid
unsuspendTeam ::
- (Member GalleyProvider r, CallsFed 'Brig "on-user-deleted-connections") =>
+ (Member GalleyProvider r) =>
TeamId ->
(Handler r) ()
unsuspendTeam tid = do
@@ -394,7 +392,7 @@ unsuspendTeam tid = do
-- Internal
changeTeamAccountStatuses ::
- (Member GalleyProvider r, CallsFed 'Brig "on-user-deleted-connections") =>
+ (Member GalleyProvider r) =>
TeamId ->
AccountStatus ->
(Handler r) ()
diff --git a/services/brig/src/Brig/User/API/Handle.hs b/services/brig/src/Brig/User/API/Handle.hs
index 2f7eb7d564..eb59ca038f 100644
--- a/services/brig/src/Brig/User/API/Handle.hs
+++ b/services/brig/src/Brig/User/API/Handle.hs
@@ -39,14 +39,13 @@ import Imports
import Network.Wai.Utilities ((!>>))
import Polysemy
import qualified System.Logger.Class as Log
-import Wire.API.Federation.API
import Wire.API.User
import qualified Wire.API.User as Public
import Wire.API.User.Search
import qualified Wire.API.User.Search as Public
getHandleInfo ::
- (Member GalleyProvider r, CallsFed 'Brig "get-user-by-handle", CallsFed 'Brig "get-users-by-ids") =>
+ (Member GalleyProvider r) =>
UserId ->
Qualified Handle ->
(Handler r) (Maybe Public.UserProfile)
@@ -58,7 +57,7 @@ getHandleInfo self handle = do
getRemoteHandleInfo
handle
-getRemoteHandleInfo :: CallsFed 'Brig "get-user-by-handle" => Remote Handle -> (Handler r) (Maybe Public.UserProfile)
+getRemoteHandleInfo :: Remote Handle -> (Handler r) (Maybe Public.UserProfile)
getRemoteHandleInfo handle = do
lift . Log.info $
Log.msg (Log.val "getHandleInfo - remote lookup")
@@ -66,7 +65,7 @@ getRemoteHandleInfo handle = do
Federation.getUserHandleInfo handle !>> fedError
getLocalHandleInfo ::
- (Member GalleyProvider r, CallsFed 'Brig "get-users-by-ids") =>
+ (Member GalleyProvider r) =>
Local UserId ->
Handle ->
(Handler r) (Maybe Public.UserProfile)
diff --git a/services/brig/src/Brig/User/API/Search.hs b/services/brig/src/Brig/User/API/Search.hs
index b3417d0484..c85ef79822 100644
--- a/services/brig/src/Brig/User/API/Search.hs
+++ b/services/brig/src/Brig/User/API/Search.hs
@@ -50,7 +50,6 @@ import Polysemy
import System.Logger (field, msg)
import System.Logger.Class (val, (~~))
import qualified System.Logger.Class as Log
-import Wire.API.Federation.API
import qualified Wire.API.Federation.API.Brig as FedBrig
import qualified Wire.API.Federation.API.Brig as S
import qualified Wire.API.Team.Permission as Public
@@ -86,7 +85,7 @@ routesInternal = do
-- FUTUREWORK: Consider augmenting 'SearchResult' with full user profiles
-- for all results. This is tracked in https://wearezeta.atlassian.net/browse/SQCORE-599
search ::
- (Member GalleyProvider r, CallsFed 'Brig "get-users-by-ids", CallsFed 'Brig "search-users") =>
+ (Member GalleyProvider r) =>
UserId ->
Text ->
Maybe Domain ->
@@ -99,7 +98,7 @@ search searcherId searchTerm maybeDomain maybeMaxResults = do
then searchLocally searcherId searchTerm maybeMaxResults
else searchRemotely queryDomain searchTerm
-searchRemotely :: CallsFed 'Brig "search-users" => Domain -> Text -> (Handler r) (Public.SearchResult Public.Contact)
+searchRemotely :: Domain -> Text -> (Handler r) (Public.SearchResult Public.Contact)
searchRemotely domain searchTerm = do
lift . Log.info $
msg (val "searchRemotely")
@@ -121,7 +120,7 @@ searchRemotely domain searchTerm = do
searchLocally ::
forall r.
- (Member GalleyProvider r, CallsFed 'Brig "get-users-by-ids") =>
+ (Member GalleyProvider r) =>
UserId ->
Text ->
Maybe (Range 1 500 Int32) ->
diff --git a/services/brig/src/Brig/User/Auth.hs b/services/brig/src/Brig/User/Auth.hs
index 7cdfd3937a..8aa2d04302 100644
--- a/services/brig/src/Brig/User/Auth.hs
+++ b/services/brig/src/Brig/User/Auth.hs
@@ -78,7 +78,6 @@ import Network.Wai.Utilities.Error ((!>>))
import Polysemy
import System.Logger (field, msg, val, (~~))
import qualified System.Logger.Class as Log
-import Wire.API.Federation.API
import Wire.API.Team.Feature
import qualified Wire.API.Team.Feature as Public
import Wire.API.User
@@ -135,7 +134,7 @@ lookupLoginCode phone =
login ::
forall r.
- (Member GalleyProvider r, CallsFed 'Brig "on-user-deleted-connections") =>
+ (Member GalleyProvider r) =>
Login ->
CookieType ->
ExceptT LoginError (AppT r) (Access ZAuth.User)
@@ -252,8 +251,7 @@ renewAccess ::
MonadMask m,
MonadHttp m,
HasRequestId m,
- MonadUnliftIO m,
- CallsFed 'Brig "on-user-deleted-connections"
+ MonadUnliftIO m
) =>
List1 (ZAuth.Token u) ->
Maybe (ZAuth.Token a) ->
@@ -291,8 +289,7 @@ catchSuspendInactiveUser ::
MonadHttp m,
HasRequestId m,
MonadUnliftIO m,
- Log.MonadLogger m,
- CallsFed 'Brig "on-user-deleted-connections"
+ Log.MonadLogger m
) =>
UserId ->
e ->
@@ -324,8 +321,7 @@ newAccess ::
MonadMask m,
MonadHttp m,
HasRequestId m,
- MonadUnliftIO m,
- CallsFed 'Brig "on-user-deleted-connections"
+ MonadUnliftIO m
) =>
UserId ->
Maybe ClientId ->
@@ -445,8 +441,7 @@ ssoLogin ::
MonadMask m,
MonadHttp m,
HasRequestId m,
- MonadUnliftIO m,
- CallsFed 'Brig "on-user-deleted-connections"
+ MonadUnliftIO m
) =>
SsoLogin ->
CookieType ->
@@ -467,7 +462,7 @@ ssoLogin (SsoLogin uid label) typ = do
-- | Log in as a LegalHold service, getting LegalHoldUser/Access Tokens.
legalHoldLogin ::
- (Member GalleyProvider r, CallsFed 'Brig "on-user-deleted-connections") =>
+ (Member GalleyProvider r) =>
LegalHoldLogin ->
CookieType ->
ExceptT LegalHoldLoginError (AppT r) (Access ZAuth.LegalHoldUser)
diff --git a/services/cargohold/cargohold.cabal b/services/cargohold/cargohold.cabal
index 287fe2fbca..c5fa83a620 100644
--- a/services/cargohold/cargohold.cabal
+++ b/services/cargohold/cargohold.cabal
@@ -79,7 +79,7 @@ library
ghc-options:
-O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates
-Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path
- -Wredundant-constraints
+ -fplugin=TransitiveAnns.Plugin -Wredundant-constraints
build-depends:
aeson >=2.0.1.0
@@ -123,6 +123,7 @@ library
, text >=1.1
, time >=1.4
, tinylog >=0.10
+ , transitive-anns
, types-common >=0.16
, types-common-aws
, unliftio
diff --git a/services/cargohold/default.nix b/services/cargohold/default.nix
index c1b65ee56f..017b1fae70 100644
--- a/services/cargohold/default.nix
+++ b/services/cargohold/default.nix
@@ -57,6 +57,7 @@
, text
, time
, tinylog
+, transitive-anns
, types-common
, types-common-aws
, unliftio
@@ -118,6 +119,7 @@ mkDerivation {
text
time
tinylog
+ transitive-anns
types-common
types-common-aws
unliftio
diff --git a/services/cargohold/src/CargoHold/API/Public.hs b/services/cargohold/src/CargoHold/API/Public.hs
index 6e2ff12830..5581785271 100644
--- a/services/cargohold/src/CargoHold/API/Public.hs
+++ b/services/cargohold/src/CargoHold/API/Public.hs
@@ -60,13 +60,13 @@ servantSitemap =
providerAPI = uploadAssetV3 @tag :<|> downloadAssetV3 @tag :<|> deleteAssetV3 @tag
legacyAPI = legacyDownloadPlain :<|> legacyDownloadPlain :<|> legacyDownloadOtr
qualifiedAPI :: ServerT QualifiedAPI Handler
- qualifiedAPI = callsFed downloadAssetV4 :<|> deleteAssetV4
+ qualifiedAPI = callsFed (exposeAnnotations downloadAssetV4) :<|> deleteAssetV4
mainAPI :: ServerT MainAPI Handler
mainAPI =
renewTokenV3
:<|> deleteTokenV3
:<|> uploadAssetV3 @'UserPrincipalTag
- :<|> callsFed downloadAssetV4
+ :<|> callsFed (exposeAnnotations downloadAssetV4)
:<|> deleteAssetV4
internalSitemap :: ServerT InternalAPI Handler
@@ -151,7 +151,7 @@ downloadAssetV3 usr key tok1 tok2 = do
AssetLocation <$$> V3.download (mkPrincipal usr) key (tok1 <|> tok2)
downloadAssetV4 ::
- (CallsFed 'Cargohold "get-asset", CallsFed 'Cargohold "stream-asset") =>
+ () =>
Local UserId ->
Qualified AssetKey ->
Maybe AssetToken ->
diff --git a/services/cargohold/src/CargoHold/Federation.hs b/services/cargohold/src/CargoHold/Federation.hs
index 94a8bebc7e..8cb7880f86 100644
--- a/services/cargohold/src/CargoHold/Federation.hs
+++ b/services/cargohold/src/CargoHold/Federation.hs
@@ -48,7 +48,7 @@ import Wire.API.Federation.Error
-- is streamed back through our outward federator, as well as the remote one.
downloadRemoteAsset ::
- (CallsFed 'Cargohold "get-asset", CallsFed 'Cargohold "stream-asset") =>
+ () =>
Local UserId ->
Remote AssetKey ->
Maybe AssetToken ->
diff --git a/services/federator/test/unit/Test/Federator/Client.hs b/services/federator/test/unit/Test/Federator/Client.hs
index dd2772b189..2d4d47fd61 100644
--- a/services/federator/test/unit/Test/Federator/Client.hs
+++ b/services/federator/test/unit/Test/Federator/Client.hs
@@ -50,7 +50,7 @@ import Wire.API.Federation.Client
import Wire.API.Federation.Error
import Wire.API.User (UserProfile)
-instance CallsFed comp name
+instance AddAnnotation loc comp name x
targetDomain :: Domain
targetDomain = Domain "target.example.com"
diff --git a/services/galley/default.nix b/services/galley/default.nix
index 387790dab1..5f5ac943ce 100644
--- a/services/galley/default.nix
+++ b/services/galley/default.nix
@@ -108,6 +108,7 @@
, tinylog
, tls
, transformers
+, transitive-anns
, types-common
, types-common-aws
, types-common-journal
@@ -222,6 +223,7 @@ mkDerivation {
tinylog
tls
transformers
+ transitive-anns
types-common
types-common-aws
types-common-journal
diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal
index 0855d0e81e..458fa0ecd4 100644
--- a/services/galley/galley.cabal
+++ b/services/galley/galley.cabal
@@ -184,7 +184,7 @@ library
ghc-options:
-O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates
-Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path
- -Wredundant-constraints
+ -fplugin=TransitiveAnns.Plugin -Wredundant-constraints
build-depends:
aeson >=2.0.1.0
@@ -271,6 +271,7 @@ library
, tinylog >=0.10
, tls >=1.3.10
, transformers
+ , transitive-anns
, types-common >=0.16
, types-common-aws
, types-common-journal >=0.1
diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs
index 374bccd69c..7467c3ff90 100644
--- a/services/galley/src/Galley/API/Action.hs
+++ b/services/galley/src/Galley/API/Action.hs
@@ -14,7 +14,6 @@
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-{-# LANGUAGE StandaloneKindSignatures #-}
module Galley.API.Action
( -- * Conversation action types
@@ -87,7 +86,7 @@ import Wire.API.Conversation.Role
import Wire.API.Error
import Wire.API.Error.Galley
import Wire.API.Event.Conversation
-import Wire.API.Federation.API (CallsFed, Component (Galley), fedClient)
+import Wire.API.Federation.API (Component (Galley), fedClient)
import Wire.API.Federation.API.Galley
import Wire.API.Federation.Error
import Wire.API.Team.LegalHold
@@ -281,29 +280,11 @@ ensureAllowed tag loc action conv origUser = do
throwS @'InvalidTargetAccess
_ -> pure ()
-type PerformActionCalls :: ConversationActionTag -> Constraint
-type family PerformActionCalls tag where
- PerformActionCalls 'ConversationAccessDataTag =
- ( CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-new-remote-conversation"
- )
- PerformActionCalls 'ConversationJoinTag =
- ( CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-new-remote-conversation"
- )
- PerformActionCalls 'ConversationLeaveTag =
- ( CallsFed 'Galley "on-mls-message-sent"
- )
- PerformActionCalls tag = ()
-
-- | Returns additional members that resulted from the action (e.g. ConversationJoin)
-- and also returns the (possible modified) action that was performed
performAction ::
forall tag r.
- ( HasConversationActionEffects tag r,
- PerformActionCalls tag
+ ( HasConversationActionEffects tag r
) =>
Sing tag ->
Qualified UserId ->
@@ -372,10 +353,7 @@ performAction tag origUser lconv action = do
pure (bm, act)
performConversationJoin ::
- ( HasConversationActionEffects 'ConversationJoinTag r,
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation"
+ ( HasConversationActionEffects 'ConversationJoinTag r
) =>
Qualified UserId ->
Local Conversation ->
@@ -492,10 +470,7 @@ performConversationJoin qusr lconv (ConversationJoin invited role) = do
checkLHPolicyConflictsRemote _remotes = pure ()
performConversationAccessData ::
- ( HasConversationActionEffects 'ConversationAccessDataTag r,
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation"
+ ( HasConversationActionEffects 'ConversationAccessDataTag r
) =>
Qualified UserId ->
Local Conversation ->
@@ -589,10 +564,7 @@ updateLocalConversation ::
Member GundeckAccess r,
Member (Input UTCTime) r,
HasConversationActionEffects tag r,
- SingI tag,
- CallsFed 'Galley "on-new-remote-conversation",
- CallsFed 'Galley "on-conversation-updated",
- PerformActionCalls tag
+ SingI tag
) =>
Local ConvId ->
Qualified UserId ->
@@ -629,10 +601,7 @@ updateLocalConversationUnchecked ::
Member FederatorAccess r,
Member GundeckAccess r,
Member (Input UTCTime) r,
- HasConversationActionEffects tag r,
- CallsFed 'Galley "on-new-remote-conversation",
- CallsFed 'Galley "on-conversation-updated",
- PerformActionCalls tag
+ HasConversationActionEffects tag r
) =>
Local Conversation ->
Qualified UserId ->
@@ -711,9 +680,7 @@ notifyConversationAction ::
( Member FederatorAccess r,
Member ExternalAccess r,
Member GundeckAccess r,
- Member (Input UTCTime) r,
- CallsFed 'Galley "on-new-remote-conversation",
- CallsFed 'Galley "on-conversation-updated"
+ Member (Input UTCTime) r
) =>
Sing tag ->
Qualified UserId ->
@@ -827,10 +794,7 @@ kickMember ::
Member (Input UTCTime) r,
Member (Input Env) r,
Member MemberStore r,
- Member TinyLog r,
- CallsFed 'Galley "on-new-remote-conversation",
- CallsFed 'Galley "on-conversation-updated",
- PerformActionCalls 'ConversationLeaveTag
+ Member TinyLog r
) =>
Qualified UserId ->
Local Conversation ->
diff --git a/services/galley/src/Galley/API/Clients.hs b/services/galley/src/Galley/API/Clients.hs
index 9225a572c7..25cc308737 100644
--- a/services/galley/src/Galley/API/Clients.hs
+++ b/services/galley/src/Galley/API/Clients.hs
@@ -54,7 +54,9 @@ import qualified Polysemy.TinyLog as P
import qualified System.Logger as Log
import Wire.API.Conversation hiding (Member)
import Wire.API.Federation.API
+import Wire.API.Federation.API.Common (EmptyResponse)
import Wire.API.Federation.API.Galley (ClientRemovedRequest (ClientRemovedRequest))
+import Wire.API.Federation.Client (FederatorClient)
import Wire.API.Routes.MultiTablePaging
import Wire.Sem.Paging.Cassandra (CassandraPaging)
@@ -106,9 +108,7 @@ rmClientH ::
Member (Error InternalError) r,
Member ProposalStore r,
Member P.TinyLog r
- ),
- CallsFed 'Galley "on-client-removed",
- CallsFed 'Galley "on-mls-message-sent"
+ )
) =>
UserId ::: ClientId ->
Sem r Response
@@ -121,7 +121,9 @@ rmClientH (usr ::: cid) = do
E.deleteClient usr cid
pure empty
where
+ rpc :: ClientRemovedRequest -> FederatorClient 'Galley EmptyResponse
rpc = fedClient @'Galley @"on-client-removed"
+
goConvs :: Range 1 1000 Int32 -> ConvIdsPage -> Local UserId -> Sem r ()
goConvs range page lusr = do
let (localConvs, remoteConvs) = partitionQualified lusr (mtpResults page)
diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs
index 8ee1994523..e4f2b4b970 100644
--- a/services/galley/src/Galley/API/Create.hs
+++ b/services/galley/src/Galley/API/Create.hs
@@ -71,7 +71,6 @@ import Wire.API.Conversation.Protocol
import Wire.API.Error
import Wire.API.Error.Galley
import Wire.API.Event.Conversation
-import Wire.API.Federation.API
import Wire.API.Federation.Error
import Wire.API.Routes.Public.Galley.Conversation
import Wire.API.Routes.Public.Util
@@ -104,8 +103,7 @@ createGroupConversation ::
Member (Input UTCTime) r,
Member LegalHoldStore r,
Member TeamStore r,
- Member P.TinyLog r,
- CallsFed 'Galley "on-conversation-created"
+ Member P.TinyLog r
) =>
Local UserId ->
ConnId ->
@@ -243,8 +241,7 @@ createOne2OneConversation ::
Member GundeckAccess r,
Member (Input UTCTime) r,
Member TeamStore r,
- Member P.TinyLog r,
- CallsFed 'Galley "on-conversation-created"
+ Member P.TinyLog r
) =>
Local UserId ->
ConnId ->
@@ -296,8 +293,7 @@ createLegacyOne2OneConversationUnchecked ::
Member FederatorAccess r,
Member GundeckAccess r,
Member (Input UTCTime) r,
- Member P.TinyLog r,
- CallsFed 'Galley "on-conversation-created"
+ Member P.TinyLog r
) =>
Local UserId ->
ConnId ->
@@ -334,8 +330,7 @@ createOne2OneConversationUnchecked ::
Member FederatorAccess r,
Member GundeckAccess r,
Member (Input UTCTime) r,
- Member P.TinyLog r,
- CallsFed 'Galley "on-conversation-created"
+ Member P.TinyLog r
) =>
Local UserId ->
ConnId ->
@@ -357,8 +352,7 @@ createOne2OneConversationLocally ::
Member FederatorAccess r,
Member GundeckAccess r,
Member (Input UTCTime) r,
- Member P.TinyLog r,
- CallsFed 'Galley "on-conversation-created"
+ Member P.TinyLog r
) =>
Local ConvId ->
Local UserId ->
@@ -411,8 +405,7 @@ createConnectConversation ::
Member GundeckAccess r,
Member (Input UTCTime) r,
Member MemberStore r,
- Member P.TinyLog r,
- CallsFed 'Galley "on-conversation-created"
+ Member P.TinyLog r
) =>
Local UserId ->
Maybe ConnId ->
@@ -545,8 +538,7 @@ notifyCreatedConversation ::
Member FederatorAccess r,
Member GundeckAccess r,
Member (Input UTCTime) r,
- Member P.TinyLog r,
- CallsFed 'Galley "on-conversation-created"
+ Member P.TinyLog r
) =>
Maybe UTCTime ->
Local UserId ->
diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs
index d57ad26264..6610a5cbf6 100644
--- a/services/galley/src/Galley/API/Federation.hs
+++ b/services/galley/src/Galley/API/Federation.hs
@@ -107,17 +107,17 @@ federationSitemap =
:<|> Named @"on-new-remote-conversation" onNewRemoteConversation
:<|> Named @"get-conversations" getConversations
:<|> Named @"on-conversation-updated" onConversationUpdated
- :<|> Named @"leave-conversation" (callsFed leaveConversation)
+ :<|> Named @"leave-conversation" (callsFed (exposeAnnotations leaveConversation))
:<|> Named @"on-message-sent" onMessageSent
- :<|> Named @"send-message" (callsFed sendMessage)
- :<|> Named @"on-user-deleted-conversations" (callsFed onUserDeleted)
- :<|> Named @"update-conversation" (callsFed updateConversation)
+ :<|> Named @"send-message" (callsFed (exposeAnnotations sendMessage))
+ :<|> Named @"on-user-deleted-conversations" (callsFed (exposeAnnotations onUserDeleted))
+ :<|> Named @"update-conversation" (callsFed (exposeAnnotations updateConversation))
:<|> Named @"mls-welcome" mlsSendWelcome
:<|> Named @"on-mls-message-sent" onMLSMessageSent
- :<|> Named @"send-mls-message" (callsFed sendMLSMessage)
- :<|> Named @"send-mls-commit-bundle" (callsFed sendMLSCommitBundle)
+ :<|> Named @"send-mls-message" (callsFed (exposeAnnotations sendMLSMessage))
+ :<|> Named @"send-mls-commit-bundle" (callsFed (exposeAnnotations sendMLSCommitBundle))
:<|> Named @"query-group-info" queryGroupInfo
- :<|> Named @"on-client-removed" (callsFed onClientRemoved)
+ :<|> Named @"on-client-removed" (callsFed (exposeAnnotations onClientRemoved))
:<|> Named @"on-typing-indicator-updated" onTypingIndicatorUpdated
onClientRemoved ::
@@ -130,8 +130,7 @@ onClientRemoved ::
Member (Input UTCTime) r,
Member MemberStore r,
Member ProposalStore r,
- Member TinyLog r,
- CallsFed 'Galley "on-mls-message-sent"
+ Member TinyLog r
) =>
Domain ->
ClientRemovedRequest ->
@@ -338,10 +337,7 @@ leaveConversation ::
Member (Input UTCTime) r,
Member MemberStore r,
Member ProposalStore r,
- Member TinyLog r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member TinyLog r
) =>
Domain ->
F.LeaveConversationRequest ->
@@ -447,9 +443,7 @@ sendMessage ::
Member (Input UTCTime) r,
Member ExternalAccess r,
Member TeamStore r,
- Member P.TinyLog r,
- CallsFed 'Galley "on-message-sent",
- CallsFed 'Brig "get-user-clients"
+ Member P.TinyLog r
) =>
Domain ->
F.ProteusMessageSendRequest ->
@@ -473,10 +467,7 @@ onUserDeleted ::
Member (Input Env) r,
Member MemberStore r,
Member ProposalStore r,
- Member TinyLog r,
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member TinyLog r
) =>
Domain ->
F.UserDeletedConversationsNotification ->
@@ -537,10 +528,7 @@ updateConversation ::
Member TeamStore r,
Member TinyLog r,
Member ConversationStore r,
- Member (Input (Local ())) r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member (Input (Local ())) r
) =>
Domain ->
F.ConversationUpdateRequest ->
@@ -619,13 +607,7 @@ sendMLSCommitBundle ::
Member Resource r,
Member TeamStore r,
Member P.TinyLog r,
- Member ProposalStore r,
- CallsFed 'Galley "mls-welcome",
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-new-remote-conversation",
- CallsFed 'Galley "send-mls-commit-bundle",
- CallsFed 'Brig "get-mls-clients"
+ Member ProposalStore r
) =>
Domain ->
F.MLSMessageSendRequest ->
@@ -666,12 +648,7 @@ sendMLSMessage ::
Member Resource r,
Member TeamStore r,
Member P.TinyLog r,
- Member ProposalStore r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-new-remote-conversation",
- CallsFed 'Galley "send-mls-message",
- CallsFed 'Brig "get-mls-clients"
+ Member ProposalStore r
) =>
Domain ->
F.MLSMessageSendRequest ->
diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs
index ae7dbd910f..a3401ad4b0 100644
--- a/services/galley/src/Galley/API/Internal.hs
+++ b/services/galley/src/Galley/API/Internal.hs
@@ -105,8 +105,8 @@ internalAPI :: API InternalAPI GalleyEffects
internalAPI =
hoistAPI @InternalAPIBase id $
mkNamedAPI @"status" (pure ())
- <@> mkNamedAPI @"delete-user" (callsFed rmUser)
- <@> mkNamedAPI @"connect" (callsFed Create.createConnectConversation)
+ <@> mkNamedAPI @"delete-user" (callsFed (exposeAnnotations rmUser))
+ <@> mkNamedAPI @"connect" (callsFed (exposeAnnotations Create.createConnectConversation))
<@> mkNamedAPI @"guard-legalhold-policy-conflicts" guardLegalholdPolicyConflictsH
<@> legalholdWhitelistedTeamsAPI
<@> iTeamsAPI
@@ -157,8 +157,8 @@ featureAPI =
<@> mkNamedAPI @'("iput", SSOConfig) (setFeatureStatusInternal @Cassandra)
<@> mkNamedAPI @'("ipatch", SSOConfig) (patchFeatureStatusInternal @Cassandra)
<@> mkNamedAPI @'("iget", LegalholdConfig) (getFeatureStatus @Cassandra DontDoAuth)
- <@> mkNamedAPI @'("iput", LegalholdConfig) (callsFed (setFeatureStatusInternal @Cassandra))
- <@> mkNamedAPI @'("ipatch", LegalholdConfig) (callsFed (patchFeatureStatusInternal @Cassandra))
+ <@> mkNamedAPI @'("iput", LegalholdConfig) (callsFed (exposeAnnotations (setFeatureStatusInternal @Cassandra)))
+ <@> mkNamedAPI @'("ipatch", LegalholdConfig) (callsFed (exposeAnnotations (patchFeatureStatusInternal @Cassandra)))
<@> mkNamedAPI @'("iget", SearchVisibilityAvailableConfig) (getFeatureStatus @Cassandra DontDoAuth)
<@> mkNamedAPI @'("iput", SearchVisibilityAvailableConfig) (setFeatureStatusInternal @Cassandra)
<@> mkNamedAPI @'("ipatch", SearchVisibilityAvailableConfig) (patchFeatureStatusInternal @Cassandra)
@@ -316,10 +316,7 @@ rmUser ::
Member ProposalStore r,
Member P.TinyLog r,
Member TeamStore r
- ),
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-user-deleted-conversations",
- CallsFed 'Galley "on-mls-message-sent"
+ )
) =>
Local UserId ->
Maybe ConnId ->
diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs
index 82acf6bc68..df76873206 100644
--- a/services/galley/src/Galley/API/LegalHold.hs
+++ b/services/galley/src/Galley/API/LegalHold.hs
@@ -72,7 +72,6 @@ import Wire.API.Conversation (ConvType (..))
import Wire.API.Conversation.Role
import Wire.API.Error
import Wire.API.Error.Galley
-import Wire.API.Federation.API
import Wire.API.Provider.Service
import Wire.API.Routes.Internal.Brig.Connection
import Wire.API.Routes.Public.Galley.LegalHold
@@ -209,10 +208,7 @@ removeSettingsInternalPaging ::
Member P.TinyLog r,
Member (TeamFeatureStore db) r,
Member (TeamMemberStore InternalPaging) r,
- Member TeamStore r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member TeamStore r
) =>
TeamFeatures.FeaturePersistentConstraint db Public.LegalholdConfig =>
Local UserId ->
@@ -255,10 +251,7 @@ removeSettings ::
Member (TeamFeatureStore db) r,
Member (TeamMemberStore p) r,
Member TeamStore r
- ),
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-new-remote-conversation"
+ )
) =>
TeamFeatures.FeaturePersistentConstraint db Public.LegalholdConfig =>
UserId ->
@@ -315,10 +308,7 @@ removeSettings' ::
Member TeamStore r,
Member ProposalStore r,
Member P.TinyLog r
- ),
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-new-remote-conversation"
+ )
) =>
TeamId ->
Sem r ()
@@ -401,10 +391,7 @@ grantConsent ::
Member MemberStore r,
Member ProposalStore r,
Member P.TinyLog r,
- Member TeamStore r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member TeamStore r
) =>
Local UserId ->
TeamId ->
@@ -449,10 +436,7 @@ requestDevice ::
Member ProposalStore r,
Member P.TinyLog r,
Member (TeamFeatureStore db) r,
- Member TeamStore r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member TeamStore r
) =>
TeamFeatures.FeaturePersistentConstraint db Public.LegalholdConfig =>
Local UserId ->
@@ -530,10 +514,7 @@ approveDevice ::
Member ProposalStore r,
Member P.TinyLog r,
Member (TeamFeatureStore db) r,
- Member TeamStore r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member TeamStore r
) =>
TeamFeatures.FeaturePersistentConstraint db Public.LegalholdConfig =>
Local UserId ->
@@ -606,10 +587,7 @@ disableForUser ::
Member MemberStore r,
Member ProposalStore r,
Member P.TinyLog r,
- Member TeamStore r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member TeamStore r
) =>
Local UserId ->
TeamId ->
@@ -660,10 +638,7 @@ changeLegalholdStatus ::
Member MemberStore r,
Member TeamStore r,
Member ProposalStore r,
- Member P.TinyLog r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member P.TinyLog r
) =>
TeamId ->
Local UserId ->
@@ -775,10 +750,7 @@ handleGroupConvPolicyConflicts ::
Member MemberStore r,
Member ProposalStore r,
Member P.TinyLog r,
- Member TeamStore r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member TeamStore r
) =>
Local UserId ->
UserLegalHoldStatus ->
diff --git a/services/galley/src/Galley/API/MLS/GroupInfo.hs b/services/galley/src/Galley/API/MLS/GroupInfo.hs
index e3d2315587..fc1c4f0935 100644
--- a/services/galley/src/Galley/API/MLS/GroupInfo.hs
+++ b/services/galley/src/Galley/API/MLS/GroupInfo.hs
@@ -49,8 +49,7 @@ getGroupInfo ::
Member (Error FederationError) r,
Member FederatorAccess r,
Member (Input Env) r,
- Member MemberStore r,
- CallsFed 'Galley "query-group-info"
+ Member MemberStore r
) =>
Members MLSGroupInfoStaticErrors r =>
Local UserId ->
@@ -79,8 +78,7 @@ getGroupInfoFromLocalConv qusr lcnvId = do
getGroupInfoFromRemoteConv ::
( Member (Error FederationError) r,
- Member FederatorAccess r,
- CallsFed 'Galley "query-group-info"
+ Member FederatorAccess r
) =>
Members MLSGroupInfoStaticErrors r =>
Local UserId ->
diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs
index 4224d9a028..891d6350a1 100644
--- a/services/galley/src/Galley/API/MLS/Message.hs
+++ b/services/galley/src/Galley/API/MLS/Message.hs
@@ -138,12 +138,7 @@ postMLSMessageFromLocalUserV1 ::
Member ProposalStore r,
Member Resource r,
Member TinyLog r
- ),
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "send-mls-message",
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation",
- CallsFed 'Brig "get-mls-clients"
+ )
) =>
Local UserId ->
Maybe ClientId ->
@@ -179,12 +174,7 @@ postMLSMessageFromLocalUser ::
Member ProposalStore r,
Member Resource r,
Member TinyLog r
- ),
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "send-mls-message",
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation",
- CallsFed 'Brig "get-mls-clients"
+ )
) =>
Local UserId ->
Maybe ClientId ->
@@ -213,13 +203,7 @@ postMLSCommitBundle ::
Member ProposalStore r,
Member Resource r,
Member TinyLog r
- ),
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "mls-welcome",
- CallsFed 'Galley "send-mls-commit-bundle",
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation",
- CallsFed 'Brig "get-mls-clients"
+ )
) =>
Local x ->
Qualified UserId ->
@@ -249,13 +233,7 @@ postMLSCommitBundleFromLocalUser ::
Member ProposalStore r,
Member Resource r,
Member TinyLog r
- ),
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "mls-welcome",
- CallsFed 'Galley "send-mls-commit-bundle",
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation",
- CallsFed 'Brig "get-mls-clients"
+ )
) =>
Local UserId ->
Maybe ClientId ->
@@ -284,12 +262,7 @@ postMLSCommitBundleToLocalConv ::
Member ProposalStore r,
Member Resource r,
Member TinyLog r
- ),
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "mls-welcome",
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation",
- CallsFed 'Brig "get-mls-clients"
+ )
) =>
Qualified UserId ->
Maybe ClientId ->
@@ -352,8 +325,7 @@ postMLSCommitBundleToRemoteConv ::
Member GundeckAccess r,
Member MemberStore r,
Member TinyLog r
- ),
- CallsFed 'Galley "send-mls-commit-bundle"
+ )
) =>
Local x ->
Qualified UserId ->
@@ -406,12 +378,7 @@ postMLSMessage ::
Member ProposalStore r,
Member Resource r,
Member TinyLog r
- ),
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "send-mls-message",
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation",
- CallsFed 'Brig "get-mls-clients"
+ )
) =>
Local x ->
Qualified UserId ->
@@ -489,11 +456,7 @@ postMLSMessageToLocalConv ::
Member ProposalStore r,
Member Resource r,
Member TinyLog r
- ),
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation",
- CallsFed 'Brig "get-mls-clients"
+ )
) =>
Qualified UserId ->
Maybe ClientId ->
@@ -534,8 +497,7 @@ postMLSMessageToRemoteConv ::
( Member (Error FederationError) r,
Member TinyLog r
),
- HasProposalEffects r,
- CallsFed 'Galley "send-mls-message"
+ HasProposalEffects r
) =>
Local x ->
Qualified UserId ->
@@ -649,11 +611,7 @@ processCommit ::
Member (ErrorS 'MLSSelfRemovalNotAllowed) r,
Member (ErrorS 'MLSStaleMessage) r,
Member (ErrorS 'MissingLegalholdConsent) r,
- Member Resource r,
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation",
- CallsFed 'Brig "get-mls-clients"
+ Member Resource r
) =>
Qualified UserId ->
Maybe ClientId ->
@@ -687,8 +645,7 @@ processExternalCommit ::
Member MemberStore r,
Member ProposalStore r,
Member Resource r,
- Member TinyLog r,
- CallsFed 'Galley "on-mls-message-sent"
+ Member TinyLog r
) =>
Qualified UserId ->
Maybe ClientId ->
@@ -788,11 +745,7 @@ processCommitWithAction ::
Member (ErrorS 'MLSSelfRemovalNotAllowed) r,
Member (ErrorS 'MLSStaleMessage) r,
Member (ErrorS 'MissingLegalholdConsent) r,
- Member Resource r,
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation",
- CallsFed 'Brig "get-mls-clients"
+ Member Resource r
) =>
Qualified UserId ->
Maybe ClientId ->
@@ -820,11 +773,7 @@ processInternalCommit ::
Member (ErrorS 'MLSSelfRemovalNotAllowed) r,
Member (ErrorS 'MLSStaleMessage) r,
Member (ErrorS 'MissingLegalholdConsent) r,
- Member Resource r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-new-remote-conversation",
- CallsFed 'Brig "get-mls-clients"
+ Member Resource r
) =>
Qualified UserId ->
Maybe ClientId ->
@@ -1142,11 +1091,7 @@ executeProposalAction ::
Member MemberStore r,
Member ProposalStore r,
Member TeamStore r,
- Member TinyLog r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-new-remote-conversation",
- CallsFed 'Brig "get-mls-clients"
+ Member TinyLog r
) =>
Qualified UserId ->
Maybe ConnId ->
@@ -1286,8 +1231,7 @@ handleNoChanges = fmap fold . runError
getClientInfo ::
( Member BrigAccess r,
- Member FederatorAccess r,
- CallsFed 'Brig "get-mls-clients"
+ Member FederatorAccess r
) =>
Local x ->
Qualified UserId ->
@@ -1296,8 +1240,7 @@ getClientInfo ::
getClientInfo loc = foldQualified loc getLocalMLSClients getRemoteMLSClients
getRemoteMLSClients ::
- ( Member FederatorAccess r,
- CallsFed 'Brig "get-mls-clients"
+ ( Member FederatorAccess r
) =>
Remote UserId ->
SignatureSchemeTag ->
diff --git a/services/galley/src/Galley/API/MLS/Propagate.hs b/services/galley/src/Galley/API/MLS/Propagate.hs
index 22ca2d9d5e..74fbf8f608 100644
--- a/services/galley/src/Galley/API/MLS/Propagate.hs
+++ b/services/galley/src/Galley/API/MLS/Propagate.hs
@@ -52,8 +52,7 @@ propagateMessage ::
Member FederatorAccess r,
Member GundeckAccess r,
Member (Input UTCTime) r,
- Member TinyLog r,
- CallsFed 'Galley "on-mls-message-sent"
+ Member TinyLog r
) =>
Qualified UserId ->
Local Data.Conversation ->
diff --git a/services/galley/src/Galley/API/MLS/Removal.hs b/services/galley/src/Galley/API/MLS/Removal.hs
index 2d34271b21..ec1b6529e5 100644
--- a/services/galley/src/Galley/API/MLS/Removal.hs
+++ b/services/galley/src/Galley/API/MLS/Removal.hs
@@ -42,7 +42,6 @@ import Polysemy.Input
import Polysemy.TinyLog
import qualified System.Logger as Log
import Wire.API.Conversation.Protocol
-import Wire.API.Federation.API
import Wire.API.MLS.KeyPackage
import Wire.API.MLS.Message
import Wire.API.MLS.Proposal
@@ -57,8 +56,7 @@ removeClientsWithClientMap ::
Member GundeckAccess r,
Member ProposalStore r,
Member (Input Env) r,
- Traversable t,
- CallsFed 'Galley "on-mls-message-sent"
+ Traversable t
) =>
Local Data.Conversation ->
t KeyPackageRef ->
@@ -95,8 +93,7 @@ removeClient ::
Member (Input UTCTime) r,
Member MemberStore r,
Member ProposalStore r,
- Member TinyLog r,
- CallsFed 'Galley "on-mls-message-sent"
+ Member TinyLog r
) =>
Local Data.Conversation ->
Qualified UserId ->
@@ -118,8 +115,7 @@ removeUserWithClientMap ::
Member FederatorAccess r,
Member GundeckAccess r,
Member ProposalStore r,
- Member (Input Env) r,
- CallsFed 'Galley "on-mls-message-sent"
+ Member (Input Env) r
) =>
Local Data.Conversation ->
ClientMap ->
@@ -137,8 +133,7 @@ removeUser ::
Member (Input UTCTime) r,
Member MemberStore r,
Member ProposalStore r,
- Member TinyLog r,
- CallsFed 'Galley "on-mls-message-sent"
+ Member TinyLog r
) =>
Local Data.Conversation ->
Qualified UserId ->
diff --git a/services/galley/src/Galley/API/MLS/Welcome.hs b/services/galley/src/Galley/API/MLS/Welcome.hs
index 6db0f26127..936855d15a 100644
--- a/services/galley/src/Galley/API/MLS/Welcome.hs
+++ b/services/galley/src/Galley/API/MLS/Welcome.hs
@@ -60,8 +60,7 @@ postMLSWelcome ::
Member GundeckAccess r,
Member (ErrorS 'MLSKeyPackageRefNotFound) r,
Member (Input UTCTime) r,
- Member P.TinyLog r,
- CallsFed 'Galley "mls-welcome"
+ Member P.TinyLog r
) =>
Local x ->
Maybe ConnId ->
@@ -82,8 +81,7 @@ postMLSWelcomeFromLocalUser ::
Member (ErrorS 'MLSNotEnabled) r,
Member (Input UTCTime) r,
Member (Input Env) r,
- Member P.TinyLog r,
- CallsFed 'Galley "mls-welcome"
+ Member P.TinyLog r
) =>
Local x ->
ConnId ->
@@ -128,8 +126,7 @@ sendLocalWelcomes con now rawWelcome lclients = do
sendRemoteWelcomes ::
( Member FederatorAccess r,
- Member P.TinyLog r,
- CallsFed 'Galley "mls-welcome"
+ Member P.TinyLog r
) =>
ByteString ->
[Remote (UserId, ClientId)] ->
diff --git a/services/galley/src/Galley/API/Message.hs b/services/galley/src/Galley/API/Message.hs
index 2c95afe280..5ed9bdbde3 100644
--- a/services/galley/src/Galley/API/Message.hs
+++ b/services/galley/src/Galley/API/Message.hs
@@ -77,6 +77,7 @@ import Wire.API.Event.Conversation
import Wire.API.Federation.API
import Wire.API.Federation.API.Brig
import Wire.API.Federation.API.Galley
+import Wire.API.Federation.Client (FederatorClient)
import Wire.API.Federation.Error
import Wire.API.Message
import Wire.API.Routes.Public.Galley.Messaging
@@ -214,7 +215,7 @@ checkMessageClients sender participantMap recipientMap mismatchStrat =
)
getRemoteClients ::
- (Member FederatorAccess r, CallsFed 'Brig "get-user-clients") =>
+ (Member FederatorAccess r) =>
[RemoteMember] ->
Sem r (Map (Domain, UserId) (Set ClientId))
getRemoteClients remoteMembers =
@@ -222,13 +223,14 @@ getRemoteClients remoteMembers =
mconcat . map tUnqualified
<$> runFederatedConcurrently (map rmId remoteMembers) getRemoteClientsFromDomain
where
+ getRemoteClientsFromDomain :: Remote [UserId] -> FederatorClient 'Brig (Map (Domain, UserId) (Set ClientId))
getRemoteClientsFromDomain (tUntagged -> Qualified uids domain) =
Map.mapKeys (domain,) . fmap (Set.map pubClientId) . userMap
<$> fedClient @'Brig @"get-user-clients" (GetUserClients uids)
-- FUTUREWORK: sender should be Local UserId
postRemoteOtrMessage ::
- (Member FederatorAccess r, CallsFed 'Galley "send-message") =>
+ (Member FederatorAccess r) =>
Qualified UserId ->
Remote ConvId ->
ByteString ->
@@ -368,9 +370,7 @@ postQualifiedOtrMessage ::
Member (Input Opts) r,
Member (Input UTCTime) r,
Member TeamStore r,
- Member P.TinyLog r,
- CallsFed 'Galley "on-message-sent",
- CallsFed 'Brig "get-user-clients"
+ Member P.TinyLog r
) =>
UserType ->
Qualified UserId ->
@@ -477,8 +477,7 @@ sendMessages ::
Member ExternalAccess r,
Member FederatorAccess r,
Member P.TinyLog r
- ),
- CallsFed 'Galley "on-message-sent"
+ )
) =>
UTCTime ->
Qualified UserId ->
@@ -560,8 +559,7 @@ sendLocalMessages loc now sender senderClient mconn qcnv botMap metadata localMe
sendRemoteMessages ::
forall r x.
( Member FederatorAccess r,
- Member P.TinyLog r,
- CallsFed 'Galley "on-message-sent"
+ Member P.TinyLog r
) =>
Remote x ->
UTCTime ->
diff --git a/services/galley/src/Galley/API/Public/Bot.hs b/services/galley/src/Galley/API/Public/Bot.hs
index 06ea1f89fa..742008a9fe 100644
--- a/services/galley/src/Galley/API/Public/Bot.hs
+++ b/services/galley/src/Galley/API/Public/Bot.hs
@@ -24,4 +24,4 @@ import Wire.API.Routes.API
import Wire.API.Routes.Public.Galley.Bot
botAPI :: API BotAPI GalleyEffects
-botAPI = mkNamedAPI @"post-bot-message-unqualified" (callsFed (callsFed postBotMessageUnqualified))
+botAPI = mkNamedAPI @"post-bot-message-unqualified" (callsFed (exposeAnnotations postBotMessageUnqualified))
diff --git a/services/galley/src/Galley/API/Public/Conversation.hs b/services/galley/src/Galley/API/Public/Conversation.hs
index 04e84afa17..b6f74c525d 100644
--- a/services/galley/src/Galley/API/Public/Conversation.hs
+++ b/services/galley/src/Galley/API/Public/Conversation.hs
@@ -32,20 +32,20 @@ conversationAPI :: API ConversationAPI GalleyEffects
conversationAPI =
mkNamedAPI @"get-unqualified-conversation" getUnqualifiedConversation
<@> mkNamedAPI @"get-unqualified-conversation-legalhold-alias" getUnqualifiedConversation
- <@> mkNamedAPI @"get-conversation@v2" (callsFed getConversation)
- <@> mkNamedAPI @"get-conversation" (callsFed getConversation)
+ <@> mkNamedAPI @"get-conversation@v2" (callsFed (exposeAnnotations getConversation))
+ <@> mkNamedAPI @"get-conversation" (callsFed (exposeAnnotations getConversation))
<@> mkNamedAPI @"get-conversation-roles" getConversationRoles
- <@> mkNamedAPI @"get-group-info" (callsFed getGroupInfo)
+ <@> mkNamedAPI @"get-group-info" (callsFed (exposeAnnotations getGroupInfo))
<@> mkNamedAPI @"list-conversation-ids-unqualified" conversationIdsPageFromUnqualified
<@> mkNamedAPI @"list-conversation-ids-v2" (conversationIdsPageFromV2 DoNotListGlobalSelf)
<@> mkNamedAPI @"list-conversation-ids" conversationIdsPageFrom
<@> mkNamedAPI @"get-conversations" getConversations
- <@> mkNamedAPI @"list-conversations@v1" (callsFed listConversations)
- <@> mkNamedAPI @"list-conversations@v2" (callsFed listConversations)
- <@> mkNamedAPI @"list-conversations" (callsFed listConversations)
+ <@> mkNamedAPI @"list-conversations@v1" (callsFed (exposeAnnotations listConversations))
+ <@> mkNamedAPI @"list-conversations@v2" (callsFed (exposeAnnotations listConversations))
+ <@> mkNamedAPI @"list-conversations" (callsFed (exposeAnnotations listConversations))
<@> mkNamedAPI @"get-conversation-by-reusable-code" (getConversationByReusableCode @Cassandra)
- <@> mkNamedAPI @"create-group-conversation@v2" (callsFed createGroupConversation)
- <@> mkNamedAPI @"create-group-conversation" (callsFed createGroupConversation)
+ <@> mkNamedAPI @"create-group-conversation@v2" (callsFed (exposeAnnotations createGroupConversation))
+ <@> mkNamedAPI @"create-group-conversation" (callsFed (exposeAnnotations createGroupConversation))
<@> mkNamedAPI @"create-self-conversation@v2" createProteusSelfConversation
<@> mkNamedAPI @"create-self-conversation" createProteusSelfConversation
<@> mkNamedAPI @"get-mls-self-conversation" getMLSSelfConversationWithError
@@ -62,21 +62,21 @@ conversationAPI =
<@> mkNamedAPI @"remove-code-unqualified" rmCodeUnqualified
<@> mkNamedAPI @"get-code" (getCode @Cassandra)
<@> mkNamedAPI @"member-typing-unqualified" isTypingUnqualified
- <@> mkNamedAPI @"member-typing-qualified" (callsFed isTypingQualified)
- <@> mkNamedAPI @"remove-member-unqualified" (callsFed removeMemberUnqualified)
- <@> mkNamedAPI @"remove-member" (callsFed removeMemberQualified)
- <@> mkNamedAPI @"update-other-member-unqualified" (callsFed updateOtherMemberUnqualified)
- <@> mkNamedAPI @"update-other-member" (callsFed updateOtherMember)
- <@> mkNamedAPI @"update-conversation-name-deprecated" (callsFed updateUnqualifiedConversationName)
- <@> mkNamedAPI @"update-conversation-name-unqualified" (callsFed updateUnqualifiedConversationName)
- <@> mkNamedAPI @"update-conversation-name" (callsFed updateConversationName)
- <@> mkNamedAPI @"update-conversation-message-timer-unqualified" (callsFed updateConversationMessageTimerUnqualified)
- <@> mkNamedAPI @"update-conversation-message-timer" (callsFed updateConversationMessageTimer)
- <@> mkNamedAPI @"update-conversation-receipt-mode-unqualified" (callsFed updateConversationReceiptModeUnqualified)
- <@> mkNamedAPI @"update-conversation-receipt-mode" (callsFed updateConversationReceiptMode)
- <@> mkNamedAPI @"update-conversation-access-unqualified" (callsFed updateConversationAccessUnqualified)
- <@> mkNamedAPI @"update-conversation-access@v2" (callsFed updateConversationAccess)
- <@> mkNamedAPI @"update-conversation-access" (callsFed updateConversationAccess)
+ <@> mkNamedAPI @"member-typing-qualified" (callsFed (exposeAnnotations isTypingQualified))
+ <@> mkNamedAPI @"remove-member-unqualified" (callsFed (exposeAnnotations removeMemberUnqualified))
+ <@> mkNamedAPI @"remove-member" (callsFed (exposeAnnotations removeMemberQualified))
+ <@> mkNamedAPI @"update-other-member-unqualified" (callsFed (exposeAnnotations updateOtherMemberUnqualified))
+ <@> mkNamedAPI @"update-other-member" (callsFed (exposeAnnotations updateOtherMember))
+ <@> mkNamedAPI @"update-conversation-name-deprecated" (callsFed (exposeAnnotations updateUnqualifiedConversationName))
+ <@> mkNamedAPI @"update-conversation-name-unqualified" (callsFed (exposeAnnotations updateUnqualifiedConversationName))
+ <@> mkNamedAPI @"update-conversation-name" (callsFed (exposeAnnotations updateConversationName))
+ <@> mkNamedAPI @"update-conversation-message-timer-unqualified" (callsFed (exposeAnnotations updateConversationMessageTimerUnqualified))
+ <@> mkNamedAPI @"update-conversation-message-timer" (callsFed (exposeAnnotations updateConversationMessageTimer))
+ <@> mkNamedAPI @"update-conversation-receipt-mode-unqualified" (callsFed (exposeAnnotations updateConversationReceiptModeUnqualified))
+ <@> mkNamedAPI @"update-conversation-receipt-mode" (callsFed (exposeAnnotations updateConversationReceiptMode))
+ <@> mkNamedAPI @"update-conversation-access-unqualified" (callsFed (exposeAnnotations updateConversationAccessUnqualified))
+ <@> mkNamedAPI @"update-conversation-access@v2" (callsFed (exposeAnnotations updateConversationAccess))
+ <@> mkNamedAPI @"update-conversation-access" (callsFed (exposeAnnotations updateConversationAccess))
<@> mkNamedAPI @"get-conversation-self-unqualified" getLocalSelf
<@> mkNamedAPI @"update-conversation-self-unqualified" updateUnqualifiedSelfMember
<@> mkNamedAPI @"update-conversation-self" updateSelfMember
diff --git a/services/galley/src/Galley/API/Public/Feature.hs b/services/galley/src/Galley/API/Public/Feature.hs
index d2fe3408bd..3c959fe19c 100644
--- a/services/galley/src/Galley/API/Public/Feature.hs
+++ b/services/galley/src/Galley/API/Public/Feature.hs
@@ -31,7 +31,7 @@ featureAPI :: API FeatureAPI GalleyEffects
featureAPI =
mkNamedAPI @'("get", SSOConfig) (getFeatureStatus @Cassandra . DoAuth)
<@> mkNamedAPI @'("get", LegalholdConfig) (getFeatureStatus @Cassandra . DoAuth)
- <@> mkNamedAPI @'("put", LegalholdConfig) (callsFed (setFeatureStatus @Cassandra . DoAuth))
+ <@> mkNamedAPI @'("put", LegalholdConfig) (callsFed (exposeAnnotations (setFeatureStatus @Cassandra . DoAuth)))
<@> mkNamedAPI @'("get", SearchVisibilityAvailableConfig) (getFeatureStatus @Cassandra . DoAuth)
<@> mkNamedAPI @'("put", SearchVisibilityAvailableConfig) (setFeatureStatus @Cassandra . DoAuth)
<@> mkNamedAPI @'("get-deprecated", SearchVisibilityAvailableConfig) (getFeatureStatus @Cassandra . DoAuth)
diff --git a/services/galley/src/Galley/API/Public/LegalHold.hs b/services/galley/src/Galley/API/Public/LegalHold.hs
index 405d3ca61a..ef64ab8e4f 100644
--- a/services/galley/src/Galley/API/Public/LegalHold.hs
+++ b/services/galley/src/Galley/API/Public/LegalHold.hs
@@ -28,9 +28,9 @@ legalHoldAPI :: API LegalHoldAPI GalleyEffects
legalHoldAPI =
mkNamedAPI @"create-legal-hold-settings" (createSettings @Cassandra)
<@> mkNamedAPI @"get-legal-hold-settings" (getSettings @Cassandra)
- <@> mkNamedAPI @"delete-legal-hold-settings" (callsFed (callsFed (callsFed (removeSettingsInternalPaging @Cassandra))))
+ <@> mkNamedAPI @"delete-legal-hold-settings" (callsFed (exposeAnnotations (removeSettingsInternalPaging @Cassandra)))
<@> mkNamedAPI @"get-legal-hold" getUserStatus
- <@> mkNamedAPI @"consent-to-legal-hold" (callsFed (callsFed (callsFed grantConsent)))
- <@> mkNamedAPI @"request-legal-hold-device" (callsFed (callsFed (callsFed (requestDevice @Cassandra))))
- <@> mkNamedAPI @"disable-legal-hold-for-user" (callsFed (callsFed (callsFed disableForUser)))
- <@> mkNamedAPI @"approve-legal-hold-device" (callsFed (callsFed (callsFed (approveDevice @Cassandra))))
+ <@> mkNamedAPI @"consent-to-legal-hold" (callsFed (exposeAnnotations grantConsent))
+ <@> mkNamedAPI @"request-legal-hold-device" (callsFed (exposeAnnotations (requestDevice @Cassandra)))
+ <@> mkNamedAPI @"disable-legal-hold-for-user" (callsFed (exposeAnnotations disableForUser))
+ <@> mkNamedAPI @"approve-legal-hold-device" (callsFed (exposeAnnotations (approveDevice @Cassandra)))
diff --git a/services/galley/src/Galley/API/Public/MLS.hs b/services/galley/src/Galley/API/Public/MLS.hs
index 7581908ccf..73187b06da 100644
--- a/services/galley/src/Galley/API/Public/MLS.hs
+++ b/services/galley/src/Galley/API/Public/MLS.hs
@@ -25,8 +25,8 @@ import Wire.API.Routes.Public.Galley.MLS
mlsAPI :: API MLSAPI GalleyEffects
mlsAPI =
- mkNamedAPI @"mls-welcome-message" (callsFed postMLSWelcomeFromLocalUser)
- <@> mkNamedAPI @"mls-message-v1" (callsFed postMLSMessageFromLocalUserV1)
- <@> mkNamedAPI @"mls-message" (callsFed postMLSMessageFromLocalUser)
- <@> mkNamedAPI @"mls-commit-bundle" (callsFed postMLSCommitBundleFromLocalUser)
+ mkNamedAPI @"mls-welcome-message" (callsFed (exposeAnnotations postMLSWelcomeFromLocalUser))
+ <@> mkNamedAPI @"mls-message-v1" (callsFed (exposeAnnotations postMLSMessageFromLocalUserV1))
+ <@> mkNamedAPI @"mls-message" (callsFed (exposeAnnotations postMLSMessageFromLocalUser))
+ <@> mkNamedAPI @"mls-commit-bundle" (callsFed (exposeAnnotations postMLSCommitBundleFromLocalUser))
<@> mkNamedAPI @"mls-public-keys" getMLSPublicKeys
diff --git a/services/galley/src/Galley/API/Public/Messaging.hs b/services/galley/src/Galley/API/Public/Messaging.hs
index ae5a3248d9..efbbd7482f 100644
--- a/services/galley/src/Galley/API/Public/Messaging.hs
+++ b/services/galley/src/Galley/API/Public/Messaging.hs
@@ -25,7 +25,7 @@ import Wire.API.Routes.Public.Galley.Messaging
messagingAPI :: API MessagingAPI GalleyEffects
messagingAPI =
- mkNamedAPI @"post-otr-message-unqualified" (callsFed postOtrMessageUnqualified)
+ mkNamedAPI @"post-otr-message-unqualified" (callsFed (exposeAnnotations postOtrMessageUnqualified))
<@> mkNamedAPI @"post-otr-broadcast-unqualified" postOtrBroadcastUnqualified
- <@> mkNamedAPI @"post-proteus-message" (callsFed postProteusMessage)
+ <@> mkNamedAPI @"post-proteus-message" (callsFed (exposeAnnotations postProteusMessage))
<@> mkNamedAPI @"post-proteus-broadcast" postProteusBroadcast
diff --git a/services/galley/src/Galley/API/Public/TeamConversation.hs b/services/galley/src/Galley/API/Public/TeamConversation.hs
index 6aad651f3b..173d7aba61 100644
--- a/services/galley/src/Galley/API/Public/TeamConversation.hs
+++ b/services/galley/src/Galley/API/Public/TeamConversation.hs
@@ -28,4 +28,4 @@ teamConversationAPI =
mkNamedAPI @"get-team-conversation-roles" getTeamConversationRoles
<@> mkNamedAPI @"get-team-conversations" getTeamConversations
<@> mkNamedAPI @"get-team-conversation" getTeamConversation
- <@> mkNamedAPI @"delete-team-conversation" (callsFed deleteTeamConversation)
+ <@> mkNamedAPI @"delete-team-conversation" (callsFed (exposeAnnotations deleteTeamConversation))
diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs
index 2a08dd27bc..26290f4c1e 100644
--- a/services/galley/src/Galley/API/Query.hs
+++ b/services/galley/src/Galley/API/Query.hs
@@ -91,6 +91,7 @@ import Wire.API.Error
import Wire.API.Error.Galley
import Wire.API.Federation.API
import Wire.API.Federation.API.Galley
+import Wire.API.Federation.Client (FederatorClient)
import Wire.API.Federation.Error
import qualified Wire.API.Provider.Bot as Public
import qualified Wire.API.Routes.MultiTablePaging as Public
@@ -150,8 +151,7 @@ getConversation ::
Member (Error FederationError) r,
Member (Error InternalError) r,
Member FederatorAccess r,
- Member P.TinyLog r,
- CallsFed 'Galley "get-conversations"
+ Member P.TinyLog r
) =>
Local UserId ->
Qualified ConvId ->
@@ -177,8 +177,7 @@ getRemoteConversations ::
Member (Error FederationError) r,
Member (ErrorS 'ConvNotFound) r,
Member FederatorAccess r,
- Member P.TinyLog r,
- CallsFed 'Galley "get-conversations"
+ Member P.TinyLog r
) =>
Local UserId ->
[Remote ConvId] ->
@@ -235,8 +234,7 @@ partitionGetConversationFailures = bimap concat concat . partitionEithers . map
getRemoteConversationsWithFailures ::
( Member ConversationStore r,
Member FederatorAccess r,
- Member P.TinyLog r,
- CallsFed 'Galley "get-conversations"
+ Member P.TinyLog r
) =>
Local UserId ->
[Remote ConvId] ->
@@ -260,7 +258,8 @@ getRemoteConversationsWithFailures lusr convs = do
| otherwise = [failedGetConversationLocally (map tUntagged locallyNotFound)]
-- request conversations from remote backends
- let rpc = fedClient @'Galley @"get-conversations"
+ let rpc :: GetConversationsRequest -> FederatorClient 'Galley GetConversationsResponse
+ rpc = fedClient @'Galley @"get-conversations"
resp <-
E.runFederatedConcurrentlyEither locallyFound $ \someConvs ->
rpc $ GetConversationsRequest (tUnqualified lusr) (tUnqualified someConvs)
@@ -499,8 +498,7 @@ listConversations ::
( Member ConversationStore r,
Member (Error InternalError) r,
Member FederatorAccess r,
- Member P.TinyLog r,
- CallsFed 'Galley "get-conversations"
+ Member P.TinyLog r
) =>
Local UserId ->
Public.ListConversations ->
diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs
index 18ed8631ea..393a49f45b 100644
--- a/services/galley/src/Galley/API/Teams.hs
+++ b/services/galley/src/Galley/API/Teams.hs
@@ -127,7 +127,6 @@ import Wire.API.Error
import Wire.API.Error.Galley
import qualified Wire.API.Event.Conversation as Conv
import Wire.API.Event.Team
-import Wire.API.Federation.API
import Wire.API.Federation.Error
import qualified Wire.API.Message as Conv
import Wire.API.Routes.Internal.Galley.TeamsIntra
@@ -1099,9 +1098,7 @@ deleteTeamConversation ::
Member FederatorAccess r,
Member GundeckAccess r,
Member (Input UTCTime) r,
- Member TeamStore r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member TeamStore r
) =>
Local UserId ->
ConnId ->
diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs
index 6b3f313b1b..61dca43056 100644
--- a/services/galley/src/Galley/API/Teams/Features.hs
+++ b/services/galley/src/Galley/API/Teams/Features.hs
@@ -76,7 +76,6 @@ import Wire.API.Conversation.Role (Action (RemoveConversationMember))
import Wire.API.Error (ErrorS, throwS)
import Wire.API.Error.Galley
import qualified Wire.API.Event.FeatureConfig as Event
-import Wire.API.Federation.API
import qualified Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti as Multi
import Wire.API.Team.Feature
import Wire.API.Team.Member
@@ -669,13 +668,7 @@ instance GetFeatureConfig db LegalholdConfig where
False -> FeatureStatusDisabled
pure $ setStatus status defFeatureStatus
-instance
- ( CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-new-remote-conversation"
- ) =>
- SetFeatureConfig db LegalholdConfig
- where
+instance SetFeatureConfig db LegalholdConfig where
type
SetConfigForTeamConstraints db LegalholdConfig (r :: EffectRow) =
( Bounded (PagingBounds InternalPaging TeamMember),
diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs
index 06193bd8cc..8243d941c8 100644
--- a/services/galley/src/Galley/API/Update.hs
+++ b/services/galley/src/Galley/API/Update.hs
@@ -274,10 +274,7 @@ type UpdateConversationAccessEffects =
]
updateConversationAccess ::
- ( Members UpdateConversationAccessEffects r,
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-new-remote-conversation",
- CallsFed 'Galley "on-conversation-updated"
+ ( Members UpdateConversationAccessEffects r
) =>
Local UserId ->
ConnId ->
@@ -290,10 +287,7 @@ updateConversationAccess lusr con qcnv update = do
updateLocalConversation @'ConversationAccessDataTag lcnv (tUntagged lusr) (Just con) update
updateConversationAccessUnqualified ::
- ( Members UpdateConversationAccessEffects r,
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-new-remote-conversation",
- CallsFed 'Galley "on-conversation-updated"
+ ( Members UpdateConversationAccessEffects r
) =>
Local UserId ->
ConnId ->
@@ -321,10 +315,7 @@ updateConversationReceiptMode ::
Member (Input (Local ())) r,
Member (Input UTCTime) r,
Member MemberStore r,
- Member TinyLog r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation",
- CallsFed 'Galley "update-conversation"
+ Member TinyLog r
) =>
Local UserId ->
ConnId ->
@@ -356,8 +347,7 @@ updateRemoteConversation ::
Member MemberStore r,
Member TinyLog r,
RethrowErrors (HasConversationActionGalleyErrors tag) (Error NoChanges : r),
- SingI tag,
- CallsFed 'Galley "update-conversation"
+ SingI tag
) =>
Remote ConvId ->
Local UserId ->
@@ -393,10 +383,7 @@ updateConversationReceiptModeUnqualified ::
Member (Input (Local ())) r,
Member (Input UTCTime) r,
Member MemberStore r,
- Member TinyLog r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation",
- CallsFed 'Galley "update-conversation"
+ Member TinyLog r
) =>
Local UserId ->
ConnId ->
@@ -414,9 +401,7 @@ updateConversationMessageTimer ::
Member ExternalAccess r,
Member FederatorAccess r,
Member GundeckAccess r,
- Member (Input UTCTime) r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member (Input UTCTime) r
) =>
Local UserId ->
ConnId ->
@@ -448,9 +433,7 @@ updateConversationMessageTimerUnqualified ::
Member ExternalAccess r,
Member FederatorAccess r,
Member GundeckAccess r,
- Member (Input UTCTime) r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member (Input UTCTime) r
) =>
Local UserId ->
ConnId ->
@@ -471,9 +454,7 @@ deleteLocalConversation ::
Member FederatorAccess r,
Member GundeckAccess r,
Member (Input UTCTime) r,
- Member TeamStore r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member TeamStore r
) =>
Local UserId ->
ConnId ->
@@ -672,9 +653,7 @@ joinConversationByReusableCode ::
Member MemberStore r,
Member TeamStore r,
Member (TeamFeatureStore db) r,
- FeaturePersistentConstraint db GuestLinksConfig,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation"
+ FeaturePersistentConstraint db GuestLinksConfig
) =>
Local UserId ->
ConnId ->
@@ -701,9 +680,7 @@ joinConversationById ::
Member (Input Opts) r,
Member (Input UTCTime) r,
Member MemberStore r,
- Member TeamStore r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member TeamStore r
) =>
Local UserId ->
ConnId ->
@@ -726,9 +703,7 @@ joinConversation ::
Member (Input Opts) r,
Member (Input UTCTime) r,
Member MemberStore r,
- Member TeamStore r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member TeamStore r
) =>
Local UserId ->
ConnId ->
@@ -782,10 +757,7 @@ addMembers ::
Member MemberStore r,
Member ProposalStore r,
Member TeamStore r,
- Member TinyLog r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member TinyLog r
) =>
Local UserId ->
ConnId ->
@@ -822,10 +794,7 @@ addMembersUnqualifiedV2 ::
Member MemberStore r,
Member ProposalStore r,
Member TeamStore r,
- Member TinyLog r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member TinyLog r
) =>
Local UserId ->
ConnId ->
@@ -862,10 +831,7 @@ addMembersUnqualified ::
Member MemberStore r,
Member ProposalStore r,
Member TeamStore r,
- Member TinyLog r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member TinyLog r
) =>
Local UserId ->
ConnId ->
@@ -951,9 +917,7 @@ updateOtherMemberLocalConv ::
Member FederatorAccess r,
Member GundeckAccess r,
Member (Input UTCTime) r,
- Member MemberStore r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member MemberStore r
) =>
Local ConvId ->
Local UserId ->
@@ -978,9 +942,7 @@ updateOtherMemberUnqualified ::
Member FederatorAccess r,
Member GundeckAccess r,
Member (Input UTCTime) r,
- Member MemberStore r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member MemberStore r
) =>
Local UserId ->
ConnId ->
@@ -1005,9 +967,7 @@ updateOtherMember ::
Member FederatorAccess r,
Member GundeckAccess r,
Member (Input UTCTime) r,
- Member MemberStore r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member MemberStore r
) =>
Local UserId ->
ConnId ->
@@ -1042,11 +1002,7 @@ removeMemberUnqualified ::
Member (Input UTCTime) r,
Member MemberStore r,
Member ProposalStore r,
- Member TinyLog r,
- CallsFed 'Galley "leave-conversation",
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member TinyLog r
) =>
Local UserId ->
ConnId ->
@@ -1071,11 +1027,7 @@ removeMemberQualified ::
Member (Input UTCTime) r,
Member MemberStore r,
Member ProposalStore r,
- Member TinyLog r,
- CallsFed 'Galley "leave-conversation",
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member TinyLog r
) =>
Local UserId ->
ConnId ->
@@ -1095,8 +1047,7 @@ removeMemberFromRemoteConv ::
( Member FederatorAccess r,
Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
Member (ErrorS 'ConvNotFound) r,
- Member (Input UTCTime) r,
- CallsFed 'Galley "leave-conversation"
+ Member (Input UTCTime) r
) =>
Remote ConvId ->
Local UserId ->
@@ -1143,10 +1094,7 @@ removeMemberFromLocalConv ::
Member (Input UTCTime) r,
Member MemberStore r,
Member ProposalStore r,
- Member TinyLog r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-mls-message-sent",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member TinyLog r
) =>
Local ConvId ->
Local UserId ->
@@ -1178,10 +1126,7 @@ postProteusMessage ::
Member (Input Opts) r,
Member (Input UTCTime) r,
Member TeamStore r,
- Member TinyLog r,
- CallsFed 'Brig "get-user-clients",
- CallsFed 'Galley "on-message-sent",
- CallsFed 'Galley "send-message"
+ Member TinyLog r
) =>
Local UserId ->
ConnId ->
@@ -1255,9 +1200,7 @@ postBotMessageUnqualified ::
Member (Input Opts) r,
Member TeamStore r,
Member TinyLog r,
- Member (Input UTCTime) r,
- CallsFed 'Galley "on-message-sent",
- CallsFed 'Brig "get-user-clients"
+ Member (Input UTCTime) r
) =>
BotId ->
ConvId ->
@@ -1308,9 +1251,7 @@ postOtrMessageUnqualified ::
Member (Input Opts) r,
Member (Input UTCTime) r,
Member TeamStore r,
- Member TinyLog r,
- CallsFed 'Galley "on-message-sent",
- CallsFed 'Brig "get-user-clients"
+ Member TinyLog r
) =>
Local UserId ->
ConnId ->
@@ -1335,9 +1276,7 @@ updateConversationName ::
Member ExternalAccess r,
Member FederatorAccess r,
Member GundeckAccess r,
- Member (Input UTCTime) r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member (Input UTCTime) r
) =>
Local UserId ->
ConnId ->
@@ -1361,9 +1300,7 @@ updateUnqualifiedConversationName ::
Member ExternalAccess r,
Member FederatorAccess r,
Member GundeckAccess r,
- Member (Input UTCTime) r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member (Input UTCTime) r
) =>
Local UserId ->
ConnId ->
@@ -1383,9 +1320,7 @@ updateLocalConversationName ::
Member ExternalAccess r,
Member FederatorAccess r,
Member GundeckAccess r,
- Member (Input UTCTime) r,
- CallsFed 'Galley "on-conversation-updated",
- CallsFed 'Galley "on-new-remote-conversation"
+ Member (Input UTCTime) r
) =>
Local UserId ->
ConnId ->
@@ -1402,8 +1337,7 @@ isTypingQualified ::
Member (Input (Local ())) r,
Member (Input UTCTime) r,
Member MemberStore r,
- Member FederatorAccess r,
- CallsFed 'Galley "on-typing-indicator-updated"
+ Member FederatorAccess r
) =>
Local UserId ->
ConnId ->
diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs
index 8205012fda..51595a43d3 100644
--- a/services/galley/src/Galley/API/Util.hs
+++ b/services/galley/src/Galley/API/Util.hs
@@ -750,7 +750,7 @@ fromConversationCreated loc rc@ConversationCreated {..} =
-- | Notify remote users of being added to a new conversation
registerRemoteConversationMemberships ::
- (Member FederatorAccess r, CallsFed 'Galley "on-conversation-created") =>
+ (Member FederatorAccess r) =>
-- | The time stamp when the conversation was created
UTCTime ->
-- | The domain of the user that created the conversation