From c1ed1c433b57511e65cb72eaf9c25ccf7ebc49f2 Mon Sep 17 00:00:00 2001 From: Igor Ranieri <54423+elland@users.noreply.github.com> Date: Wed, 23 Oct 2024 18:38:19 +0200 Subject: [PATCH] [chore] Weed out dead code, add weeder to sanitize-pr. (#4300) --- Makefile | 3 +- hack/bin/check-weed.sh | 18 +++++++++ integration/integration.cabal | 1 - integration/test/API/Stern.hs | 8 ---- integration/test/Test/FeatureFlags/Mls.hs | 10 ----- .../test/Test/FeatureFlags/MlsMigration.hs | 10 ----- integration/test/Testlib/Types.hs | 3 -- libs/metrics-wai/default.nix | 2 - libs/metrics-wai/metrics-wai.cabal | 1 - .../src/Data/Metrics/Middleware/Prometheus.hs | 11 +----- libs/types-common/default.nix | 2 - libs/types-common/src/Data/Credentials.hs | 6 --- libs/types-common/src/Data/Misc.hs | 4 -- libs/types-common/types-common.cabal | 1 - libs/wire-api/src/Wire/API/User.hs | 4 -- .../test/unit/Test/Wire/API/Password.hs | 3 +- .../src/Wire/AuthenticationSubsystem.hs | 19 ---------- .../TeamInvitationSubsystem/Interpreter.hs | 8 ---- services/brig/src/Brig/API/Auth.hs | 2 + services/brig/src/Brig/API/Internal.hs | 18 +++++++-- services/brig/src/Brig/API/Public.hs | 5 ++- services/brig/src/Brig/API/User.hs | 13 +++++-- services/brig/src/Brig/Data/Activation.hs | 10 ----- services/brig/src/Brig/Federation/Client.hs | 12 ------ services/brig/src/Brig/User/Auth.hs | 18 ++++++--- .../brig/test/integration/API/User/Util.hs | 37 ------------------- services/cargohold/src/CargoHold/AWS.hs | 9 ----- services/cargohold/src/CargoHold/Options.hs | 11 +++--- services/galley/test/integration/API/Util.hs | 26 ------------- services/gundeck/src/Gundeck/Monad.hs | 9 ----- tools/stern/default.nix | 2 - tools/stern/src/Stern/Intra.hs | 16 -------- tools/stern/stern.cabal | 1 - weeder.toml | 20 ++++++++-- 34 files changed, 86 insertions(+), 237 deletions(-) create mode 100755 hack/bin/check-weed.sh delete mode 100644 integration/test/API/Stern.hs diff --git a/Makefile b/Makefile index 8f7e39530ff..e422703c453 100644 --- a/Makefile +++ b/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 ) diff --git a/hack/bin/check-weed.sh b/hack/bin/check-weed.sh new file mode 100755 index 00000000000..a55e4c26ca7 --- /dev/null +++ b/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 diff --git a/integration/integration.cabal b/integration/integration.cabal index edada8586df..a3989f28e76 100644 --- a/integration/integration.cabal +++ b/integration/integration.cabal @@ -100,7 +100,6 @@ library API.GundeckInternal API.Nginz API.Spar - API.Stern MLS.Util Notifications RunAllTests diff --git a/integration/test/API/Stern.hs b/integration/test/API/Stern.hs deleted file mode 100644 index b7d93d07178..00000000000 --- a/integration/test/API/Stern.hs +++ /dev/null @@ -1,8 +0,0 @@ -module API.Stern where - -import Testlib.Prelude - -getTeamActivity :: (HasCallStack, MakesValue domain) => domain -> String -> App Response -getTeamActivity domain tid = - baseRequest domain Stern Unversioned (joinHttpPath ["team-activity-info", tid]) - >>= submit "GET" diff --git a/integration/test/Test/FeatureFlags/Mls.hs b/integration/test/Test/FeatureFlags/Mls.hs index 40c3783fec0..73cc96eaf12 100644 --- a/integration/test/Test/FeatureFlags/Mls.hs +++ b/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 diff --git a/integration/test/Test/FeatureFlags/MlsMigration.hs b/integration/test/Test/FeatureFlags/MlsMigration.hs index edabd00fb16..bac309fa5bb 100644 --- a/integration/test/Test/FeatureFlags/MlsMigration.hs +++ b/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 - ] - ] diff --git a/integration/test/Testlib/Types.hs b/integration/test/Testlib/Types.hs index 1c64fb56f7f..e25b33d06f8 100644 --- a/integration/test/Testlib/Types.hs +++ b/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 diff --git a/libs/metrics-wai/default.nix b/libs/metrics-wai/default.nix index 8bb74088e5e..5a64f6b4f93 100644 --- a/libs/metrics-wai/default.nix +++ b/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 ]; diff --git a/libs/metrics-wai/metrics-wai.cabal b/libs/metrics-wai/metrics-wai.cabal index 1b6e5cfa03b..779eda44ec6 100644 --- a/libs/metrics-wai/metrics-wai.cabal +++ b/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 diff --git a/libs/metrics-wai/src/Data/Metrics/Middleware/Prometheus.hs b/libs/metrics-wai/src/Data/Metrics/Middleware/Prometheus.hs index 39b73e351e9..b185b6b60da 100644 --- a/libs/metrics-wai/src/Data/Metrics/Middleware/Prometheus.hs +++ b/libs/metrics-wai/src/Data/Metrics/Middleware/Prometheus.hs @@ -16,26 +16,17 @@ -- with this program. If not, see . 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 diff --git a/libs/types-common/default.nix b/libs/types-common/default.nix index 6e45c4c4d3c..0cafcabbfd7 100644 --- a/libs/types-common/default.nix +++ b/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 diff --git a/libs/types-common/src/Data/Credentials.hs b/libs/types-common/src/Data/Credentials.hs index 52c632f9307..5423b574e7a 100644 --- a/libs/types-common/src/Data/Credentials.hs +++ b/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))) diff --git a/libs/types-common/src/Data/Misc.hs b/libs/types-common/src/Data/Misc.hs index 81f9ddc02e6..a72995b8667 100644 --- a/libs/types-common/src/Data/Misc.hs +++ b/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 diff --git a/libs/types-common/types-common.cabal b/libs/types-common/types-common.cabal index 5144c76d5d9..369659432cc 100644 --- a/libs/types-common/types-common.cabal +++ b/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 diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index 47f3e5d56e0..25cf9e88172 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/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 diff --git a/libs/wire-api/test/unit/Test/Wire/API/Password.hs b/libs/wire-api/test/unit/Test/Wire/API/Password.hs index c9edea60ef4..5693e5c54fe 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Password.hs +++ b/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 diff --git a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs index 1d3e18b8411..9d098c0ead9 100644 --- a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs +++ b/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 diff --git a/libs/wire-subsystems/src/Wire/TeamInvitationSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/TeamInvitationSubsystem/Interpreter.hs index bac8f052635..46445645c9d 100644 --- a/libs/wire-subsystems/src/Wire/TeamInvitationSubsystem/Interpreter.hs +++ b/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 :: diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index b0f7295cacf..021ca38aabc 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/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 ) => diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 94ee5b43021..21d73c16e99 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/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 :: diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 2485961ce68..a576af85158 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/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 () diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index daf3109c63e..e081822b271 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -127,6 +127,8 @@ 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.ActivationCodeStore qualified as ActivationCode import Wire.AuthenticationSubsystem (AuthenticationSubsystem, internalLookupPasswordResetCode) import Wire.BlockListStore as BlockListStore import Wire.DeleteQueue @@ -778,6 +780,7 @@ sendActivationCode :: ( Member BlockListStore r, Member EmailSubsystem r, Member GalleyAPIAccess r, + Member ActivationCodeStore r, Member UserKeyStore r ) => EmailAddress -> @@ -792,7 +795,7 @@ sendActivationCode email loc = do blacklisted <- lift . liftSem $ BlockListStore.exists ek when blacklisted $ throwE (ActivationBlacklistedUserKey ek) - uc <- lift . wrapClient $ Data.lookupActivationCode ek + uc <- lift . liftSem $ ActivationCode.lookupActivationCode ek case uc of Nothing -> sendVerificationEmail ek Nothing -- Fresh code request, no user Just (Nothing, c) -> sendVerificationEmail ek (Just c) -- Re-requesting existing code @@ -1070,13 +1073,15 @@ deleteAccount user = do -- Lookups lookupActivationCode :: - (MonadClient m) => + ( Member ActivationCodeStore r, + Member (Embed IO) r + ) => EmailAddress -> - m (Maybe ActivationPair) + Sem r (Maybe ActivationPair) lookupActivationCode email = do let uk = mkEmailKey email k <- liftIO $ Data.mkActivationKey uk - c <- fmap snd <$> Data.lookupActivationCode uk + c <- fmap snd <$> ActivationCode.lookupActivationCode uk pure $ (k,) <$> c lookupPasswordResetCode :: diff --git a/services/brig/src/Brig/Data/Activation.hs b/services/brig/src/Brig/Data/Activation.hs index a7f94e58205..ae9ce48899f 100644 --- a/services/brig/src/Brig/Data/Activation.hs +++ b/services/brig/src/Brig/Data/Activation.hs @@ -23,7 +23,6 @@ module Brig.Data.Activation activationErrorToRegisterError, newActivation, mkActivationKey, - lookupActivationCode, activateKey, verifyCode, ) @@ -175,12 +174,6 @@ newActivation uk timeout u = do ActivationCode . Ascii.unsafeFromText . pack . printf "%06d" <$> randIntegerZeroToNMinusOne 1000000 --- | Lookup an activation code and it's associated owner (if any) for a 'UserKey'. -lookupActivationCode :: (MonadClient m) => EmailKey -> m (Maybe (Maybe UserId, ActivationCode)) -lookupActivationCode k = - liftIO (mkActivationKey k) - >>= retry x1 . query1 codeSelect . params LocalQuorum . Identity - -- | Verify an activation code. verifyCode :: (MonadClient m) => @@ -229,8 +222,5 @@ keyInsert = keySelect :: PrepQuery R (Identity ActivationKey) (Int32, Ascii, Text, ActivationCode, Maybe UserId, Int32) keySelect = "SELECT ttl(code) as ttl, key_type, key_text, code, user, retries FROM activation_keys WHERE key = ?" -codeSelect :: PrepQuery R (Identity ActivationKey) (Maybe UserId, ActivationCode) -codeSelect = "SELECT user, code FROM activation_keys WHERE key = ?" - keyDelete :: PrepQuery W (Identity ActivationKey) () keyDelete = "DELETE FROM activation_keys WHERE key = ?" diff --git a/services/brig/src/Brig/Federation/Client.hs b/services/brig/src/Brig/Federation/Client.hs index 19e0193e1ce..9c5302689d2 100644 --- a/services/brig/src/Brig/Federation/Client.hs +++ b/services/brig/src/Brig/Federation/Client.hs @@ -99,18 +99,6 @@ claimMultiPrekeyBundle domain uc = do lift . Log.info $ Log.msg @Text "Brig-federation: claiming remote multi-user prekey bundle" runBrigFederatorClient domain $ fedClient @'Brig @"claim-multi-prekey-bundle" uc -searchUsers :: - ( MonadReader Env m, - MonadIO m, - Log.MonadLogger m - ) => - Domain -> - SearchRequest -> - ExceptT FederationError m SearchResponse -searchUsers domain searchTerm = do - lift $ Log.info $ Log.msg $ T.pack "Brig-federation: search call on remote backend" - runBrigFederatorClient domain $ fedClient @'Brig @"search-users" searchTerm - getUserClients :: ( MonadReader Env m, MonadIO m, diff --git a/services/brig/src/Brig/User/Auth.hs b/services/brig/src/Brig/User/Auth.hs index 9f4168727a5..b8e6556f4aa 100644 --- a/services/brig/src/Brig/User/Auth.hs +++ b/services/brig/src/Brig/User/Auth.hs @@ -38,7 +38,6 @@ import Brig.API.Types import Brig.API.User (changeSingleAccountStatus) import Brig.App import Brig.Budget -import Brig.Data.Activation qualified as Data import Brig.Data.Client import Brig.Options qualified as Opt import Brig.Types.Intra @@ -71,6 +70,8 @@ import Wire.API.User import Wire.API.User.Auth import Wire.API.User.Auth.LegalHold import Wire.API.User.Auth.Sso +import Wire.ActivationCodeStore (ActivationCodeStore) +import Wire.ActivationCodeStore qualified as ActivationCode import Wire.AuthenticationSubsystem import Wire.AuthenticationSubsystem qualified as Authentication import Wire.Events (Events) @@ -88,13 +89,14 @@ import Wire.VerificationCodeSubsystem qualified as VerificationCodeSubsystem login :: forall r. ( Member GalleyAPIAccess r, + Member (Input (Local ())) r, + Member ActivationCodeStore r, + Member Events r, Member TinyLog r, Member UserKeyStore r, Member UserStore r, - Member VerificationCodeSubsystem r, - Member (Input (Local ())) r, Member UserSubsystem r, - Member Events r, + Member VerificationCodeSubsystem r, Member AuthenticationSubsystem r ) => Login -> @@ -290,6 +292,7 @@ resolveLoginId :: ( Member UserKeyStore r, Member UserStore r, Member UserSubsystem r, + Member ActivationCodeStore r, Member (Input (Local ())) r ) => LoginId -> @@ -311,7 +314,10 @@ validateLoginId (LoginByHandle h) = Right h isPendingActivation :: forall r. - (Member UserSubsystem r, Member (Input (Local ())) r) => + ( Member UserSubsystem r, + Member ActivationCodeStore r, + Member (Input (Local ())) r + ) => LoginId -> AppT r Bool isPendingActivation ident = case ident of @@ -320,7 +326,7 @@ isPendingActivation ident = case ident of where checkKey :: EmailKey -> AppT r Bool checkKey k = do - musr <- (>>= fst) <$> wrapClient (Data.lookupActivationCode k) + musr <- (>>= fst) <$> liftSem (ActivationCode.lookupActivationCode k) case musr of Nothing -> pure False Just usr -> liftSem do diff --git a/services/brig/test/integration/API/User/Util.hs b/services/brig/test/integration/API/User/Util.hs index 1a4d528d108..c05174bd505 100644 --- a/services/brig/test/integration/API/User/Util.hs +++ b/services/brig/test/integration/API/User/Util.hs @@ -40,11 +40,9 @@ import Data.Handle (parseHandle) import Data.Id import Data.Kind import Data.List1 qualified as List1 -import Data.Misc import Data.Qualified import Data.Range (unsafeRange) import Data.String.Conversions -import Data.Text.Ascii qualified as Ascii import Data.Vector qualified as Vec import Data.ZAuth.Token qualified as ZAuth import Imports @@ -69,7 +67,6 @@ import Wire.API.User.Auth import Wire.API.User.Client import Wire.API.User.Client.DPoPAccessToken (Proof) import Wire.API.User.Handle -import Wire.API.User.Password import Wire.VerificationCode qualified as Code import Wire.VerificationCodeStore.Cassandra qualified as VerificationCodeStore @@ -129,15 +126,6 @@ registerUser name brig = do ] post (brig . path "/register" . contentJson . body p) -initiatePasswordReset :: Brig -> EmailAddress -> (MonadHttp m) => m ResponseLBS -initiatePasswordReset brig email = - post - ( brig - . path "/password-reset" - . contentJson - . body (RequestBodyLBS . encode $ NewPasswordReset email) - ) - activateEmail :: (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => Brig -> EmailAddress -> m () activateEmail brig email = do act <- getActivationCode brig (Left email) @@ -180,31 +168,6 @@ initiateEmailUpdateNoSend brig email uid = in put (brig . path "/i/self/email" . contentJson . zUser uid . body emailUpdate) - Brig -> - EmailAddress -> - UserId -> - PlainTextPassword8 -> - m CompletePasswordReset -preparePasswordReset brig email uid newpw = do - let qry = queryItem "email" (toByteString' email) - r <- get $ brig . path "/i/users/password-reset-code" . qry - let lbs = fromMaybe "" $ responseBody r - let Just pwcode = PasswordResetCode . Ascii.unsafeFromText <$> (lbs ^? key "code" . _String) - let ident = PasswordResetIdentityKey (mkPasswordResetKey uid) - let complete = CompletePasswordReset ident pwcode newpw - pure complete - -completePasswordReset :: Brig -> CompletePasswordReset -> (MonadHttp m) => m ResponseLBS -completePasswordReset brig passwordResetData = - post - ( brig - . path "/password-reset/complete" - . contentJson - . body (RequestBodyLBS $ encode passwordResetData) - ) - removeBlacklist :: Brig -> EmailAddress -> (MonadIO m, MonadHttp m) => m () removeBlacklist brig email = void $ delete (brig . path "/i/users/blacklist" . queryItem "email" (toByteString' email)) diff --git a/services/cargohold/src/CargoHold/AWS.hs b/services/cargohold/src/CargoHold/AWS.hs index a7db87772ea..e94392d5755 100644 --- a/services/cargohold/src/CargoHold/AWS.hs +++ b/services/cargohold/src/CargoHold/AWS.hs @@ -1,5 +1,4 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE TemplateHaskell #-} -- This file is part of the Wire Server implementation. -- @@ -21,11 +20,6 @@ module CargoHold.AWS ( -- * Monad Env (..), - amazonkaEnvLens, - CargoHold.AWS.s3BucketLens, - CargoHold.AWS.cloudFrontLens, - amazonkaDownloadEndpointLens, - loggerLens, mkEnv, amazonkaEnvWithDownloadEndpoint, Amazon, @@ -56,7 +50,6 @@ import qualified System.Logger as Logger import System.Logger.Class (Logger, MonadLogger (log), (~~)) import qualified System.Logger.Class as Log import Util.Options (AWSEndpoint (..)) -import Util.SuffixNamer data Env = Env { logger :: !Logger, @@ -69,8 +62,6 @@ data Env = Env cloudFront :: !(Maybe CloudFront) } -makeLensesWith (lensRules & lensField .~ suffixNamer) ''Env - -- | Override the endpoint in the '_amazonkaEnv' with '_amazonkaDownloadEndpoint'. -- TODO: Choose the correct s3 addressing style amazonkaEnvWithDownloadEndpoint :: Env -> AWS.Env diff --git a/services/cargohold/src/CargoHold/Options.hs b/services/cargohold/src/CargoHold/Options.hs index 09edeb065cd..4b5ccb1d7bc 100644 --- a/services/cargohold/src/CargoHold/Options.hs +++ b/services/cargohold/src/CargoHold/Options.hs @@ -44,7 +44,6 @@ data CloudFrontOpts = CloudFrontOpts deriving (Show, Generic) deriveFromJSON defaultOptions ''CloudFrontOpts -makeLensesWith (lensRules & lensField .~ suffixNamer) ''CloudFrontOpts newtype OptS3AddressingStyle = OptS3AddressingStyle { unwrapS3AddressingStyle :: S3AddressingStyle @@ -123,8 +122,12 @@ instance FromJSON S3Compatibility where deriveFromJSON defaultOptions ''AWSOpts -makeLenses ''AWSOpts -makeLensesWith (lensRules & lensField .~ suffixNamer) ''AWSOpts +makeLensesFor + [ ("multiIngress", "multiIngressLens"), + ("s3DownloadEndpoint", "s3DownloadEndpointLens"), + ("cloudFront", "cloudFrontLens") + ] + ''AWSOpts data Settings = Settings { -- | Maximum allowed size for uploads, in bytes @@ -148,8 +151,6 @@ data Settings = Settings deriveFromJSON defaultOptions ''Settings -makeLensesWith (lensRules & lensField .~ suffixNamer) ''Settings - -- | Options consist of information the server needs to operate, and 'Settings' -- modify the behavior. data Opts = Opts diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 6fe7bcbd9bd..a12bf6d2e10 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -42,7 +42,6 @@ import Data.Code qualified as Code import Data.Currency qualified as Currency import Data.Default import Data.Domain -import Data.Handle qualified as Handle import Data.HashMap.Strict qualified as HashMap import Data.Id import Data.Json.Util hiding ((#)) @@ -69,7 +68,6 @@ import Data.UUID.V4 import Federator.MockServer import Federator.MockServer qualified as Mock import GHC.TypeNats -import Galley.Intra.User (chunkify) import Galley.Options qualified as Opts import Galley.Run qualified as Run import Galley.Types.Conversations.One2One @@ -304,14 +302,6 @@ getTeamMembers usr tid = do r <- get (g . paths ["teams", toByteString' tid, "members"] . zUser usr) UserId -> TeamId -> TestM ResponseLBS -getTeamMembersCsv usr tid = do - g <- viewGalley - get (g . accept "text/csv" . paths ["teams", toByteString' tid, "members/csv"] . zUser usr) UserId -> TeamId -> Int -> TestM TeamMemberList getTeamMembersTruncated usr tid n = do g <- viewGalley @@ -2389,22 +2379,6 @@ deleteTeam owner tid = do !!! do const 202 === statusCode -getUsersBy :: forall uidsOrHandles. (ToByteString uidsOrHandles) => ByteString -> [uidsOrHandles] -> TestM [User] -getUsersBy keyName = chunkify $ \keys -> do - brig <- viewBrig - let users = BS.intercalate "," $ toByteString' <$> keys - res <- - get - ( brig - . path "/i/users" - . queryItem keyName users - . expect2xx - ) - pure $ fromJust $ responseJsonMaybe @[User] res - -getUsersByHandle :: [Handle.Handle] -> TestM [User] -getUsersByHandle = getUsersBy "handles" - upgradeClientToLH :: (HasCallStack) => UserId -> ClientId -> TestM () upgradeClientToLH zusr cid = putCapabilities zusr cid [ClientSupportsLegalholdImplicitConsent] diff --git a/services/gundeck/src/Gundeck/Monad.hs b/services/gundeck/src/Gundeck/Monad.hs index 1ccce16a55b..6d4147ea70a 100644 --- a/services/gundeck/src/Gundeck/Monad.hs +++ b/services/gundeck/src/Gundeck/Monad.hs @@ -31,7 +31,6 @@ module Gundeck.Monad Gundeck, runDirect, runGundeck, - fromJsonBody, posixTime, -- * Select which redis to target @@ -44,11 +43,9 @@ import Bilge hiding (Request, header, options, statusCode) import Bilge.RPC import Cassandra import Control.Concurrent.Async (AsyncCancelled) -import Control.Error import Control.Exception (throwIO) import Control.Lens (view, (.~), (^.)) import Control.Monad.Catch hiding (tryJust) -import Data.Aeson (FromJSON) import Data.Misc (Milliseconds (..)) import Data.UUID as UUID import Data.UUID.V4 as UUID @@ -56,9 +53,7 @@ import Database.Redis qualified as Redis import Gundeck.Env import Gundeck.Redis qualified as Redis import Imports -import Network.HTTP.Types import Network.Wai -import Network.Wai.Utilities import Prometheus import System.Logger qualified as Log import System.Logger qualified as Logger @@ -201,10 +196,6 @@ lookupReqId l r = case lookup requestIdName (requestHeaders r) of ~~ msg (val "generated a new request id for local request") pure localRid -fromJsonBody :: (FromJSON a) => JsonRequest a -> Gundeck a -fromJsonBody r = exceptT (throwM . mkError status400 "bad-request") pure (parseBody r) -{-# INLINE fromJsonBody #-} - posixTime :: Gundeck Milliseconds posixTime = view time >>= liftIO {-# INLINE posixTime #-} diff --git a/tools/stern/default.nix b/tools/stern/default.nix index 81032346144..18246b4fc52 100644 --- a/tools/stern/default.nix +++ b/tools/stern/default.nix @@ -42,7 +42,6 @@ , tasty-ant-xml , tasty-hunit , text -, time , tinylog , transformers , types-common @@ -84,7 +83,6 @@ mkDerivation { servant-swagger-ui split text - time tinylog transformers types-common diff --git a/tools/stern/src/Stern/Intra.hs b/tools/stern/src/Stern/Intra.hs index d226f49f252..a5e17507ff2 100644 --- a/tools/stern/src/Stern/Intra.hs +++ b/tools/stern/src/Stern/Intra.hs @@ -67,7 +67,6 @@ module Stern.Intra getOAuthClient, updateOAuthClient, deleteOAuthClient, - getActivityTimestamp, ) where @@ -94,7 +93,6 @@ import Data.Text.Encoding import Data.Text.Encoding.Error import Data.Text.Lazy as LT (pack) import Data.Text.Lazy.Encoding qualified as TL -import Data.Time.Clock import Imports import Network.HTTP.Types (urlEncode) import Network.HTTP.Types.Method @@ -1040,17 +1038,3 @@ deleteOAuthClient cid = do . expect2xx ) parseResponse (mkError status502 "bad-upstream") r - -getActivityTimestamp :: UserId -> Handler (Maybe UTCTime) -getActivityTimestamp uid = do - b <- asks (.brig) - r <- - catchRpcErrors $ - rpc' - "brig" - b - ( method GET - . Bilge.paths ["i", "users", toByteString' uid, "activity"] - . expect2xx - ) - parseResponse (mkError status502 "bad-upstream") r diff --git a/tools/stern/stern.cabal b/tools/stern/stern.cabal index 36b5a86ca65..b7e04c9de2b 100644 --- a/tools/stern/stern.cabal +++ b/tools/stern/stern.cabal @@ -96,7 +96,6 @@ library , servant-swagger-ui , split >=0.2 , text >=1.1 - , time , tinylog >=0.10 , transformers >=0.3 , types-common >=0.4.13 diff --git a/weeder.toml b/weeder.toml index 66ab0310a78..64669d11e89 100644 --- a/weeder.toml +++ b/weeder.toml @@ -19,6 +19,7 @@ roots = [ # may of the entries here are about general-purpose module "^API.Search._testOrderName", "^API.Team.Util.*$", # FUTUREWORK: Consider whether unused utility functions should be kept. "^Bilge.*$", + "^Cannon.run$", "^Cassandra.Helpers.toOptionFieldName", "^Cassandra.QQ.sql$", "^Data.ETag._OpaqueDigest", @@ -35,11 +36,14 @@ roots = [ # may of the entries here are about general-purpose module "^Data.Range.rcons", "^Data.Range.rinc", "^Data.Range.rsingleton", + "^Data.Schema.fieldWithDocModifierF$", "^Data.ZAuth.Validation.*$", "^Galley.Cassandra.FeatureTH.generateSOPInstances$", "^Galley.Cassandra.FeatureTH.generateTupleP$", "^Galley.Types.Teams.canSeePermsOf", # TODO: figure out why weeder is confused by let bindings with curried infix notation - "^Galley.Types.UserList.ulDiff", + "^Galley.Types.UserList.ulDiff$", + "^Gundeck.Monad.runGundeck$", + "^Gundeck.run$", "^HTTP2.Client.Manager.*$", "^Imports.getChar", "^Imports.getContents", @@ -52,6 +56,8 @@ roots = [ # may of the entries here are about general-purpose module "^Main.debugMainExport", # move-team "^Main.debugMainImport", # move-team "^Main.main$", + "^Network.Wai.Utilities.Request.parseBody$", + "^Network.Wai.Utilities.Server.route$", "^Network.Wai.Utilities.ZAuth.*$", "^Notifications.*$", # new integration tests "^ParseSchema._printAllTables", @@ -112,12 +118,16 @@ roots = [ # may of the entries here are about general-purpose module "^Proto.Otr_Fields.vec'userIds", "^Proto.TeamEvents_Fields.currency", "^Proto.TeamEvents_Fields.vec'billingUser", + "^Proxy.run$", + "^Run.main$", "^Run.main$", "^Spar.Sem.AReqIDStore.Mem.*$", # FUTUREWORK: @fisx can we delete this? "^Spar.Sem.AssIDStore.Mem.*$", # FUTUREWORK: @fisx can we delete this? "^Spar.Sem.ScimTokenStore.Mem.*$", # FUTUREWORK: @fisx can we delete this? "^Spar.Sem.VerdictFormatStore.Mem.*$", # FUTUREWORK: @fisx can we delete this? "^Spec.main$", + "^Stern.App.runHandler$", + "^System.Logger.Extended.runWithLogger$", "^Test.Cargohold.API.Util.shouldMatchALittle", "^Test.Cargohold.API.Util.shouldMatchLeniently", "^Test.Cargohold.API.Util.shouldMatchSloppily", @@ -126,8 +136,6 @@ roots = [ # may of the entries here are about general-purpose module "^Test.Data.Schema.userSchemaWithDefaultName'", "^Test.Federator.JSON.deriveJSONOptions", # This is used inside an instance derivation via TH "^Test.Wire.API.Golden.Run.main$", - "^Run.main$", - "^Test.Wire.API.Password.testHashPasswordScrypt", # FUTUREWORK: reworking scrypt/argon2id is planned for next sprint "^TestSetup.runFederationClient", "^TestSetup.viewCargohold", "^Testlib.App.*$", # FUTUREWORK: See how we can have weeder parse operators in the config file. @@ -148,6 +156,7 @@ roots = [ # may of the entries here are about general-purpose module "^Testlib.Run.mainI$", "^Testlib.RunServices.main$", "^ThreadBudget.extractLogHistory", + "^Util.SuffixNamer.*", "^Util.assertOne", "^Util.randomActivationCode", "^Util.zClient", @@ -174,8 +183,11 @@ roots = [ # may of the entries here are about general-purpose module "^Web.Scim.Test.Util.scim", "^Web.Scim.Test.Util.shouldEventuallyRespondWith", "^Wire.API.MLS.Serialisation.traceMLS", # Debug + "^Wire.API.Password.hashPasswordScrypt$", # Used in testing + "^Wire.API.Password.mkSafePasswordScrypt$", # Used in testing "^Wire.Sem.Concurrency.IO.performConcurrency", - "^Wire.Sem.Logger.fatal" + "^Wire.Sem.Logger.fatal", + "^Wire.Sem.Metrics.incGauge$" # Used in wai-utilities ] type-class-roots = true # `root-instances` is more precise, but requires more config maintenance.