[chore] Weed out dead code, add weeder to sanitize-pr. (#4300)

Makefile

@@ -56,10 +56,10 @@ rabbit-clean:
 # Clean
 .PHONY: full-clean
 full-clean: clean
+	make rabbit-clean
 	rm -rf ~/.cache/hie-bios
 	rm -rf ./dist-newstyle ./.env
 	direnv reload
-	make rabbit-clean
 	@echo -e "\n\n*** NOTE: you may want to also 'rm -rf ~/.cabal/store \$$CABAL_DIR/store', not sure.\n"
 
 .PHONY: clean
@@ -138,6 +138,7 @@ devtest:
 
 .PHONY: sanitize-pr
 sanitize-pr:
+	./hack/bin/check-weed.sh
 	make lint-all-shallow
 	make git-add-cassandra-schema
 	@git diff-files --quiet -- || ( echo "There are unstaged changes, please take a look, consider committing them, and try again."; exit 1 )

hack/bin/check-weed.sh

@@ -0,0 +1,18 @@
+#!/bin/bash
+
+# Define ANSI color code for red
+RED='\033[0;31m'
+NC='\033[0m' # No Color (reset)
+
+echo "Checking for weed…"
+echo "Make sure you have compiled everything with the correct settings."
+
+output=$(weeder -N)
+
+# Check if the output is empty
+if [[ -z "$output" ]]; then
+    echo "No weed found! 🚫🪴"
+else
+    echo "We found some weed!"
+    echo -e "${RED}$output${NC}"
+fi

integration/integration.cabal

@@ -100,7 +100,6 @@ library
     API.GundeckInternal
     API.Nginz
     API.Spar
-    API.Stern
     MLS.Util
     Notifications
     RunAllTests

integration/test/Test/FeatureFlags/Mls.hs

@@ -59,16 +59,6 @@ testMlsPatch = do
                 ]
           ]
 
-mlsDefaultConfig :: Value
-mlsDefaultConfig =
-  object
-    [ "protocolToggleUsers" .= ([] :: [String]),
-      "defaultProtocol" .= "proteus",
-      "supportedProtocols" .= ["proteus", "mls"],
-      "allowedCipherSuites" .= ([1] :: [Int]),
-      "defaultCipherSuite" .= toJSON (1 :: Int)
-    ]
-
 mls1 :: String -> Value
 mls1 uid =
   object

integration/test/Test/FeatureFlags/MlsMigration.hs

@@ -77,13 +77,3 @@ mlsMigrationConfig2 =
             "finaliseRegardlessAfter" .= "2031-10-17T00:00:00Z"
           ]
     ]
-
-mlsMigrationInvalidConfig :: Value
-mlsMigrationInvalidConfig =
-  object
-    [ "status" .= "enabled",
-      "config"
-        .= object
-          [ "startTime" .= A.Number 1
-          ]
-    ]

integration/test/Testlib/Types.hs

@@ -407,9 +407,6 @@ assertNothing = maybe (pure ()) $ const $ assertFailure "Maybe value was Just, n
 addFailureContext :: String -> App a -> App a
 addFailureContext ctx = modifyFailureContext (\mCtx0 -> Just $ maybe ctx (\x -> ctx <> "\n" <> x) mCtx0)
 
-modifyFailureMsg :: (String -> String) -> App a -> App a
-modifyFailureMsg modMessage = modifyFailure (\e -> e {msg = modMessage e.msg})
-
 modifyFailureContext :: (Maybe String -> Maybe String) -> App a -> App a
 modifyFailureContext modContext =
   modifyFailure

libs/metrics-wai/default.nix

@@ -19,7 +19,6 @@
 , wai
 , wai-middleware-prometheus
 , wai-route
