[feat] nixpkgs update (semantically relevant part)

- fix hscim
- fix http2-manager
- fix the docs
- fix integration test suite compiliation errors
- fix wire-api, wire-api-federation
- fix spar, stern, cargohold
- fix gundeck, brig and galley
- regenerate local packages
- remove "obsolete" version field from docker compose files
- fix federator
- nix cleanup
- bump http2 to beyond the necessary bug fix in 5.2.2
- patch http2 to not spam ConnectionIsClosed

.ormolu

@@ -1,4 +1,4 @@
-infixr 10 .=
+infixr 8 .=
 infix 4 ===
 infix 4 =/=
 infixr 3 !!!

changelog.d/5-internal/WPB-8943

@@ -0,0 +1 @@
+update nixpkgs and hence GHC version as well as some other tooling.

deploy/dockerephemeral/docker-compose.yaml

@@ -1,4 +1,3 @@
-version: '2'
 networks:
   redis:
     driver: bridge

deploy/dockerephemeral/federation-v0.yaml

@@ -1,5 +1,3 @@
-version: '2.3'
-
 networks:
   demo_wire:
     external: false

integration/test/Test/Demo.hs

@@ -7,21 +7,20 @@ import qualified API.Brig as BrigP
 import qualified API.BrigInternal as BrigI
 import qualified API.GalleyInternal as GalleyI
 import qualified API.Nginz as Nginz
-import Control.Monad.Cont
 import GHC.Stack
 import SetupHelpers
 import Testlib.Prelude
 
 -- | Deleting unknown clients should fail with 404.
-testDeleteUnknownClient :: HasCallStack => App ()
+testDeleteUnknownClient :: (HasCallStack) => App ()
 testDeleteUnknownClient = do
   user <- randomUser OwnDomain def
   let fakeClientId = "deadbeefdeadbeef"
   bindResponse (BrigP.deleteClient user fakeClientId) $ \resp -> do
     resp.status `shouldMatchInt` 404
     resp.json %. "label" `shouldMatch` "client-not-found"
 
-testModifiedBrig :: HasCallStack => App ()
+testModifiedBrig :: (HasCallStack) => App ()
 testModifiedBrig = do
   withModifiedBackend
     (def {brigCfg = setField "optSettings.setFederationDomain" "overridden.example.com"})
@@ -31,7 +30,7 @@ testModifiedBrig = do
         resp.status `shouldMatchInt` 200
         (resp.json %. "domain") `shouldMatch` "overridden.example.com"
 
-testModifiedGalley :: HasCallStack => App ()
+testModifiedGalley :: (HasCallStack) => App ()
 testModifiedGalley = do
   (_user, tid, _) <- createTeam OwnDomain 1
 
