module Wire.FederationConfigStore.Cassandra
( interpretFederationDomainConfig,
remotesMapFromCfgFile,
AddFederationRemoteResult (..),
)
where
import Cassandra
import Control.Exception (ErrorCall (ErrorCall))
import Control.Lens
import Control.Monad.Catch (throwM)
import Data.Domain
import Data.Id
import Data.Map qualified as Map
import Data.Qualified
import Database.CQL.Protocol (SerialConsistency (LocalSerialConsistency), serialConsistency)
import Imports
import Polysemy
import Polysemy.Embed
import Wire.API.Routes.FederationDomainConfig
import Wire.API.User.Search
import Wire.FederationConfigStore
interpretFederationDomainConfig ::
forall r a.
( Member (Embed IO) r
) =>
ClientState ->
Maybe FederationStrategy ->
Map Domain FederationDomainConfig ->
Sem (FederationConfigStore ': r) a ->
Sem r a
interpretFederationDomainConfig :: forall (r :: EffectRow) a.
Member (Embed IO) r =>
ClientState
-> Maybe FederationStrategy
-> Map Domain FederationDomainConfig
-> Sem (FederationConfigStore : r) a
-> Sem r a
interpretFederationDomainConfig ClientState
casClient Maybe FederationStrategy
mFedStrategy Map Domain FederationDomainConfig
fedCfgs =
(forall (rInitial :: EffectRow) x.
FederationConfigStore (Sem rInitial) x -> Sem r x)
-> Sem (FederationConfigStore : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall (rInitial :: EffectRow) x.
FederationConfigStore (Sem rInitial) x -> Sem r x)
-> Sem (FederationConfigStore : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
FederationConfigStore (Sem rInitial) x -> Sem r x)
-> Sem (FederationConfigStore : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$
(forall x. Client x -> IO x) -> Sem (Embed Client : r) x -> Sem r x
forall (m1 :: * -> *) (m2 :: * -> *) (r :: EffectRow) a.
Member (Embed m2) r =>
(forall x. m1 x -> m2 x) -> Sem (Embed m1 : r) a -> Sem r a
runEmbedded (ClientState -> Client x -> IO x
forall (m :: * -> *) a. MonadIO m => ClientState -> Client a -> m a
runClient ClientState
casClient) (Sem (Embed Client : r) x -> Sem r x)
-> (FederationConfigStore (Sem rInitial) x
-> Sem (Embed Client : r) x)
-> FederationConfigStore (Sem rInitial) x
-> Sem r x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Client x -> Sem (Embed Client : r) x
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (Client x -> Sem (Embed Client : r) x)
-> (FederationConfigStore (Sem rInitial) x -> Client x)
-> FederationConfigStore (Sem rInitial) x
-> Sem (Embed Client : r) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
GetFederationConfig Domain
d -> Map Domain FederationDomainConfig
-> Domain -> Client (Maybe FederationDomainConfig)
forall (m :: * -> *).
MonadClient m =>
Map Domain FederationDomainConfig
-> Domain -> m (Maybe FederationDomainConfig)
getFederationConfig' Map Domain FederationDomainConfig
fedCfgs Domain
d
FederationConfigStore (Sem rInitial) x
GetFederationConfigs -> Maybe FederationStrategy
-> Map Domain FederationDomainConfig
-> Client FederationDomainConfigs
forall (m :: * -> *).
MonadClient m =>
Maybe FederationStrategy
-> Map Domain FederationDomainConfig -> m FederationDomainConfigs
getFederationConfigs' Maybe FederationStrategy
mFedStrategy Map Domain FederationDomainConfig
fedCfgs
AddFederationConfig FederationDomainConfig
cnf -> Map Domain FederationDomainConfig
-> FederationDomainConfig -> Client AddFederationRemoteResult
forall (m :: * -> *).
MonadClient m =>
Map Domain FederationDomainConfig
-> FederationDomainConfig -> m AddFederationRemoteResult
addFederationConfig' Map Domain FederationDomainConfig
fedCfgs FederationDomainConfig
cnf
UpdateFederationConfig FederationDomainConfig
cnf -> Map Domain FederationDomainConfig
-> FederationDomainConfig -> Client UpdateFederationResult
forall (m :: * -> *).
MonadClient m =>
Map Domain FederationDomainConfig
-> FederationDomainConfig -> m UpdateFederationResult
updateFederationConfig' Map Domain FederationDomainConfig
fedCfgs FederationDomainConfig
cnf
AddFederationRemoteTeam Domain
d TeamId
t -> Map Domain FederationDomainConfig
-> Domain -> TeamId -> Client AddFederationRemoteTeamResult
forall (m :: * -> *).
MonadClient m =>
Map Domain FederationDomainConfig
-> Domain -> TeamId -> m AddFederationRemoteTeamResult
addFederationRemoteTeam' Map Domain FederationDomainConfig
fedCfgs Domain
d TeamId
t
RemoveFederationRemoteTeam Domain
d TeamId
t -> Domain -> TeamId -> Client ()
forall (m :: * -> *). MonadClient m => Domain -> TeamId -> m ()
removeFederationRemoteTeam' Domain
d TeamId
t
GetFederationRemoteTeams Domain
d -> Domain -> Client [FederationRemoteTeam]
forall (m :: * -> *).
MonadClient m =>
Domain -> m [FederationRemoteTeam]
getFederationRemoteTeams' Domain
d
BackendFederatesWith Remote (Maybe TeamId)
mtid -> Remote (Maybe TeamId)
-> Map Domain FederationDomainConfig
-> Maybe FederationStrategy
-> Client Bool
forall (m :: * -> *).
MonadClient m =>
Remote (Maybe TeamId)
-> Map Domain FederationDomainConfig
-> Maybe FederationStrategy
-> m Bool
backendFederatesWithImpl Remote (Maybe TeamId)
mtid Map Domain FederationDomainConfig
fedCfgs Maybe FederationStrategy
mFedStrategy
remotesMapFromCfgFile :: [FederationDomainConfig] -> Map Domain FederationDomainConfig
remotesMapFromCfgFile :: [FederationDomainConfig] -> Map Domain FederationDomainConfig
remotesMapFromCfgFile [FederationDomainConfig]
cfg =
let dict :: [(Domain, FederationDomainConfig)]
dict = [(FederationDomainConfig
cnf.domain, FederationDomainConfig
cnf) | FederationDomainConfig
cnf <- [FederationDomainConfig]
cfg]
merge :: b -> b -> b
merge b
c b
c' =
if b
c b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
c'
then b
c
else [Char] -> b
forall a. HasCallStack => [Char] -> a
error ([Char] -> b) -> [Char] -> b
forall a b. (a -> b) -> a -> b
$ [Char]
"error in config file: conflicting parameters on domain: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> (b, b) -> [Char]
forall a. Show a => a -> [Char]
show (b
c, b
c')
in (FederationDomainConfig
-> FederationDomainConfig -> FederationDomainConfig)
-> [(Domain, FederationDomainConfig)]
-> Map Domain FederationDomainConfig
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith FederationDomainConfig
-> FederationDomainConfig -> FederationDomainConfig
forall {b}. (Eq b, Show b) => b -> b -> b
merge [(Domain, FederationDomainConfig)]
dict
getFederationConfigs' ::
forall m.
(MonadClient m) =>
Maybe FederationStrategy ->
Map Domain FederationDomainConfig ->
m FederationDomainConfigs
getFederationConfigs' :: forall (m :: * -> *).
MonadClient m =>
Maybe FederationStrategy
-> Map Domain FederationDomainConfig -> m FederationDomainConfigs
getFederationConfigs' Maybe FederationStrategy
mFedStrategy Map Domain FederationDomainConfig
cfgs = do
[FederationDomainConfig]
remotes <-
[FederationDomainConfig]
-> [FederationDomainConfig] -> [FederationDomainConfig]
forall a. Semigroup a => a -> a -> a
(<>)
([FederationDomainConfig]
-> [FederationDomainConfig] -> [FederationDomainConfig])
-> m [FederationDomainConfig]
-> m ([FederationDomainConfig] -> [FederationDomainConfig])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [FederationDomainConfig]
forall (m :: * -> *). MonadClient m => m [FederationDomainConfig]
getFederationRemotesFromDb
m ([FederationDomainConfig] -> [FederationDomainConfig])
-> m [FederationDomainConfig] -> m [FederationDomainConfig]
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [FederationDomainConfig] -> m [FederationDomainConfig]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map Domain FederationDomainConfig -> [FederationDomainConfig]
forall k a. Map k a -> [a]
Map.elems Map Domain FederationDomainConfig
cfgs)
FederationDomainConfigs
defFederationDomainConfigs
FederationDomainConfigs
-> (FederationDomainConfigs -> FederationDomainConfigs)
-> FederationDomainConfigs
forall a b. a -> (a -> b) -> b
& (FederationDomainConfigs -> FederationDomainConfigs)
-> (FederationStrategy
-> FederationDomainConfigs -> FederationDomainConfigs)
-> Maybe FederationStrategy
-> FederationDomainConfigs
-> FederationDomainConfigs
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FederationDomainConfigs -> FederationDomainConfigs
forall a. a -> a
id (\FederationStrategy
v FederationDomainConfigs
cfg -> FederationDomainConfigs
cfg {strategy = v}) Maybe FederationStrategy
mFedStrategy
FederationDomainConfigs
-> (FederationDomainConfigs -> FederationDomainConfigs)
-> FederationDomainConfigs
forall a b. a -> (a -> b) -> b
& (\FederationDomainConfigs
cfg -> FederationDomainConfigs
cfg {remotes = remotes})
FederationDomainConfigs
-> (FederationDomainConfigs -> m FederationDomainConfigs)
-> m FederationDomainConfigs
forall a b. a -> (a -> b) -> b
& FederationDomainConfigs -> m FederationDomainConfigs
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
maxKnownNodes :: Int
maxKnownNodes :: Int
maxKnownNodes = Int
10000
getFederationConfig' :: (MonadClient m) => Map Domain FederationDomainConfig -> Domain -> m (Maybe FederationDomainConfig)
getFederationConfig' :: forall (m :: * -> *).
MonadClient m =>
Map Domain FederationDomainConfig
-> Domain -> m (Maybe FederationDomainConfig)
getFederationConfig' Map Domain FederationDomainConfig
cfgs Domain
rDomain = case (FederationDomainConfig -> Bool)
-> Map Domain FederationDomainConfig
-> Maybe FederationDomainConfig
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Domain -> Domain -> Bool
forall a. Eq a => a -> a -> Bool
== Domain
rDomain) (Domain -> Bool)
-> (FederationDomainConfig -> Domain)
-> FederationDomainConfig
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FederationDomainConfig -> Domain
domain) Map Domain FederationDomainConfig
cfgs of
Just FederationDomainConfig
cfg -> Maybe FederationDomainConfig -> m (Maybe FederationDomainConfig)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FederationDomainConfig -> m (Maybe FederationDomainConfig))
-> (FederationDomainConfig -> Maybe FederationDomainConfig)
-> FederationDomainConfig
-> m (Maybe FederationDomainConfig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FederationDomainConfig -> Maybe FederationDomainConfig
forall a. a -> Maybe a
Just (FederationDomainConfig -> m (Maybe FederationDomainConfig))
-> FederationDomainConfig -> m (Maybe FederationDomainConfig)
forall a b. (a -> b) -> a -> b
$ FederationDomainConfig
cfg
Maybe FederationDomainConfig
Nothing -> do
Maybe (FederatedUserSearchPolicy, Maybe Int32)
mCnf <- RetrySettings
-> m (Maybe (FederatedUserSearchPolicy, Maybe Int32))
-> m (Maybe (FederatedUserSearchPolicy, Maybe Int32))
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (PrepQuery
R (Identity Domain) (FederatedUserSearchPolicy, Maybe Int32)
-> QueryParams (Identity Domain)
-> m (Maybe (FederatedUserSearchPolicy, Maybe Int32))
forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m (Maybe b)
query1 PrepQuery
R (Identity Domain) (FederatedUserSearchPolicy, Maybe Int32)
q (Consistency -> Identity Domain -> QueryParams (Identity Domain)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (Domain -> Identity Domain
forall a. a -> Identity a
Identity Domain
rDomain)))
case Maybe (FederatedUserSearchPolicy, Maybe Int32)
mCnf of
Just (FederatedUserSearchPolicy
p, Maybe Int32
r) -> FederationDomainConfig -> Maybe FederationDomainConfig
forall a. a -> Maybe a
Just (FederationDomainConfig -> Maybe FederationDomainConfig)
-> (FederationRestriction -> FederationDomainConfig)
-> FederationRestriction
-> Maybe FederationDomainConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Domain
-> FederatedUserSearchPolicy
-> FederationRestriction
-> FederationDomainConfig
FederationDomainConfig Domain
rDomain FederatedUserSearchPolicy
p (FederationRestriction -> Maybe FederationDomainConfig)
-> m FederationRestriction -> m (Maybe FederationDomainConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Domain -> Int32 -> m FederationRestriction
forall (m :: * -> *).
MonadClient m =>
Domain -> Int32 -> m FederationRestriction
toRestriction Domain
rDomain (Int32 -> Maybe Int32 -> Int32
forall a. a -> Maybe a -> a
fromMaybe Int32
0 Maybe Int32
r)
Maybe (FederatedUserSearchPolicy, Maybe Int32)
Nothing -> Maybe FederationDomainConfig -> m (Maybe FederationDomainConfig)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FederationDomainConfig
forall a. Maybe a
Nothing
where
q :: PrepQuery R (Identity Domain) (FederatedUserSearchPolicy, Maybe Int32)
q :: PrepQuery
R (Identity Domain) (FederatedUserSearchPolicy, Maybe Int32)
q = PrepQuery
R (Identity Domain) (FederatedUserSearchPolicy, Maybe Int32)
"SELECT search_policy, restriction FROM federation_remotes WHERE domain = ?"
getFederationRemotesFromDb :: forall m. (MonadClient m) => m [FederationDomainConfig]
getFederationRemotesFromDb :: forall (m :: * -> *). MonadClient m => m [FederationDomainConfig]
getFederationRemotesFromDb = (\(Domain
d, FederatedUserSearchPolicy
p, FederationRestriction
r) -> Domain
-> FederatedUserSearchPolicy
-> FederationRestriction
-> FederationDomainConfig
FederationDomainConfig Domain
d FederatedUserSearchPolicy
p FederationRestriction
r) ((Domain, FederatedUserSearchPolicy, FederationRestriction)
-> FederationDomainConfig)
-> m [(Domain, FederatedUserSearchPolicy, FederationRestriction)]
-> m [FederationDomainConfig]
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> m [(Domain, FederatedUserSearchPolicy, FederationRestriction)]
qry
where
qry :: m [(Domain, FederatedUserSearchPolicy, FederationRestriction)]
qry :: m [(Domain, FederatedUserSearchPolicy, FederationRestriction)]
qry = do
[(Domain, FederatedUserSearchPolicy, Maybe Int32)]
res <- RetrySettings
-> m [(Domain, FederatedUserSearchPolicy, Maybe Int32)]
-> m [(Domain, FederatedUserSearchPolicy, Maybe Int32)]
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (m [(Domain, FederatedUserSearchPolicy, Maybe Int32)]
-> m [(Domain, FederatedUserSearchPolicy, Maybe Int32)])
-> (QueryParams ()
-> m [(Domain, FederatedUserSearchPolicy, Maybe Int32)])
-> QueryParams ()
-> m [(Domain, FederatedUserSearchPolicy, Maybe Int32)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrepQuery R () (Domain, FederatedUserSearchPolicy, Maybe Int32)
-> QueryParams ()
-> m [(Domain, FederatedUserSearchPolicy, Maybe Int32)]
forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m [b]
query PrepQuery R () (Domain, FederatedUserSearchPolicy, Maybe Int32)
get (QueryParams ()
-> m [(Domain, FederatedUserSearchPolicy, Maybe Int32)])
-> QueryParams ()
-> m [(Domain, FederatedUserSearchPolicy, Maybe Int32)]
forall a b. (a -> b) -> a -> b
$ Consistency -> () -> QueryParams ()
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum ()
[(Domain, FederatedUserSearchPolicy, Maybe Int32)]
-> ((Domain, FederatedUserSearchPolicy, Maybe Int32)
-> m (Domain, FederatedUserSearchPolicy, FederationRestriction))
-> m [(Domain, FederatedUserSearchPolicy, FederationRestriction)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Domain, FederatedUserSearchPolicy, Maybe Int32)]
res (((Domain, FederatedUserSearchPolicy, Maybe Int32)
-> m (Domain, FederatedUserSearchPolicy, FederationRestriction))
-> m [(Domain, FederatedUserSearchPolicy, FederationRestriction)])
-> ((Domain, FederatedUserSearchPolicy, Maybe Int32)
-> m (Domain, FederatedUserSearchPolicy, FederationRestriction))
-> m [(Domain, FederatedUserSearchPolicy, FederationRestriction)]
forall a b. (a -> b) -> a -> b
$ \(Domain
d, FederatedUserSearchPolicy
p, Maybe Int32
rInt) -> do
(Domain
d,FederatedUserSearchPolicy
p,) (FederationRestriction
-> (Domain, FederatedUserSearchPolicy, FederationRestriction))
-> m FederationRestriction
-> m (Domain, FederatedUserSearchPolicy, FederationRestriction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Domain -> Int32 -> m FederationRestriction
forall (m :: * -> *).
MonadClient m =>
Domain -> Int32 -> m FederationRestriction
toRestriction Domain
d (Int32 -> Maybe Int32 -> Int32
forall a. a -> Maybe a -> a
fromMaybe Int32
0 Maybe Int32
rInt)
get :: PrepQuery R () (Domain, FederatedUserSearchPolicy, Maybe Int32)
get :: PrepQuery R () (Domain, FederatedUserSearchPolicy, Maybe Int32)
get = [Char]
-> PrepQuery R () (Domain, FederatedUserSearchPolicy, Maybe Int32)
forall a. IsString a => [Char] -> a
fromString ([Char]
-> PrepQuery R () (Domain, FederatedUserSearchPolicy, Maybe Int32))
-> [Char]
-> PrepQuery R () (Domain, FederatedUserSearchPolicy, Maybe Int32)
forall a b. (a -> b) -> a -> b
$ [Char]
"SELECT domain, search_policy, restriction FROM federation_remotes LIMIT " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
maxKnownNodes
addFederationConfig' :: (MonadClient m) => Map Domain FederationDomainConfig -> FederationDomainConfig -> m AddFederationRemoteResult
addFederationConfig' :: forall (m :: * -> *).
MonadClient m =>
Map Domain FederationDomainConfig
-> FederationDomainConfig -> m AddFederationRemoteResult
addFederationConfig' Map Domain FederationDomainConfig
cfg (FederationDomainConfig Domain
rDomain FederatedUserSearchPolicy
searchPolicy FederationRestriction
restriction) = do
Bool
conflict <- FederationDomainConfig -> m Bool
forall (m :: * -> *). Monad m => FederationDomainConfig -> m Bool
domainExistsInConfig (Domain
-> FederatedUserSearchPolicy
-> FederationRestriction
-> FederationDomainConfig
FederationDomainConfig Domain
rDomain FederatedUserSearchPolicy
searchPolicy FederationRestriction
restriction)
if Bool
conflict
then AddFederationRemoteResult -> m AddFederationRemoteResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AddFederationRemoteResult -> m AddFederationRemoteResult)
-> AddFederationRemoteResult -> m AddFederationRemoteResult
forall a b. (a -> b) -> a -> b
$ Map Domain FederationDomainConfig -> AddFederationRemoteResult
AddFederationRemoteDivergingConfig Map Domain FederationDomainConfig
cfg
else do
Int
l <- [FederationDomainConfig] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([FederationDomainConfig] -> Int)
-> m [FederationDomainConfig] -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [FederationDomainConfig]
forall (m :: * -> *). MonadClient m => m [FederationDomainConfig]
getFederationRemotesFromDb
if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxKnownNodes
then AddFederationRemoteResult -> m AddFederationRemoteResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AddFederationRemoteResult
AddFederationRemoteMaxRemotesReached
else
AddFederationRemoteResult
AddFederationRemoteSuccess AddFederationRemoteResult -> m () -> m AddFederationRemoteResult
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
RetrySettings -> m () -> m ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (PrepQuery W (Domain, FederatedUserSearchPolicy, Int32) ()
-> QueryParams (Domain, FederatedUserSearchPolicy, Int32) -> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Domain, FederatedUserSearchPolicy, Int32) ()
addConfig (Consistency
-> (Domain, FederatedUserSearchPolicy, Int32)
-> QueryParams (Domain, FederatedUserSearchPolicy, Int32)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (Domain
rDomain, FederatedUserSearchPolicy
searchPolicy, FederationRestriction -> Int32
fromRestriction FederationRestriction
restriction)))
case FederationRestriction
restriction of
FederationRestrictionByTeam [TeamId]
tids ->
RetrySettings -> m () -> m ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (m () -> m ())
-> ((TeamId -> BatchM ()) -> m ()) -> (TeamId -> BatchM ()) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BatchM () -> m ()
forall (m :: * -> *). MonadClient m => BatchM () -> m ()
batch (BatchM () -> m ())
-> ((TeamId -> BatchM ()) -> BatchM ())
-> (TeamId -> BatchM ())
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TeamId] -> (TeamId -> BatchM ()) -> BatchM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TeamId]
tids ((TeamId -> BatchM ()) -> m ()) -> (TeamId -> BatchM ()) -> m ()
forall a b. (a -> b) -> a -> b
$ PrepQuery W (Domain, TeamId) () -> (Domain, TeamId) -> BatchM ()
forall a b.
(Show a, Tuple a, Tuple b) =>
PrepQuery W a b -> a -> BatchM ()
addPrepQuery PrepQuery W (Domain, TeamId) ()
addTeams ((Domain, TeamId) -> BatchM ())
-> (TeamId -> (Domain, TeamId)) -> TeamId -> BatchM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Domain
rDomain,)
FederationRestriction
FederationRestrictionAllowAll -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
where
domainExistsInConfig :: (Monad m) => FederationDomainConfig -> m Bool
domainExistsInConfig :: forall (m :: * -> *). Monad m => FederationDomainConfig -> m Bool
domainExistsInConfig FederationDomainConfig
fedDomConf = do
Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ case Domain
-> Map Domain FederationDomainConfig
-> Maybe FederationDomainConfig
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (FederationDomainConfig -> Domain
domain FederationDomainConfig
fedDomConf) Map Domain FederationDomainConfig
cfg of
Maybe FederationDomainConfig
Nothing -> Bool
False
Just FederationDomainConfig
fedDomConf' -> FederationDomainConfig
fedDomConf' FederationDomainConfig -> FederationDomainConfig -> Bool
forall a. Eq a => a -> a -> Bool
/= FederationDomainConfig
fedDomConf
addConfig :: PrepQuery W (Domain, FederatedUserSearchPolicy, Int32) ()
addConfig :: PrepQuery W (Domain, FederatedUserSearchPolicy, Int32) ()
addConfig = PrepQuery W (Domain, FederatedUserSearchPolicy, Int32) ()
"INSERT INTO federation_remotes (domain, search_policy, restriction) VALUES (?, ?, ?)"
addTeams :: PrepQuery W (Domain, TeamId) ()
addTeams :: PrepQuery W (Domain, TeamId) ()
addTeams = PrepQuery W (Domain, TeamId) ()
"INSERT INTO federation_remote_teams (domain, team) VALUES (?, ?)"
updateFederationConfig' :: (MonadClient m) => Map Domain FederationDomainConfig -> FederationDomainConfig -> m UpdateFederationResult
updateFederationConfig' :: forall (m :: * -> *).
MonadClient m =>
Map Domain FederationDomainConfig
-> FederationDomainConfig -> m UpdateFederationResult
updateFederationConfig' Map Domain FederationDomainConfig
cfgs (FederationDomainConfig Domain
rDomain FederatedUserSearchPolicy
searchPolicy FederationRestriction
restriction) = do
if Domain
rDomain Domain -> Map Domain Domain -> Bool
forall a. Eq a => a -> Map Domain a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (FederationDomainConfig -> Domain
domain (FederationDomainConfig -> Domain)
-> Map Domain FederationDomainConfig -> Map Domain Domain
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Domain FederationDomainConfig
cfgs)
then UpdateFederationResult -> m UpdateFederationResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UpdateFederationResult
UpdateFederationRemoteDivergingConfig
else do
let configParams :: QueryParams (FederatedUserSearchPolicy, Int32, Domain)
configParams =
( Consistency
-> (FederatedUserSearchPolicy, Int32, Domain)
-> QueryParams (FederatedUserSearchPolicy, Int32, Domain)
forall a. Consistency -> a -> QueryParams a
params
Consistency
LocalQuorum
(FederatedUserSearchPolicy
searchPolicy, FederationRestriction -> Int32
fromRestriction FederationRestriction
restriction, Domain
rDomain)
)
{ serialConsistency = Just LocalSerialConsistency
}
[Row]
r <- RetrySettings -> m [Row] -> m [Row]
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (PrepQuery W (FederatedUserSearchPolicy, Int32, Domain) Row
-> QueryParams (FederatedUserSearchPolicy, Int32, Domain)
-> m [Row]
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a Row -> QueryParams a -> m [Row]
trans PrepQuery W (FederatedUserSearchPolicy, Int32, Domain) Row
forall x. PrepQuery W (FederatedUserSearchPolicy, Int32, Domain) x
updateConfig QueryParams (FederatedUserSearchPolicy, Int32, Domain)
configParams)
m ()
forall (m :: * -> *). MonadClient m => m ()
updateTeams
case [Row]
r of
[] -> UpdateFederationResult -> m UpdateFederationResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UpdateFederationResult
UpdateFederationRemoteNotFound
[Row
_] -> UpdateFederationResult -> m UpdateFederationResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UpdateFederationResult
UpdateFederationSuccess
[Row]
_ -> ErrorCall -> m UpdateFederationResult
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (ErrorCall -> m UpdateFederationResult)
-> ErrorCall -> m UpdateFederationResult
forall a b. (a -> b) -> a -> b
$ [Char] -> ErrorCall
ErrorCall [Char]
"Primary key violation detected federation_remotes"
where
updateConfig :: PrepQuery W (FederatedUserSearchPolicy, Int32, Domain) x
updateConfig :: forall x. PrepQuery W (FederatedUserSearchPolicy, Int32, Domain) x
updateConfig = PrepQuery W (FederatedUserSearchPolicy, Int32, Domain) x
"UPDATE federation_remotes SET search_policy = ?, restriction = ? WHERE domain = ? IF EXISTS"
updateTeams :: (MonadClient m) => m ()
updateTeams :: forall (m :: * -> *). MonadClient m => m ()
updateTeams = RetrySettings -> m () -> m ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
PrepQuery W (Identity Domain) ()
-> QueryParams (Identity Domain) -> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Identity Domain) ()
dropTeams (Consistency -> Identity Domain -> QueryParams (Identity Domain)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (Domain -> Identity Domain
forall a. a -> Identity a
Identity Domain
rDomain))
case FederationRestriction
restriction of
FederationRestrictionByTeam [TeamId]
tids ->
BatchM () -> m ()
forall (m :: * -> *). MonadClient m => BatchM () -> m ()
batch (BatchM () -> m ())
-> ((TeamId -> BatchM ()) -> BatchM ())
-> (TeamId -> BatchM ())
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TeamId] -> (TeamId -> BatchM ()) -> BatchM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TeamId]
tids ((TeamId -> BatchM ()) -> m ()) -> (TeamId -> BatchM ()) -> m ()
forall a b. (a -> b) -> a -> b
$ PrepQuery W (Domain, TeamId) () -> (Domain, TeamId) -> BatchM ()
forall a b.
(Show a, Tuple a, Tuple b) =>
PrepQuery W a b -> a -> BatchM ()
addPrepQuery PrepQuery W (Domain, TeamId) ()
insertTeam ((Domain, TeamId) -> BatchM ())
-> (TeamId -> (Domain, TeamId)) -> TeamId -> BatchM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Domain
rDomain,)
FederationRestriction
FederationRestrictionAllowAll -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
dropTeams :: PrepQuery W (Identity Domain) ()
dropTeams :: PrepQuery W (Identity Domain) ()
dropTeams = PrepQuery W (Identity Domain) ()
"DELETE FROM federation_remote_teams WHERE domain = ?"
insertTeam :: PrepQuery W (Domain, TeamId) ()
insertTeam :: PrepQuery W (Domain, TeamId) ()
insertTeam = PrepQuery W (Domain, TeamId) ()
"INSERT INTO federation_remote_teams (domain, team) VALUES (?, ?)"
addFederationRemoteTeam' :: (MonadClient m) => Map Domain FederationDomainConfig -> Domain -> TeamId -> m AddFederationRemoteTeamResult
addFederationRemoteTeam' :: forall (m :: * -> *).
MonadClient m =>
Map Domain FederationDomainConfig
-> Domain -> TeamId -> m AddFederationRemoteTeamResult
addFederationRemoteTeam' Map Domain FederationDomainConfig
cfgs Domain
rDomain TeamId
tid = do
Maybe FederationDomainConfig
mDom <- Map Domain FederationDomainConfig
-> Domain -> m (Maybe FederationDomainConfig)
forall (m :: * -> *).
MonadClient m =>
Map Domain FederationDomainConfig
-> Domain -> m (Maybe FederationDomainConfig)
getFederationConfig' Map Domain FederationDomainConfig
cfgs Domain
rDomain
case Maybe FederationDomainConfig
mDom of
Maybe FederationDomainConfig
Nothing ->
AddFederationRemoteTeamResult -> m AddFederationRemoteTeamResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AddFederationRemoteTeamResult
AddFederationRemoteTeamDomainNotFound
Just (FederationDomainConfig Domain
_ FederatedUserSearchPolicy
_ FederationRestriction
FederationRestrictionAllowAll) ->
AddFederationRemoteTeamResult -> m AddFederationRemoteTeamResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AddFederationRemoteTeamResult
AddFederationRemoteTeamRestrictionAllowAll
Just FederationDomainConfig
_ -> do
RetrySettings -> m () -> m ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ PrepQuery W (Domain, TeamId) ()
-> QueryParams (Domain, TeamId) -> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Domain, TeamId) ()
add (Consistency -> (Domain, TeamId) -> QueryParams (Domain, TeamId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (Domain
rDomain, TeamId
tid))
AddFederationRemoteTeamResult -> m AddFederationRemoteTeamResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AddFederationRemoteTeamResult
AddFederationRemoteTeamSuccess
where
add :: PrepQuery W (Domain, TeamId) ()
add :: PrepQuery W (Domain, TeamId) ()
add = PrepQuery W (Domain, TeamId) ()
"INSERT INTO federation_remote_teams (domain, team) VALUES (?, ?)"
getFederationRemoteTeams' :: (MonadClient m) => Domain -> m [FederationRemoteTeam]
getFederationRemoteTeams' :: forall (m :: * -> *).
MonadClient m =>
Domain -> m [FederationRemoteTeam]
getFederationRemoteTeams' Domain
rDomain = do
(Identity TeamId -> FederationRemoteTeam)
-> [Identity TeamId] -> [FederationRemoteTeam]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TeamId -> FederationRemoteTeam
FederationRemoteTeam (TeamId -> FederationRemoteTeam)
-> (Identity TeamId -> TeamId)
-> Identity TeamId
-> FederationRemoteTeam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity TeamId -> TeamId
forall a. Identity a -> a
runIdentity) ([Identity TeamId] -> [FederationRemoteTeam])
-> m [Identity TeamId] -> m [FederationRemoteTeam]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RetrySettings -> m [Identity TeamId] -> m [Identity TeamId]
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (PrepQuery R (Identity Domain) (Identity TeamId)
-> QueryParams (Identity Domain) -> m [Identity TeamId]
forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m [b]
query PrepQuery R (Identity Domain) (Identity TeamId)
get (Consistency -> Identity Domain -> QueryParams (Identity Domain)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (Domain -> Identity Domain
forall a. a -> Identity a
Identity Domain
rDomain)))
where
get :: PrepQuery R (Identity Domain) (Identity TeamId)
get :: PrepQuery R (Identity Domain) (Identity TeamId)
get = PrepQuery R (Identity Domain) (Identity TeamId)
"SELECT team FROM federation_remote_teams WHERE domain = ?"
removeFederationRemoteTeam' :: (MonadClient m) => Domain -> TeamId -> m ()
removeFederationRemoteTeam' :: forall (m :: * -> *). MonadClient m => Domain -> TeamId -> m ()
removeFederationRemoteTeam' Domain
rDomain TeamId
rteam =
RetrySettings -> m () -> m ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ PrepQuery W (Domain, TeamId) ()
-> QueryParams (Domain, TeamId) -> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Domain, TeamId) ()
delete (Consistency -> (Domain, TeamId) -> QueryParams (Domain, TeamId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (Domain
rDomain, TeamId
rteam))
where
delete :: PrepQuery W (Domain, TeamId) ()
delete :: PrepQuery W (Domain, TeamId) ()
delete = PrepQuery W (Domain, TeamId) ()
"DELETE FROM federation_remote_teams WHERE domain = ? AND team = ?"
backendFederatesWithImpl ::
(MonadClient m) =>
Remote (Maybe TeamId) ->
Map Domain FederationDomainConfig ->
Maybe FederationStrategy ->
m Bool
backendFederatesWithImpl :: forall (m :: * -> *).
MonadClient m =>
Remote (Maybe TeamId)
-> Map Domain FederationDomainConfig
-> Maybe FederationStrategy
-> m Bool
backendFederatesWithImpl (Remote (Maybe TeamId) -> Qualified (Maybe TeamId)
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged -> Qualified Maybe TeamId
Nothing Domain
rDomain) Map Domain FederationDomainConfig
staticCfgs = \case
Maybe FederationStrategy
Nothing -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Just FederationStrategy
AllowNone -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Just FederationStrategy
AllowAll -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
Just FederationStrategy
AllowDynamic -> do
Map Domain FederationDomainConfig
-> Domain -> m (Maybe FederationDomainConfig)
forall (m :: * -> *).
MonadClient m =>
Map Domain FederationDomainConfig
-> Domain -> m (Maybe FederationDomainConfig)
getFederationConfig' Map Domain FederationDomainConfig
staticCfgs Domain
rDomain m (Maybe FederationDomainConfig)
-> (Maybe FederationDomainConfig -> m Bool) -> m Bool
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe FederationDomainConfig
Nothing -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Just FederationDomainConfig
c -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FederationDomainConfig -> FederationRestriction
restriction FederationDomainConfig
c FederationRestriction -> FederationRestriction -> Bool
forall a. Eq a => a -> a -> Bool
== FederationRestriction
FederationRestrictionAllowAll
backendFederatesWithImpl (Remote (Maybe TeamId) -> Qualified (Maybe TeamId)
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged -> Qualified (Just TeamId
rTeam) Domain
rDomain) Map Domain FederationDomainConfig
staticCfgs = \case
Maybe FederationStrategy
Nothing -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Just FederationStrategy
AllowNone -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Just FederationStrategy
AllowAll -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
Just FederationStrategy
AllowDynamic ->
Map Domain FederationDomainConfig
-> Domain -> m (Maybe FederationDomainConfig)
forall (m :: * -> *).
MonadClient m =>
Map Domain FederationDomainConfig
-> Domain -> m (Maybe FederationDomainConfig)
getFederationConfig' Map Domain FederationDomainConfig
staticCfgs Domain
rDomain m (Maybe FederationDomainConfig)
-> (Maybe FederationDomainConfig -> m Bool) -> m Bool
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe FederationDomainConfig
Nothing -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Just (FederationDomainConfig Domain
_ FederatedUserSearchPolicy
_ FederationRestriction
FederationRestrictionAllowAll) ->
Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
Just (FederationDomainConfig Domain
_ FederatedUserSearchPolicy
_ (FederationRestrictionByTeam [TeamId]
ts)) -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ TeamId
rTeam TeamId -> [TeamId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TeamId]
ts
data RestrictionException = RestrictionException Int32
instance Show RestrictionException where
show :: RestrictionException -> [Char]
show (RestrictionException Int32
v) =
[Char]
"Expected a RestrictionPolicy encoding, but found a value " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int32 -> [Char]
forall a. Show a => a -> [Char]
show Int32
v
instance Exception RestrictionException
toRestriction :: (MonadClient m) => Domain -> Int32 -> m FederationRestriction
toRestriction :: forall (m :: * -> *).
MonadClient m =>
Domain -> Int32 -> m FederationRestriction
toRestriction Domain
_ Int32
0 = FederationRestriction -> m FederationRestriction
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FederationRestriction
FederationRestrictionAllowAll
toRestriction Domain
dom Int32
1 =
([TeamId] -> FederationRestriction)
-> m [TeamId] -> m FederationRestriction
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [TeamId] -> FederationRestriction
FederationRestrictionByTeam (m [TeamId] -> m FederationRestriction)
-> m [TeamId] -> m FederationRestriction
forall a b. (a -> b) -> a -> b
$
Identity TeamId -> TeamId
forall a. Identity a -> a
runIdentity (Identity TeamId -> TeamId) -> m [Identity TeamId] -> m [TeamId]
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> RetrySettings -> m [Identity TeamId] -> m [Identity TeamId]
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (PrepQuery R (Identity Domain) (Identity TeamId)
-> QueryParams (Identity Domain) -> m [Identity TeamId]
forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m [b]
query PrepQuery R (Identity Domain) (Identity TeamId)
getTeams (Consistency -> Identity Domain -> QueryParams (Identity Domain)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (Domain -> Identity Domain
forall a. a -> Identity a
Identity Domain
dom)))
where
getTeams :: PrepQuery R (Identity Domain) (Identity TeamId)
getTeams :: PrepQuery R (Identity Domain) (Identity TeamId)
getTeams = [Char] -> PrepQuery R (Identity Domain) (Identity TeamId)
forall a. IsString a => [Char] -> a
fromString ([Char] -> PrepQuery R (Identity Domain) (Identity TeamId))
-> [Char] -> PrepQuery R (Identity Domain) (Identity TeamId)
forall a b. (a -> b) -> a -> b
$ [Char]
"SELECT team FROM federation_remote_teams WHERE domain = ?"
toRestriction Domain
_ Int32
v = RestrictionException -> m FederationRestriction
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (RestrictionException -> m FederationRestriction)
-> (Int32 -> RestrictionException)
-> Int32
-> m FederationRestriction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> RestrictionException
RestrictionException (Int32 -> m FederationRestriction)
-> Int32 -> m FederationRestriction
forall a b. (a -> b) -> a -> b
$ Int32
v
fromRestriction :: FederationRestriction -> Int32
fromRestriction :: FederationRestriction -> Int32
fromRestriction FederationRestriction
FederationRestrictionAllowAll = Int32
0
fromRestriction (FederationRestrictionByTeam [TeamId]
_) = Int32
1