-, wai-routing
 }:
 mkDerivation {
   pname = "metrics-wai";
@@ -38,7 +37,6 @@ mkDerivation {
     wai
     wai-middleware-prometheus
     wai-route
-    wai-routing
   ];
   testHaskellDepends = [ base containers hspec imports ];
   testToolDepends = [ hspec-discover ];

libs/metrics-wai/metrics-wai.cabal

@@ -81,7 +81,6 @@ library
     , wai                        >=3
     , wai-middleware-prometheus
     , wai-route                  >=0.3
-    , wai-routing
 
   default-language:   GHC2021
 

libs/metrics-wai/src/Data/Metrics/Middleware/Prometheus.hs

@@ -16,26 +16,17 @@
 -- with this program. If not, see <https://www.gnu.org/licenses/>.
 
 module Data.Metrics.Middleware.Prometheus
-  ( waiPrometheusMiddleware,
-    waiPrometheusMiddlewarePaths,
+  ( waiPrometheusMiddlewarePaths,
     normalizeWaiRequestRoute,
   )
 where
 
 import Data.Id
 import Data.Metrics.Types (Paths, treeLookup)
-import Data.Metrics.WaiRoute (treeToPaths)
 import Data.Text.Encoding qualified as T
 import Imports
 import Network.Wai qualified as Wai
 import Network.Wai.Middleware.Prometheus qualified as Promth
-import Network.Wai.Routing.Route (Routes, prepare)
-
--- | Adds a prometheus metrics endpoint at @/i/metrics@
--- This middleware requires your servers 'Routes' because it does some normalization
--- (e.g. removing params from calls)
-waiPrometheusMiddleware :: (Monad m) => Routes a m b -> Wai.Middleware
-waiPrometheusMiddleware routes = waiPrometheusMiddlewarePaths $ treeToPaths $ prepare routes
 
 -- | Helper function that should only be needed as long as we have wai-routing code left in
 -- proxy: run 'treeToPaths' on old routing tables and 'routeToPaths' on the servant ones, and

libs/types-common/default.nix

@@ -24,7 +24,6 @@
 , gitignoreSource
 , hashable
 , http-api-data
-, http-types
 , imports
 , iproute
 , iso3166-country-codes
@@ -84,7 +83,6 @@ mkDerivation {
     generic-random
     hashable
     http-api-data
-    http-types
     imports
     iproute
     iso3166-country-codes

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

@@ -18,11 +18,8 @@
 module Data.Credentials where
 
 import Data.Aeson (FromJSON)
-import Data.ByteString.Base64 qualified as B64
 import Data.Text
-import Data.Text.Encoding qualified as TE
 import Imports
-import Network.HTTP.Types.Header
 
 -- | Generic credentials for authenticating a user. Usually used for deserializing from a secret yaml file.
 data Credentials = Credentials
@@ -32,6 +29,3 @@ data Credentials = Credentials
   deriving stock (Generic)
 
 instance FromJSON Credentials
-
-mkBasicAuthHeader :: Credentials -> Header
-mkBasicAuthHeader (Credentials u p) = (hAuthorization, "Basic " <> B64.encode (TE.encodeUtf8 (u <> ":" <> p)))

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

@@ -49,7 +49,6 @@ module Data.Misc
     PlainTextPassword6,
     PlainTextPassword8,
     plainTextPassword6,
-    plainTextPassword8,
     fromPlainTextPassword,
     plainTextPassword8Unsafe,
     plainTextPassword6Unsafe,
@@ -323,9 +322,6 @@ plainTextPassword6 = fmap PlainTextPassword' . checked
 plainTextPassword6Unsafe :: Text -> PlainTextPassword6
 plainTextPassword6Unsafe = PlainTextPassword' . unsafeRange
 
-plainTextPassword8 :: Text -> Maybe PlainTextPassword8
-plainTextPassword8 = fmap PlainTextPassword' . checked
-
 plainTextPassword8Unsafe :: Text -> PlainTextPassword8
 plainTextPassword8Unsafe = PlainTextPassword' . unsafeRange
 

libs/types-common/types-common.cabal

@@ -115,7 +115,6 @@ library
     , generic-random         >=1.4.0.0
     , hashable               >=1.2
     , http-api-data
-    , http-types
     , imports
     , iproute                >=1.5
     , iso3166-country-codes  >=0.20140203.8

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

@@ -40,7 +40,6 @@ module Wire.API.User
     userEmail,
     userSSOId,
     userIssuer,
-    userSCIMExternalId,
     scimExternalId,
     ssoIssuerAndNameId,
     mkUserProfile,
@@ -636,9 +635,6 @@ userEmail = emailIdentity <=< userIdentity
 userSSOId :: User -> Maybe UserSSOId
 userSSOId = ssoIdentity <=< userIdentity
 
-userSCIMExternalId :: User -> Maybe Text
-userSCIMExternalId usr = scimExternalId (userManagedBy usr) =<< userSSOId usr
-
 -- FUTUREWORK: this is only ignoring case in the email format, and emails should be
 -- handled case-insensitively.  https://wearezeta.atlassian.net/browse/SQSERVICES-909
 scimExternalId :: ManagedBy -> UserSSOId -> Maybe Text

libs/wire-api/test/unit/Test/Wire/API/Password.hs

@@ -31,7 +31,8 @@ tests =
   testGroup "Password" $
     [ testCase "hash password argon2id" testHashPasswordArgon2id,
       testCase "update pwd hash" testUpdateHash,
-      testCase "verify old scrypt password still works" testHashingOldScrypt
+      testCase "verify old scrypt password still works" testHashingOldScrypt,
+      testCase "test hash scrypt" testHashPasswordScrypt
     ]
 
 defaultOptions :: Argon2.Options

libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs

@@ -23,7 +23,6 @@ import Data.Misc
 import Data.Qualified
 import Imports
 import Polysemy
-import Polysemy.Error
 import Wire.API.Password (Password, PasswordStatus)
 import Wire.API.User
 import Wire.API.User.Password (PasswordResetCode, PasswordResetIdentity)
@@ -43,21 +42,3 @@ data AuthenticationSubsystem m a where
   InternalLookupPasswordResetCode :: EmailKey -> AuthenticationSubsystem m (Maybe PasswordResetPair)
 
 makeSem ''AuthenticationSubsystem
-
-authenticate ::
-  ( Member (Error AuthError) r,
-    Member AuthenticationSubsystem r
-  ) =>
-  UserId ->
-  PlainTextPassword6 ->
-  Sem r ()
-authenticate uid pwd = authenticateEither uid pwd >>= either throw pure
-
-reauthenticate ::
-  ( Member (Error ReAuthError) r,
-    Member AuthenticationSubsystem r
-  ) =>
-  UserId ->
-  Maybe PlainTextPassword6 ->
-  Sem r ()
-reauthenticate uid pwd = reauthenticateEither uid pwd >>= either throw pure

libs/wire-subsystems/src/Wire/TeamInvitationSubsystem/Interpreter.hs

@@ -175,14 +175,6 @@ createInvitation' tid mExpectedInvId inviteeRole mbInviterUid inviterEmail invRe
 mkInvitationCode :: (Member Random r) => Sem r InvitationCode
 mkInvitationCode = InvitationCode . AsciiText.encodeBase64Url <$> Random.bytes 24
 
-isPersonalUser :: (Member UserSubsystem r) => Local EmailKey -> Sem r Bool
-isPersonalUser uke = do
-  mAccount <- getLocalUserAccountByUserKey uke
-  pure $ case mAccount of
-    -- this can e.g. happen if the key is claimed but the account is not yet created
-    Nothing -> False
-    Just user -> user.userStatus == Active && isNothing user.userTeam
-
 -- | brig used to not store the role, so for migration we allow this to be empty and fill in the
 -- default here.
 toInvitation ::

services/brig/src/Brig/API/Auth.hs

@@ -48,6 +48,7 @@ import Wire.API.User.Auth hiding (access)
 import Wire.API.User.Auth.LegalHold
 import Wire.API.User.Auth.ReAuth
 import Wire.API.User.Auth.Sso
+import Wire.ActivationCodeStore (ActivationCodeStore)
 import Wire.AuthenticationSubsystem
 import Wire.AuthenticationSubsystem qualified as Authentication
 import Wire.BlockListStore
@@ -101,6 +102,7 @@ login ::
     Member Events r,
     Member (Input (Local ())) r,
     Member UserSubsystem r,
+    Member ActivationCodeStore r,
     Member VerificationCodeSubsystem r,
     Member AuthenticationSubsystem r
   ) =>

services/brig/src/Brig/API/Internal.hs

@@ -88,6 +88,7 @@ import Wire.API.User.Activation
 import Wire.API.User.Client
 import Wire.API.User.RichInfo
 import Wire.API.UserEvent
+import Wire.ActivationCodeStore (ActivationCodeStore)
 import Wire.AuthenticationSubsystem (AuthenticationSubsystem)
 import Wire.BlockListStore (BlockListStore)
 import Wire.DeleteQueue (DeleteQueue)
@@ -146,7 +147,9 @@ servantSitemap ::
     Member (Input (Local ())) r,
     Member IndexedUserStore r,
     Member (Polysemy.Error UserSubsystemError) r,
-    Member HashPassword r
+    Member HashPassword r,
+    Member (Embed IO) r,
+    Member ActivationCodeStore r
   ) =>
   ServerT BrigIRoutes.API (Handler r)
 servantSitemap =
@@ -199,7 +202,9 @@ accountAPI ::
     Member Events r,
     Member PasswordResetCodeStore r,
     Member HashPassword r,
-    Member InvitationStore r
+    Member InvitationStore r,
+    Member (Embed IO) r,
+    Member ActivationCodeStore r
   ) =>
   ServerT BrigIRoutes.AccountAPI (Handler r)
 accountAPI =