@@ -49,23 +48,23 @@ testModifiedGalley = do
       (_user, tid', _) <- createTeam domain 1
       getFeatureStatus domain tid' `shouldMatch` "enabled"
 
-testModifiedCannon :: HasCallStack => App ()
+testModifiedCannon :: (HasCallStack) => App ()
 testModifiedCannon = do
   withModifiedBackend def $ \_ -> pure ()
 
-testModifiedGundeck :: HasCallStack => App ()
+testModifiedGundeck :: (HasCallStack) => App ()
 testModifiedGundeck = do
   withModifiedBackend def $ \_ -> pure ()
 
-testModifiedCargohold :: HasCallStack => App ()
+testModifiedCargohold :: (HasCallStack) => App ()
 testModifiedCargohold = do
   withModifiedBackend def $ \_ -> pure ()
 
-testModifiedSpar :: HasCallStack => App ()
+testModifiedSpar :: (HasCallStack) => App ()
 testModifiedSpar = do
   withModifiedBackend def $ \_ -> pure ()
 
-testModifiedServices :: HasCallStack => App ()
+testModifiedServices :: (HasCallStack) => App ()
 testModifiedServices = do
   let serviceMap =
         def
@@ -79,17 +78,17 @@ testModifiedServices = do
       res.status `shouldMatchInt` 200
       res.json %. "status" `shouldMatch` "enabled"
 
-    bindResponse (BrigP.getAPIVersion domain) $
-      \resp -> do
+    bindResponse (BrigP.getAPIVersion domain)
+      $ \resp -> do
         resp.status `shouldMatchInt` 200
         (resp.json %. "domain") `shouldMatch` "overridden.example.com"
 
-    bindResponse (Nginz.getSystemSettingsUnAuthorized domain) $
-      \resp -> do
+    bindResponse (Nginz.getSystemSettingsUnAuthorized domain)
+      $ \resp -> do
         resp.status `shouldMatchInt` 200
         resp.json %. "setRestrictUserCreation" `shouldMatch` False
 
-testDynamicBackend :: HasCallStack => App ()
+testDynamicBackend :: (HasCallStack) => App ()
 testDynamicBackend = do
   ownDomain <- objDomain OwnDomain
   user <- randomUser OwnDomain def
@@ -100,8 +99,8 @@ testDynamicBackend = do
 
   startDynamicBackends [def] $ \dynDomains -> do
     [dynDomain] <- pure dynDomains
-    bindResponse (Nginz.getSystemSettingsUnAuthorized dynDomain) $
-      \resp -> do
+    bindResponse (Nginz.getSystemSettingsUnAuthorized dynDomain)
+      $ \resp -> do
         resp.status `shouldMatchInt` 200
         resp.json %. "setRestrictUserCreation" `shouldMatch` False
 
@@ -120,16 +119,16 @@ testDynamicBackend = do
     bindResponse (BrigP.getSelf' ownDomain uidD1) $ \resp -> do
       resp.status `shouldMatchInt` 404
 
-testStartMultipleDynamicBackends :: HasCallStack => App ()
+testStartMultipleDynamicBackends :: (HasCallStack) => App ()
 testStartMultipleDynamicBackends = do
   let assertCorrectDomain domain =
-        bindResponse (BrigP.getAPIVersion domain) $
-          \resp -> do
+        bindResponse (BrigP.getAPIVersion domain)
+          $ \resp -> do
             resp.status `shouldMatchInt` 200
             (resp.json %. "domain") `shouldMatch` domain
   startDynamicBackends [def, def, def] $ mapM_ assertCorrectDomain
 
-testIndependentESIndices :: HasCallStack => App ()
+testIndependentESIndices :: (HasCallStack) => App ()
 testIndependentESIndices = do
   u1 <- randomUser OwnDomain def
   u2 <- randomUser OwnDomain def
@@ -162,14 +161,14 @@ testIndependentESIndices = do
         [] -> assertFailure "Expected a non empty result, but got an empty one"
         doc : _ -> doc %. "id" `shouldMatch` uidD2
 
-testDynamicBackendsFederation :: HasCallStack => App ()
+testDynamicBackendsFederation :: (HasCallStack) => App ()
 testDynamicBackendsFederation = do
   startDynamicBackends [def, def] $ \[aDynDomain, anotherDynDomain] -> do
     [u1, u2] <- createAndConnectUsers [aDynDomain, anotherDynDomain]
     bindResponse (BrigP.getConnection u1 u2) assertSuccess
     bindResponse (BrigP.getConnection u2 u1) assertSuccess
 
-testWebSockets :: HasCallStack => App ()
+testWebSockets :: (HasCallStack) => App ()
 testWebSockets = do
   user <- randomUser OwnDomain def
   withWebSocket user $ \ws -> do
@@ -195,12 +194,12 @@ testUnrace = do
   -}
   retryT $ True `shouldMatch` True
 
-testFedV0Instance :: HasCallStack => App ()
+testFedV0Instance :: (HasCallStack) => App ()
 testFedV0Instance = do
   res <- BrigP.getAPIVersion FedV0Domain >>= getJSON 200
   res %. "domain" `shouldMatch` FedV0Domain
 
-testFedV0Federation :: HasCallStack => App ()
+testFedV0Federation :: (HasCallStack) => App ()
 testFedV0Federation = do
   alice <- randomUser OwnDomain def
   bob <- randomUser FedV0Domain def

integration/test/Test/Roles.hs

@@ -18,13 +18,12 @@
 module Test.Roles where
 
 import API.Galley
-import Control.Monad.Reader
 import GHC.Stack
 import Notifications
 import SetupHelpers
 import Testlib.Prelude
 
-testRoleUpdateWithRemotesOk :: HasCallStack => App ()
+testRoleUpdateWithRemotesOk :: (HasCallStack) => App ()
 testRoleUpdateWithRemotesOk = do
   [bob, charlie, alice] <- createUsers [OwnDomain, OwnDomain, OtherDomain]
   connectTwoUsers bob charlie
@@ -45,7 +44,7 @@ testRoleUpdateWithRemotesOk = do
       notif %. "payload.0.qualified_conversation" `shouldMatch` objQidObject conv
       notif %. "payload.0.qualified_from" `shouldMatch` objQidObject bob
 
-testRoleUpdateWithRemotesUnreachable :: HasCallStack => App ()
+testRoleUpdateWithRemotesUnreachable :: (HasCallStack) => App ()
 testRoleUpdateWithRemotesUnreachable = do
   [bob, charlie] <- createUsers [OwnDomain, OwnDomain]
   startDynamicBackends [mempty] $ \[dynBackend] -> do

integration/test/Testlib/Assertions.hs

@@ -6,6 +6,7 @@ import Control.Applicative ((<|>))
 import Control.Exception as E
 import Control.Lens ((^?))
 import qualified Control.Lens.Plated as LP
+import Control.Monad
 import Control.Monad.Reader
 import Data.Aeson (Value)
 import qualified Data.Aeson as Aeson
@@ -33,7 +34,7 @@ import Testlib.Printing
 import Testlib.Types
 import Prelude
 
-assertBool :: HasCallStack => String -> Bool -> App ()
+assertBool :: (HasCallStack) => String -> Bool -> App ()
 assertBool _ True = pure ()
 assertBool msg False = assertFailure msg
 
@@ -42,7 +43,7 @@ assertOne xs = case toList xs of
   [x] -> pure x
   other -> assertFailure ("Expected one, but got " <> show (length other))
 
-expectFailure :: HasCallStack => (AssertionFailure -> App ()) -> App a -> App ()
+expectFailure :: (HasCallStack) => (AssertionFailure -> App ()) -> App a -> App ()
 expectFailure checkFailure action = do
   env <- ask
   res :: Either AssertionFailure x <-
@@ -234,7 +235,7 @@ shouldMatchOneOf a b = do
     assertFailure $ "Expected:\n" <> pa <> "\n to match at least one of:\n" <> pb
 
 shouldContainString ::
-  HasCallStack =>
+  (HasCallStack) =>
   -- | The actual value
   String ->
   -- | The expected value

integration/test/Testlib/Types.hs

@@ -6,6 +6,7 @@ module Testlib.Types where
 
 import Control.Concurrent (QSemN)
 import Control.Exception as E
+import Control.Monad
 import Control.Monad.Base
 import Control.Monad.Catch
 import Control.Monad.Reader
@@ -67,7 +68,7 @@ data BackendResource = BackendResource
     berVHost :: String,
     berNginzSslPort :: Word16,
     berNginzHttp2Port :: Word16,
-    berInternalServicePorts :: forall a. Num a => Service -> a
+    berInternalServicePorts :: forall a. (Num a) => Service -> a
   }
 
 instance Eq BackendResource where
