Use warn level when logging federation denied errors

Author: pcapriotti

services/brig/brig.integration.yaml

@@ -209,7 +209,7 @@ optSettings:
       defaultForNull:
         status: disabled
   setFederationDomainConfigsUpdateFreq: 1
-  setFederationStrategy: allowAll
+  setFederationStrategy: allowNone
   setFederationDomainConfigs:
     - domain: example.com
       search_policy: full_search

services/federator/src/Federator/Discovery.hs

@@ -36,6 +36,7 @@ import System.Logger.Class qualified as Log
 import Wire.Network.DNS.Effect (DNSLookup)
 import Wire.Network.DNS.Effect qualified as Lookup
 import Wire.Network.DNS.SRV (SrvEntry (srvTarget), SrvResponse (..), SrvTarget)
+import Wire.Sem.Logger.Level qualified as SemLog
 
 data DiscoveryFailure
   = DiscoveryFailureSrvNotAvailable ByteString
@@ -45,6 +46,7 @@ data DiscoveryFailure
 instance Exception DiscoveryFailure
 
 instance AsWai DiscoveryFailure where
+  errorLogLevel _ = SemLog.Error
   toWai e = Wai.mkError status label (LText.fromStrict (discoveryErrorDescription e))
     where
       (status, label) = case e of

services/federator/src/Federator/Error.hs

@@ -21,6 +21,8 @@ module Federator.Error
 where
 
 import Network.Wai.Utilities.Error qualified as Wai
+import Wire.Sem.Logger.Level as Log
 
 class AsWai e where
+  errorLogLevel :: e -> Log.Level
   toWai :: e -> Wai.Error

services/federator/src/Federator/Error/ServerError.hs

@@ -23,6 +23,7 @@ import Imports
 import Network.HTTP.Types qualified as HTTP
 import Network.Wai.Utilities.Error qualified as Wai
 import Wire.API.Federation.Domain
+import Wire.Sem.Logger.Level qualified as Log
 
 data ServerError
   = InvalidRoute
@@ -33,6 +34,7 @@ data ServerError
 instance Exception ServerError
 
 instance AsWai ServerError where
+  errorLogLevel _ = Log.Error
   toWai e@InvalidRoute =
     Wai.mkError HTTP.status403 "invalid-endpoint" (LText.fromStrict (serverErrorDescription e))
   toWai e@(UnknownComponent _) =

services/federator/src/Federator/Interpreter.hs

@@ -23,7 +23,7 @@ import Federator.Remote
 import Federator.Service
 import Federator.Validation
 import HTTP2.Client.Manager (Http2Manager)
-import Imports
+import Imports hiding (log)
 import Network.HTTP.Types qualified as HTTP
 import Network.Wai qualified as Wai
 import Network.Wai.Handler.Warp qualified as Warp
@@ -46,6 +46,7 @@ import Wire.API.Component (Component (Brig))
 import Wire.API.FederationUpdate qualified as FedUp (getFederationDomainConfigs)
 import Wire.API.Routes.FederationDomainConfig qualified as FedUp (FederationDomainConfigs)
 import Wire.Network.DNS.Effect
+import Wire.Sem.Logger
 import Wire.Sem.Logger.TinyLog
 
 class ErrorEffects (ee :: [Type]) r where
@@ -84,22 +85,19 @@ runWaiErrorEither ::
   (AsWai e, Member TinyLog r) =>
   Sem (Error e ': r) (Either Wai.Error a) ->
   Sem r (Either Wai.Error a)
-runWaiErrorEither =
-  fmap join
-    . runError
-    . flip catch logError
-    . mapError toWai
-    . raiseUnder
+runWaiErrorEither = fmap join . logError
   where
     logError ::
-      ( Member (Error Wai.Error) r,
-        Member TinyLog r
-      ) =>
-      Wai.Error ->
-      Sem r a
-    logError e = do
-      err $ Wai.logErrorMsg e
-      throw e
+      (Member TinyLog r, AsWai e) =>
+      Sem (Error e ': r) a ->
+      Sem r (Either Wai.Error a)
+    logError m =
+      runError m >>= \case
+        Left e -> do
+          let we = toWai e
+          log (errorLogLevel e) $ Wai.logErrorMsg we
+          pure (Left we)
+        Right x -> pure (Right x)
 
 serveServant ::
   forall (api :: Type).

services/federator/src/Federator/MockServer.hs

@@ -74,6 +74,7 @@ import Wire.API.Federation.API (Component)
 import Wire.API.Federation.API.Common
 import Wire.API.Federation.Domain
 import Wire.API.Federation.Version
+import Wire.Sem.Logger.Level qualified as Log
 import Wire.Sem.Logger.TinyLog
 
 -- | This can be thrown by actions passed to mock federator to simulate
@@ -84,6 +85,7 @@ data MockException
   deriving (Eq, Show, Typeable)
 
 instance AsWai MockException where
+  errorLogLevel _ = Log.Error
   toWai (MockErrorResponse status message) = Wai.mkError status "mock-error" message
   toWai (MockUnreachableBackendErrorResponse d) =
     Wai.mkError HTTP.status503 "mock-error" (unreachableMsg d)

services/federator/src/Federator/Remote.hs

@@ -49,6 +49,7 @@ import Wire.API.Federation.Client
 import Wire.API.Federation.Component
 import Wire.API.Federation.Error
 import Wire.Network.DNS.SRV
+import Wire.Sem.Logger.Level qualified as Log
 
 -- | An error that can occur as a result of making a request to a remote
 -- federator.
@@ -63,6 +64,7 @@ data RemoteError
   deriving (Show)
 
 instance AsWai RemoteError where
+  errorLogLevel _ = Log.Error
   toWai (RemoteError target msg err) =
     federationRemoteHTTP2Error target msg err
   toWai (RemoteErrorResponse target msg status body) =

services/federator/src/Federator/Validation.hs

@@ -46,6 +46,7 @@ import Polysemy.Error
 import Polysemy.Input
 import Wire.API.Routes.FederationDomainConfig
 import Wire.Network.DNS.SRV (SrvTarget (..))
+import Wire.Sem.Logger.Level qualified as Log
 
 data ValidationError
   = NoClientCertificate
@@ -58,6 +59,8 @@ data ValidationError
 instance Exception ValidationError
 
 instance AsWai ValidationError where
+  errorLogLevel (FederationDenied _) = Log.Warn
+  errorLogLevel _ = Log.Error
   toWai err =
     Wai.mkError (validationErrorStatus err) (validationErrorLabel err)
       . LText.fromStrict