[WPB-5175] upgrade to ghc 9.4

cabal.project

@@ -166,3 +166,7 @@ package zauth
     ghc-options: -Werror
 package fedcalls
     ghc-options: -Werror
+
+allow-newer: 
+  , proto-lens-protoc:base
+  , proto-lens-protoc:ghc

changelog.d/5-internal/WPB-5175

@@ -0,0 +1 @@
+upgrade the GHC version to GHC 9.4

hack/bin/generate-local-nix-packages.sh

@@ -4,7 +4,7 @@ set -euo pipefail
 
 SCRIPT_DIR=$(cd -- "$(dirname -- "${BASH_SOURCE[0]}" )" &> /dev/null && pwd )
 ROOT_DIR=$(cd -- "$SCRIPT_DIR/../../" &> /dev/null && pwd)
-cabalFiles=$(find  -L "$ROOT_DIR" -name '*.cabal' \
+cabalFiles=$(find  "$ROOT_DIR" -name '*.cabal' \
                  | grep -v dist-newstyle | sort)
 
 warningFile=$(mktemp)

integration/test/Testlib/App.hs

@@ -3,7 +3,6 @@ module Testlib.App where
 import Control.Monad.Reader
 import Control.Retry qualified as Retry
 import Data.Aeson hiding ((.=))
-import Data.Functor ((<&>))
 import Data.IORef
 import Data.Text qualified as T
 import Data.Yaml qualified as Yaml
@@ -44,9 +43,13 @@ readServiceConfig = readServiceConfig' . configName
 readServiceConfig' :: String -> App Value
 readServiceConfig' srvName = do
   cfgFile <-
-    asks (.servicesCwdBase) <&> \case
-      Nothing -> "/etc/wire" </> srvName </> "conf" </> (srvName <> ".yaml")
-      Just p -> p </> srvName </> (srvName <> ".integration.yaml")
+    asks
+      ( ( \case
+            Nothing -> "/etc/wire" </> srvName </> "conf" </> (srvName <> ".yaml")
+            Just p -> p </> srvName </> (srvName <> ".integration.yaml")
+        )
+          . (.servicesCwdBase)
+      )
 
   eith <- liftIO (Yaml.decodeFileEither cfgFile)
   case eith of

integration/test/Testlib/HTTP.hs

@@ -9,7 +9,6 @@ import Data.ByteString.Char8 qualified as C8
 import Data.ByteString.Lazy qualified as L
 import Data.CaseInsensitive qualified as CI
 import Data.Function
-import Data.Functor ((<&>))
 import Data.List
 import Data.List.Split (splitOn)
 import Data.Maybe
@@ -173,7 +172,7 @@ locationHeaderHost :: Response -> String
 locationHeaderHost resp =
   let location = C8.unpack . snd . fromJust $ locationHeader resp
       locationURI = fromJust $ parseURI location
-      locationHost = fromJust $ locationURI & uriAuthority <&> uriRegName
+      locationHost = uriRegName (fromJust (locationURI & uriAuthority))
    in locationHost
 
 locationHeader :: Response -> Maybe (HTTP.HeaderName, ByteString)

integration/test/Testlib/JSON.hs

@@ -18,7 +18,7 @@ import Data.Foldable
 import Data.Function
 import Data.Functor
 import Data.List.Split (splitOn)
-import Data.Maybe
+import Data.Maybe (fromMaybe)
 import Data.Scientific qualified as Sci
 import Data.String
 import Data.Text qualified as T
@@ -287,7 +287,7 @@ printJSON = prettyJSON >=> liftIO . putStrLn
 
 prettyJSON :: MakesValue a => a -> App String
 prettyJSON x =
-  make x <&> Aeson.encodePretty <&> LC8.unpack
+  make x <&> LC8.unpack . Aeson.encodePretty
 
 jsonType :: Value -> String
 jsonType (Object _) = "Object"

integration/test/Testlib/ModService.hs

@@ -397,10 +397,14 @@ startProcess' domain execName config = do
   tempFile <- liftIO $ writeTempFile "/tmp" (execName <> "-" <> domain <> "-" <> ".yaml") (cs $ Yaml.encode config)
 
   (cwd, exe) <-
-    asks (.servicesCwdBase) <&> \case
-      Nothing -> (Nothing, execName)
-      Just dir ->
-        (Just (dir </> execName), "../../dist" </> execName)
+    asks
+      ( ( \case
+            Nothing -> (Nothing, execName)
+            Just dir ->
+              (Just (dir </> execName), "../../dist" </> execName)
+        )
+          . (.servicesCwdBase)
+      )
 
   (_, Just stdoutHdl, Just stderrHdl, ph) <- liftIO $ createProcess (proc exe ["-c", tempFile]) {cwd = cwd, std_out = CreatePipe, std_err = CreatePipe}
   let prefix = "[" <> execName <> "@" <> domain <> "] "

integration/test/Testlib/Run.hs

@@ -113,9 +113,13 @@ createGlobalEnv cfg = do
       config <- readServiceConfig Galley
       relPath <- config %. "settings.mlsPrivateKeyPaths.removal.ed25519" & asString
       path <-
-        asks (.servicesCwdBase) <&> \case
-          Nothing -> relPath
-          Just dir -> dir </> "galley" </> relPath
+        asks
+          ( ( \case
+                Nothing -> relPath
+                Just dir -> dir </> "galley" </> relPath
+            )
+              . ((.servicesCwdBase))
+          )
       bs <- liftIO $ B.readFile path
       pems <- case pemParseBS bs of
         Left err -> assertFailure $ "Could not parse removal key PEM: " <> err

libs/http2-manager/http2-manager.cabal

@@ -49,7 +49,7 @@ library
   default-language: Haskell2010
 
 flag test-trailing-dot
-  description: "Whether or not include the trainling dot test"
+  description: "Whether or not include the trailing dot test"
   default:     True
 
 test-suite http2-manager-tests

libs/schema-profunctor/src/Data/Schema.hs

@@ -296,6 +296,7 @@ instance HasOpt doc => FieldFunctor doc Maybe where
 
 -- | A schema for a one-field JSON object.
 field ::
+  forall doc' doc a b.
   HasField doc' doc =>
   Text ->
   SchemaP doc' A.Value A.Value a b ->
@@ -304,6 +305,7 @@ field = fieldOver id
 
 -- | A schema for a JSON object with a single optional field.
 optField ::
+  forall doc doc' a b.
   (HasOpt doc, HasField doc' doc) =>
   Text ->
   SchemaP doc' A.Value A.Value a b ->
@@ -312,6 +314,7 @@ optField = fieldF
 
 -- | Generalization of 'optField' with 'FieldFunctor'.
 fieldF ::
+  forall doc' doc f a b.
   (HasField doc' doc, FieldFunctor doc f) =>
   Text ->
   SchemaP doc' A.Value A.Value a b ->
@@ -362,32 +365,35 @@ fieldOver l name = fmap runIdentity . fieldOverF l name
 -- | Like 'field', but apply an arbitrary function to the
 -- documentation of the field.
 fieldWithDocModifier ::
+  forall doc' doc a b.
   HasField doc' doc =>
   Text ->
   (doc' -> doc') ->
   SchemaP doc' A.Value A.Value a b ->
   SchemaP doc A.Object [A.Pair] a b
-fieldWithDocModifier name modify sch = field name (over doc modify sch)
+fieldWithDocModifier name modify sch = field @doc' @doc name (over doc modify sch)
 
 -- | Like 'optField', but apply an arbitrary function to the
 -- documentation of the field.
 optFieldWithDocModifier ::
+  forall doc doc' a b.
   (HasOpt doc, HasField doc' doc) =>
   Text ->
   (doc' -> doc') ->
   SchemaP doc' A.Value A.Value a b ->
   SchemaP doc A.Object [A.Pair] a (Maybe b)
-optFieldWithDocModifier name modify sch = optField name (over doc modify sch)
+optFieldWithDocModifier name modify sch = optField @doc @doc' name (over doc modify sch)
 
 -- | Like 'fieldF', but apply an arbitrary function to the
 -- documentation of the field.
 fieldWithDocModifierF ::
+  forall doc' doc f a b.
   (HasField doc' doc, FieldFunctor doc f) =>
   Text ->
   (doc' -> doc') ->
   SchemaP doc' A.Value A.Value a b ->
   SchemaP doc A.Object [A.Pair] a (f b)
-fieldWithDocModifierF name modify sch = fieldF name (over doc modify sch)
+fieldWithDocModifierF name modify sch = fieldF @doc' @doc name (over doc modify sch)
 
 -- | Change the input type of a schema.
 (.=) :: Profunctor p => (a -> a') -> p a' b -> p a b

libs/types-common/src/Data/ETag.hs

@@ -43,13 +43,14 @@ import Control.Lens
 -- TODO: These package imports are only needed due to the
 -- use of GHCI. They should be removed by moving everything
 -- from cryptohash (which is deprecated) to cryptonite
-import "cryptohash-md5" Crypto.Hash.MD5 qualified as MD5
-import "cryptohash-sha1" Crypto.Hash.SHA1 qualified as SHA1
+
 import Data.Attoparsec.ByteString.Char8
 import Data.ByteString.Base16 qualified as Hex
 import Data.ByteString.Builder (byteString)
 import Data.ByteString.Conversion
 import Imports hiding (takeWhile)
+import "cryptohash-md5" Crypto.Hash.MD5 qualified as MD5
+import "cryptohash-sha1" Crypto.Hash.SHA1 qualified as SHA1
 
 data Digest = MD5 | SHA1
 

libs/types-common/src/Data/Misc.hs

@@ -329,7 +329,7 @@ instance ToSchema (Fingerprint Rsa) where
       p :: Chars.Parser (Fingerprint Rsa)
       p = do
         bs <- parser
-        either fail pure (Fingerprint <$> B64.decode bs)
+        either fail (pure . Fingerprint) (B64.decode bs)
 
 instance Cql (Fingerprint a) where
   ctype = Tagged BlobColumn

libs/wire-api/src/Wire/API/MakesFederatedCall.hs

@@ -27,10 +27,10 @@ module Wire.API.MakesFederatedCall
     Location (..),
     ShowComponent,
     Annotation,
-    exposeAnnotations,
     HasFeds (..),
     FedCallFrom' (..),
     Calls (..),
+    Wire.API.MakesFederatedCall.exposeAnnotations,
   )
 where
 

libs/wire-api/src/Wire/API/SwaggerHelper.hs

@@ -67,17 +67,17 @@ cleanupSwagger =
             if "Invalid "
               `T.isPrefixOf` desc
               && resp
-              ^? _Inline
-              . links
-              == pure mempty
+                ^? _Inline
+                  . links
+                == pure mempty
               && resp
-              ^? _Inline
-              . content
-              == pure mempty
+                ^? _Inline
+                  . content
+                == pure mempty
               && resp
-              ^? _Inline
-              . headers
-              == pure mempty
+                ^? _Inline
+                  . headers
+                == pure mempty
               then resps
               else insert code resp resps
           Nothing -> insert code resp resps
@@ -86,17 +86,17 @@ cleanupSwagger =
             if " not found"
               `T.isSuffixOf` desc
               && resp
-              ^? _Inline
-              . links
-              == pure mempty
+                ^? _Inline
+                  . links
+                == pure mempty
               && resp
-              ^? _Inline
-              . content
-              == pure mempty
+                ^? _Inline
+                  . content
+                == pure mempty
               && resp
-              ^? _Inline
-              . headers
-              == pure mempty
+                ^? _Inline
+                  . headers
+                == pure mempty
               then resps
               else insert code resp resps
           Nothing -> insert code resp resps

libs/wire-api/src/Wire/API/Team/LegalHold.hs

@@ -93,9 +93,9 @@ instance ToSchema LHServiceStatus where
 
 instance ToSchema ViewLegalHoldService where
   schema =
-    object "ViewLegalHoldService"
-      $ toOutput .= recordSchema
-      `withParser` validateViewLegalHoldService
+    object "ViewLegalHoldService" $
+      toOutput .= recordSchema
+        `withParser` validateViewLegalHoldService
     where
       toOutput :: ViewLegalHoldService -> (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
       toOutput = \case

nix/haskell-pins.nix

@@ -56,14 +56,14 @@
 # 1. Update version number.
 # 2. Make the 'sha256' blank string.
 # 3. Run step 3. from how to add a git pin.
-{ lib, fetchgit }: hself: hsuper:
+{ lib, fetchgit, pkgs }: hself: hsuper:
 let
   gitPins = {
     transitive-anns = {
       src = fetchgit {
         url = "https://github.com/wireapp/transitive-anns";
-        rev = "c3bdc423f84bf15fe8b3618b5dddd5764fc8a470";
-        sha256 = "sha256-mWBZ2uY0shlxNRceyC2Zu1f3Kr4IDtT/rOL7CKWgilA=";
+        rev = "7caf82f8d1be0f994a557e0cdc87fde8e32d5420";
+        sha256 = "sha256-rDIAbYpNGMBDOOE1hqLneRSVkCnj3cCQVYGKkhw8t7w=";
       };
     };
     amazonka = {
@@ -214,12 +214,23 @@ let
         sha256 = "sha256-+rHcS+BwEFsXqPAHX/KZDIgv9zfk1dZl0LlZJ57Com4=";
       };
     };
-    # PR: https://github.com/freckle/hspec-junit-formatter/pull/24
-    hspec-junit-formatter = {
-      src = fetchgit {
-        url = "https://github.com/akshaymankar/hspec-junit-formatter";
-        rev = "acec31822cc4f90489d9940bad23b3fd6d1d7c75";
-        sha256 = "sha256-4xGW3KHQKbTL+6+Q/gzfaMBP+J0npUe7tP5ZCQCB5+s=";
+
+    text-icu-translit = {
+      src = pkgs.fetchFromGitHub {
+        owner = "wireapp";
+        repo = "text-icu-translit";
+        rev = "317bbd27ea5ae4e7f93836ee9ca664f9bde7c583";
+        hash = "sha256-9uVqUTkLkE7U19FDjn5xt8JEHyJmosLPSnmW7kYbe5w=";
+      };
+    };
+
+    ghc-source-gen = {
+      version = "0.4.4.0";
+      src = pkgs.fetchFromGitHub {
+        owner = "circuithub";
+        repo = "ghc-source-gen";
+        rev = "7a6aac047b706508e85ba2054b5bedbecfd7eb7a";
+        hash = "sha256-DZu3XAOYLKcSpOYhjpb6IuXMvRHtGohTkL0nsCb/dT0=";
       };
     };
   };

nix/manual-overrides.nix

@@ -1,4 +1,4 @@
-{ libsodium, protobuf, hlib, mls-test-cli, fetchpatch }:
+{ libsodium, protobuf, hlib, mls-test-cli, fetchpatch, pkgs }:
 # FUTUREWORK: Figure out a way to detect if some of these packages are not
 # actually marked broken, so we can cleanup this file on every nixpkgs bump.
 hself: hsuper: {
@@ -10,7 +10,12 @@ hself: hsuper: {
     url = "https://gitlab.com/twittner/cql/-/merge_requests/11.patch";
     sha256 = "sha256-qfcCRkKjSS1TEqPRVBU9Ox2DjsdGsYG/F3DrZ5JGoEI=";
   });
+  ghc-source-gen = hlib.markUnbroken (hlib.doJailbreak hsuper.ghc-source-gen);
+  proto-lens-protoc = hlib.doJailbreak hsuper.proto-lens-protoc;
+  proto-lens-setup = hlib.doJailbreak hsuper.proto-lens-setup;
   hashtables = hsuper.hashtables_1_3;
+  # in case everything breaks with the hashable update, use this 
+  # hashable = hsuper.callHackage "hashable" "1.4.2.0" {};
   invertible = hlib.markUnbroken hsuper.invertible;
   lens-datetime = hlib.markUnbroken (hlib.doJailbreak hsuper.lens-datetime);
   monoidal-containers = hlib.doJailbreak hsuper.monoidal-containers;
@@ -33,13 +38,14 @@ hself: hsuper: {
   sodium-crypto-sign = hlib.addPkgconfigDepend hsuper.sodium-crypto-sign libsodium.dev;
   text-icu-translit = hlib.markUnbroken (hlib.dontCheck hsuper.text-icu-translit);
   text-short = hlib.dontCheck hsuper.text-short;
-  template = hlib.markUnbroken hsuper.template;
+  template = hlib.markUnbroken (hlib.doJailbreak hsuper.template);
   type-errors = hlib.dontCheck hsuper.type-errors;
   th-abstraction = hsuper.th-abstraction_0_5_0_0;
   th-desugar = hlib.doJailbreak hsuper.th-desugar;
   wai-middleware-prometheus = hlib.doJailbreak hsuper.wai-middleware-prometheus;
   wai-predicates = hlib.markUnbroken hsuper.wai-predicates;
-
+  # transitive-anns has flaky tests
+  transitive-anns = hlib.dontCheck hsuper.transitive-anns;
   http2-manager = hlib.enableCabalFlag hsuper.http2-manager "-f-test-trailing-dot";
 
   # PR with fix: https://github.com/freckle/hspec-junit-formatter/pull/23

nix/overlay-docs.nix

@@ -1,13 +1,13 @@
 self: super: rec {
-  python3 = super.python3.override ({
+  python3 = super.python3.override {
     packageOverrides = pself: psuper: {
       rst2pdf = pself.callPackage ./pkgs/python-docs/rst2pdf.nix { };
       sphinx-multiversion = pself.callPackage ./pkgs/python-docs/sphinx-multiversion.nix { };
       sphinx_reredirects = pself.callPackage ./pkgs/python-docs/sphinx_reredirects.nix { };
       sphinxcontrib-kroki = pself.callPackage ./pkgs/python-docs/sphinxcontrib-kroki.nix { };
       svg2rlg = pself.callPackage ./pkgs/python-docs/svg2rlg.nix { };
     };
-  });
+  };
 
   mls-test-cli = self.callPackage ./pkgs/mls-test-cli { };
 

nix/pkgs/mls-test-cli/default.nix

@@ -1,7 +1,6 @@
 { fetchFromGitHub
 , rustPlatform
 }:
-
 # TODO: migrate to crate2nix once
 # https://github.com/nix-community/crate2nix/issues/310 is fixed
 rustPlatform.buildRustPackage rec {