@@ -341,7 +342,7 @@ appToIOKleisli k = do
   env <- ask
   pure $ \a -> runAppWithEnv env (k a)
 
-getServiceMap :: HasCallStack => String -> App ServiceMap
+getServiceMap :: (HasCallStack) => String -> App ServiceMap
 getServiceMap fedDomain = do
   env <- ask
   assertJust ("Could not find service map for federation domain: " <> fedDomain) (Map.lookup fedDomain env.serviceMap)
@@ -375,7 +376,7 @@ instance Exception AppFailure where
 instance MonadFail App where
   fail msg = assertFailure ("Pattern matching failure: " <> msg)
 
-assertFailure :: HasCallStack => String -> App a
+assertFailure :: (HasCallStack) => String -> App a
 assertFailure msg =
   forceList msg $
     liftIO $
@@ -384,7 +385,7 @@ assertFailure msg =
     forceList [] y = y
     forceList (x : xs) y = seq x (forceList xs y)
 
-assertJust :: HasCallStack => String -> Maybe a -> App a
+assertJust :: (HasCallStack) => String -> Maybe a -> App a
 assertJust _ (Just x) = pure x
 assertJust msg Nothing = assertFailure msg
 

libs/hscim/hscim.cabal

@@ -86,12 +86,12 @@ library
       aeson                >=2.1.2   && <2.2
     , aeson-qq             >=0.8.4   && <0.9
     , attoparsec           >=0.14.4  && <0.15