@@ -597,9 +602,14 @@ listActivatedAccountsH
               }
       pure $ others <> byEmails
 
-getActivationCode :: EmailAddress -> Handler r GetActivationCodeResp
+getActivationCode ::
+  ( Member ActivationCodeStore r,
+    Member (Embed IO) r
+  ) =>
+  EmailAddress ->
+  Handler r GetActivationCodeResp
 getActivationCode email = do
-  apair <- lift . wrapClient $ API.lookupActivationCode email
+  apair <- lift . liftSem $ API.lookupActivationCode email
   maybe (throwStd activationKeyNotFound) (pure . GetActivationCodeResp) apair
 
 getPasswordResetCodeH ::

services/brig/src/Brig/API/Public.hs

@@ -144,6 +144,7 @@ import Wire.API.User.RichInfo qualified as Public
 import Wire.API.User.Search qualified as Public
 import Wire.API.UserMap qualified as Public
 import Wire.API.Wrapped qualified as Public
+import Wire.ActivationCodeStore (ActivationCodeStore)
 import Wire.AuthenticationSubsystem (AuthenticationSubsystem, createPasswordResetCode, resetPassword)
 import Wire.BlockListStore (BlockListStore)
 import Wire.DeleteQueue
@@ -296,6 +297,7 @@ servantSitemap ::
     Member SFT r,
     Member TinyLog r,
     Member UserKeyStore r,
+    Member ActivationCodeStore r,
     Member UserStore r,
     Member (Input TeamTemplates) r,
     Member UserSubsystem r,
@@ -1073,7 +1075,8 @@ sendActivationCode ::
   ( Member BlockListStore r,
     Member EmailSubsystem r,
     Member GalleyAPIAccess r,
-    Member UserKeyStore r
+    Member UserKeyStore r,
+    Member ActivationCodeStore r
   ) =>
   Public.SendActivationCode ->
   Handler r ()