-    , base                 >=4.17.2  && <4.18
+    , base                 >=4.17.2  && <4.19
     , bytestring           >=0.10.4  && <0.12
     , case-insensitive     >=1.2.1   && <1.3
     , email-validate       >=2.3.2   && <2.4
     , hashable             >=1.4.3   && <1.5
-    , hspec                >=2.10.10 && <2.11
+    , hspec                >=2.10.10 && <2.12
     , hspec-expectations   >=0.8.2   && <0.9
     , hspec-wai            >=0.11.1  && <0.12
     , http-api-data        >=0.5     && <0.6
@@ -100,18 +100,18 @@ library
     , list-t               >=1.0.5   && <1.1
     , microlens            >=0.4.13  && <0.5
     , mmorph               >=1.2.0   && <1.3
-    , mtl                  >=2.2.2   && <2.3
+    , mtl                  >=2.2.2   && <2.4
     , network-uri          >=2.6.4   && <2.7
     , retry                >=0.9.3   && <0.10
     , scientific           >=0.3.7   && <0.4
-    , servant              >=0.19.1  && <0.20
-    , servant-client       >=0.19    && <0.20
-    , servant-client-core  >=0.19    && <0.20
-    , servant-server       >=0.19.2  && <0.20
+    , servant              >=0.19.1  && <0.21
+    , servant-client       >=0.19    && <0.21
+    , servant-client-core  >=0.19    && <0.21
+    , servant-server       >=0.19.2  && <0.21
     , stm                  >=2.5.1   && <2.6
     , stm-containers       >=1.2.0   && <1.3
     , string-conversions   >=0.4.0   && <0.5
-    , template-haskell     >=2.19.0  && <2.20
+    , template-haskell     >=2.19.0  && <2.21
     , text                 >=2.0.2   && <2.1
     , time                 >=1.12.2  && <1.13
     , uuid                 >=1.3.15  && <1.4

libs/hscim/server/Main.hs

@@ -72,8 +72,9 @@ mkUserDB = do
                 (emailAddress "elton@wire.com"),
             E.primary = Nothing
           }
+
   let user =
-        (User.empty [User20] "elton" NoUserExtra)
+        (User.empty [User20] "elton" NoUserExtra :: User Mock)
           { name =
               Just
                 Name

libs/hscim/src/Web/Scim/Handler.hs

@@ -22,14 +22,15 @@ module Web.Scim.Handler
   )
 where
 
+import Control.Monad ((<=<))
 import Control.Monad.Except
 import Web.Scim.Schema.Error
 
 -- | Handler type for SCIM. All errors will be thrown via 'ExceptT'.
 type ScimHandler m = ExceptT ScimError m
 
 -- | Throw a 'ScimError'.
-throwScim :: Monad m => ScimError -> ScimHandler m a
+throwScim :: (Monad m) => ScimError -> ScimHandler m a
 throwScim = throwError
 
 -- | A natural transformation for Servant handlers. To use it, you need to
@@ -42,7 +43,7 @@ throwScim = throwError
 -- You can either do something custom for 'ScimError', or use
 -- 'scimToServantErr'.
 fromScimHandler ::
-  Monad m =>
+  (Monad m) =>
   (forall a. ScimError -> m a) ->
   (forall a. ScimHandler m a -> m a)
 fromScimHandler fromError = either fromError pure <=< runExceptT

libs/hscim/src/Web/Scim/Schema/PatchOp.hs

@@ -18,6 +18,7 @@
 module Web.Scim.Schema.PatchOp where
 
 import Control.Applicative
+import Control.Monad (guard)
 import Control.Monad.Except
 import qualified Data.Aeson.Key as Key
 import qualified Data.Aeson.KeyMap as KeyMap
@@ -85,7 +86,7 @@ rPath (IntoValuePath valuePath subAttr) = rValuePath valuePath <> maybe "" rSubA
 -- TODO(arianvp): According to the SCIM spec we should throw an InvalidPath
 -- error when the path is invalid syntax. this is a bit hard to do though as we
 -- can't control what errors FromJSON throws :/
-instance UserTypes tag => FromJSON (PatchOp tag) where
+instance (UserTypes tag) => FromJSON (PatchOp tag) where
   parseJSON = withObject "PatchOp" $ \v -> do
     let o = KeyMap.fromList . map (first lowerKey) . KeyMap.toList $ v
     schemas' :: [Schema] <- o .: "schemas"